@@ -0,0 +1,111 @@
+# CONTRIBUTING
+
+Thank you for considering contributing to DBD-Oracle.
+This file contains instructions that will help you work with
+the source code.
+
+## Repository branches structure
+
+The two main branches of this repository are:
+
+* **master**
+
+The main development branch. This branch has to
+be processed by Dist::Zilla to generate the
+code as it will appear in the CPAN distribution. See the
+next section for more details.
+
+* **releases**
+
+Contains the code as it appears on CPAN. Each official
+release is also tagged with its version.
+
+## Working on the master branch
+
+The distribution is managed with [Dist::Zilla][distzilla].
+This means than many of the usual files you might expect
+are not in the repository, but are generated at release time.
+
+However, you can run tests directly using the 'prove' tool:
+
+``` bash
+$ prove -l
+$ prove -lv t/some_test_file.t
+$ prove -lvr t/
+```
+
+In most cases, 'prove' is entirely sufficent for you to test any
+patches you have.
+
+You may need to satisfy some dependencies. The easiest way to satisfy
+dependencies is to install the last release -- this is available at
+https://metacpan.org/release/DBD-Oracle.
+
+If you use cpanminus, you can do it without downloading the tarball first:
+
+``` bash
+$ cpanm --reinstall --installdeps --with-recommends DBD::Oracle
+```
+
+Dist::Zilla is a very powerful authoring tool, but requires a number of
+author-specific plugins. If you would like to use it for contributing,
+install it from CPAN, then run one of the following commands, depending on
+your CPAN client:
+
+``` bash
+$ cpan `dzil authordeps --missing`
+$ dzil authordeps --missing | cpanm
+```
+
+You should then also install any additional requirements not needed by the
+dzil build but may be needed by tests or other development:
+
+``` bash
+# cpan `dzil listdeps --author --missing`
+$ dzil listdeps --author --missing | cpanm
+```
+
+You can also do this via cpanm directly:
+
+``` bash
+$ cpanm --reinstall --installdeps --with-develop --with-recommends DBD::Oracle
+```
+
+Once installed, here are some dzil commands you might try:
+
+``` bash
+$ dzil build
+$ dzil test
+$ dzil test --release
+$ dzil xtest
+$ dzil listdeps --json
+$ dzil build --notgz
+```
+
+
+## This Is Complicated. Is There an Easier Way?
+
+Actually, yes there is. You can also work directly on the `releases` branch,
+which corresponds to the code is generated by Dist::Zilla and
+correspond to what is uploaded to CPAN.
+
+It won't contain any of the changes brought to the codebase since the last
+CPAN release, but for a small patch that shouldn't be a problem.
+
+## Sending Patches
+
+The code for this distribution is hosted on [GitHub][repository].
+
+You can submit bug reports via the [repository's issue track][bugtracker].
+
+You can also submit code changes by forking the repository, pushing your code
+changes to your clone, and then submitting a pull request. Detailed
+instructions for doing that is available here:
+
+* https://help.github.com/
+* https://help.github.com/articles/creating-a-pull-request
+
+[distzilla]: http://dzil.org/.
+[repository]: https://github.com/pythian/DBD-Oracle/
+[bugtracker]: https://github.com/pythian/DBD-Oracle/issues
+
@@ -0,0 +1,20 @@
+
+# DBD-ORACLE CONTRIBUTORS #
+
+This is the (likely incomplete) list of people who have helped
+make this distribution what it is, either via code contributions,
+patches, bug reports, help with troubleshooting, etc. A huge
+thank to all of them.
+
+ * David E. Wheeler <david@justatheory.com>
+ * David Perry <perry@pythian.com>
+ * David Steinbrunner <dsteinbrunner@pobox.com>
+ * Gwen Shapira <shapira@pythian.com>
+ * Joe Crotty <joe.crotty@returnpath.net>
+ * Michael Portnoy <portnoy@pythian.com>
+ * StephenCIQG <StephenCIQG@50811bd7-b8ce-0310-adc1-d9db26280581>
+ * cjardine <cjardine@50811bd7-b8ce-0310-adc1-d9db26280581>
+ * gregor herrmann <gregoa@debian.org>
+ * jurl <jurl@50811bd7-b8ce-0310-adc1-d9db26280581>
+ * lbaxter <lbaxter@50811bd7-b8ce-0310-adc1-d9db26280581>
+ * robert <robert@50811bd7-b8ce-0310-adc1-d9db26280581>
@@ -1,4 +1,954 @@
-=head1 Changes in DBD-Oracle 1.14 27th March 2003
+Revision history for DBD::Oracle
+
+1.74 2014-04-24
+ - Promote to stable.
+
+1.73_01 2014-04-23
+ - Tweak fix for RT-88185. (GH#14, Martin J. Evans)
+
+1.73_00 2014-04-23
+ - Reverts current fix for RT-88185, as it causes breakage. (GH#14)
+
+1.72 2014-04-14
+ - promote 1.71_00 to stable.
+
+1.71_00 2014-03-31
+ - Recognizes __CYGWIN64__. (RT88709, reported by Witold Petriczek)
+ - CHOOSE hint is deprecated. (RT91217, reported by Andy Bucksch,
+ fix by Martin J Evans)
+ - Set UTF8 flag per-connection. (RT88185, reported by Heinrich Mislik, patch by Martin
+ J. Evans)
+ - Add a CONTRIBUTING.mkd file. (GH#2)
+ - Add SELinux trick. (RT#87003, patch submitted by Mike Doherty)
+
+1.70 2014-02-12
+ - promote 1.69_02 to stable.
+
+1.69_02 2014-01-19
+
+ [IMPROVEMENTS]
+
+ - The DSN 'dbi:Oracle:sid=foo' is now an alias for 'dbi:Oracle:foo'.
+ (RT#91775, Yanick Champoux, requested by David Wheeler)
+
+ - Support for ORA_SYSBACKUP, ORA_SYSDG and ORA_SYSKM. (RT#91473,
+ Kris Lemaire)
+
+ [BUG FIXES]
+
+ - OCI_THREADED setting had been accidentally removed, causing potential
+ crashes when using threads. (RT#92229, Martin J. Evans, reported
+ by Detlef Lütticke)
+
+ - When using fetch*_hashref the values are decoded but
+ not the keys so if you have unicode column names they were not
+ returned correctly. (RT#92134, Martin J. Evans, reported by
+ Marcel Montes)
+
+
+1.69_01 2014-01-14
+
+ [BUG FIXES]
+
+ - Fix RT91698. If you bound an output parameter to a scalar and
+ repeatedly called execute the memory allocated in your bound
+ scalar could increase each time. (Martin J. Evans)
+
+1.68 2013-11-25
+ - promote 1.67_00 to stable.
+
+1.67_00 2013-11-05
+
+ [BUG FIXES]
+ - Fix RT88135. Add statistics_info support (patch by Steffen Goeldner)
+ - Fix RT89491. Add RULE hint (patch by Steffen Goeldner)
+
+ [DOCUMENTATION]
+ - POD typos (RT#88285, RT#88284, Gregor Herrman).
+ - Grooming of Hpux troubleshooting pod (GH#7, Martin J. Evans,
+ Yanick Champoux)
+
+1.66 2013-08-23
+ - promote 1.65_00 to stable.
+
+1.65_00 2013-07-29
+
+ [BUG FIXES]
+
+ - Fix RT85886. The TYPE passed to bind_col is supposed to be sticky
+ and it wasn't. Attributes passed to bind_col could be lost later if
+ bind_col is called again without attributes. Both of these occur
+ when fetchall_arrayref is called with a slice (Martin J. Evans).
+
+ [DOCUMENTATION]
+
+ - Fix a bunch of typos. [GH#5, David Steinbrunner]
+
+1.64 2013-05-22
+ - promote 1.63_00 to stable.
+
+1.63_00 2013-05-03
+
+ [ENHANCEMENTS]
+ - DBD-Oracle: Use of uninitialized value $user_only in uc [RT#84657]
+ (Steffen Goeldner)
+
+ [BUG FIXES]
+ - Make 50cursor.t Oracle8-friendly. (RT#84660, patch by Steffen Goeldner)
+ - Makefile.PL's use of ACL tweaked for Suse Enterprise 11 SP2
+ (RT#84530, patch by Alfred Nathaniel)
+
+ [DOCUMENTATION]
+ - Bogus 227 directory no longer required for MacOS. (GH#1, patch
+ by theory)
+
+1.62 2013-04-30
+ - promote 1.61_00 to official release
+
+1.61_00 2013-04-15
+
+ [BUG FIXES]
+ - Adjust the privs needed for the DROP/CREATE table test. [GH#35]
+ (Joe Crotty)
+
+ - Fixed RT84170 - when using scrollable cursors and you've done a
+ positioned fetch and then keep fetching until the end of the
+ result-set calls to fetch never return undef and you keep getting
+ the last row forever. Also added test case to the 51scroll.t test
+ (Martin J. Evans).
+
+1.60 2013-04-01
+ - Move github repository to github.com/pythian/DBD-Oracle.
+
+1.58 2013-03-05
+ - promote 1.57_00 to official release
+
+1.57_00 2013-02-07
+ [BUG FIXES]
+
+ - fix RT46628 - bind_param_inout ORA_RSET causes MSWin32 access
+ violation and RT82663 - Errors if a returned SYS_REFCURSOR is not
+ opened (Martin J. Evans)
+
+ - Fix RT82663. If a procedure/function returns a SYS_REFCURSOR which
+ was never opened DBD::Oracle magics a DBI statement handle into
+ existence and attempts to describe it (which fails). This change
+ examines a returned SYS_REFCURSOR and if it it is initialised but
+ not executed does not create a DBI statement handle and returns
+ undef instead. So now if you have a procedure/function which
+ returns a SYS_REFCURSOR and never open it you'll get undef back
+ instead of a useless statement handle. Extended 50cursor.t test
+ to check the above fix. (Martin J. Evans)
+
+ [DOCUMENTATION]
+ - Update Lion instructions for 64-bit Instant Client. (GH#37, patch by
+ theory)
+
+1.56 2013-01-08
+ - fix t/26exe_array.t in the case of no db connection (RT82506,
+ reported by Peter Rabbitson)
+
+1.54 2013-01-03
+ - promote 1.53_00 to official release
+
+1.53_00 2012-12-18
+
+ [BUG FIXES]
+ - Fix RT69350 - 31lob.t was using $lob after destroying its parent $sth
+ (Rob Davies)
+
+ - Fix memory leak in execute_array (John Scoles, Pierre-Alain Blanc)
+
+ - Fix RT80349 - The error message in execute_for_fetch when a row fails
+ can contain the wrong error count. Thanks to Steffen Goeldner for
+ RT and patch.
+
+ - Fix RT80375 - no exception when execute_for_fetch fails and
+ ArrayTupleStatus is not specified. Also the tuple count calculation
+ resulted in an undefined warning. Thanks to Steffen Goeldner for
+ RT and patch.
+
+ - Fix RT80487. Skip XMLType tests if Oracle less than V9. Thanks to
+ Steffen Goeldner for RT and patch.
+
+ - Fix RT80486 for 31lob_extended.t. In old old Oracle8,
+ SYS_REFCURSOR is not defined. Instead of CREATE/DROP PROCEDURE,
+ use anonymous block. Thanks to Steffen Goeldner for RT and patch.
+
+ - Fix bug in 39attr.t which could fail if using an Oracle Client >
+ 11 but not >= 11.2 (Martin J. Evans)
+
+ - ora_server_version was not documented.
+
+ - Fix RT80566. 70meta.t test fails with Oracle 8 because
+ ALL_TAB_COLUMNS.CHAR_LENGTH is new in Oracle 9. Use DATA_LENGTH
+ instead on pre-9 versions. Thanks to Steffen Goeldner for RT and
+ patch.
+
+ - Fix RT80704. 51scroll.t test checks scrollable cursors but assumes
+ all Oracles support them (only 9 and above). Thanks to Steffen
+ Goeldner for RT and patch.
+
+ - Fix RT81067. 58object.t has some subtype tests and subtypes were
+ introduced in Oracle 9. Skip if < Oracle 9. Thanks to Steffen
+ Goeldner for RT and patch.
+
+ - Fix RT81317. 34pres_lobs.t uses the Data Interface for Persistent
+ LOBs which is new in Oracle 9. Skip if < Oracle 9. Thanks to
+ Steffen Goeldner for RT and patch.
+
+ [MISCELLANEOUS]
+
+ - The original 26exe_array test was replaced some time ago with a
+ copy of the one from DBD::ODBC. Since then I've fixed issues in
+ the DBD::ODBC one and added more tests (like tests for some RTs
+ above). To make keeping them in synch easier I've modularised the
+ tests. Hence new ExecuteArray.pm. (Martin J. Evans)
+
+ - simple code clean up, replacing 3 uses of safemalloc with Newz
+ (John Scoles)
+
+ - Add DBI as a configure prereq for the META* files (thanks to Joe Crotty)
+
+ - New FAQ entry on Solaris and setting linker library path
+ (Martin J. Evans)
+
+ - Removed ineffective commit in 34pres_lobs.t (Martin J. Evans)
+
+ - Remove dead README link in Win32 documentation. (pointed out by Alexandr
+ Ciornii, RT#82040)
+
+ - Changed any use of if SvUPGRADE to remove the if test as per email
+ from Dave Mitchell and posting at
+ http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2012-12/msg00424.html
+ (Martin J. Evans)
+
+1.52 2012-10-19
+
+ - promote 1.51_00 to official release
+
+1.51_00 2012-09-28
+
+ [BUG FIXES]
+
+ - fix serious memory corruption in TAF support (Martin J. Evans)
+
+ - fix finding client in situation where client and server both
+ installed but different architectures (patch by H.Merijn Brand)
+
+ - fix memory leak in TAF handling - the TAF function was leaked
+ (Martin J. Evans)
+
+ - fix issue with taf_function being set to a scalar which goes
+ out of scope before the callback is made (Martin J. Evans)
+
+ - fix RT46739 if a connection breaks the environment handle is
+ not thrown away (Martin J. Evans)
+
+ - ora_driver_name was not defaulted to the correct DBD::Oracle
+ version (Martin J. Evans)
+
+ - ora_driver_name, ora_client_info, ora_client_identifier,
+ ora_action and ora_oci_success_warn were set twice (if specified)
+ on connect as they were not deleted from the connect attributes
+ once handled. Code now leaves the setting to the later STORE DBI
+ calls (Martin J. Evans)
+
+ - fixed some compiler warnings for %lf (Martin J. Evans)
+
+ - fixed RT78700 - column_info reports wrong size for char semantic
+ char type columns (Douglas Wilson).
+
+ [CHANGE IN BEHAVIOUR]
+
+ - ora_taf and ora_taf_sleep were redundant and have been removed.
+ To enable/disable TAF simply set ora_taf_function and if you
+ want to sleep do it in your callback (Martin J. Evans)
+
+ - ora_taf_function can now be a code reference as well as a string
+ (Martin J. Evans)
+
+ [ENHANCEMENTS]
+
+ - the ora_can_taf method was virtually useless since you can only
+ call it after connecting and to enable TAF you had to do it in the
+ connect call. Now you can enable and disable TAF at any time by
+ simply setting or clearing the ora_taf_function (see RT78811)
+ (Martin J. Evans)
+
+ - the ora_taf_function is now passed a third argument of the
+ connection handle (Martin J. Evans)
+
+ - RT78987 - removed Oraperl.pm and oraperl.ph; these files will be
+ available in a separate distribution named "Oraperl" (David Perry)
+
+ [MISCELLANEOUS]
+
+ - hide dr, db and st packages from PAUSE (Martin J. Evans)
+
+ - added a few more simple TAF tests (Martin J. Evans)
+
+1.50 2012-08-15
+ - RT78965 - Remove Oraperl tests (which were forcing a require on Oraperl)
+
+1.48 2012-08-09
+ - promote 1.47_00 to official release
+
+1.47_00 2012-07-11
+
+ [BUG FIXES]
+
+ - fixed redeclaration of $len in 31lob.t - (Martin J, Evans)
+
+ - RT55028 - stop segfaulting when attempting to read empty lobs
+ (Martin J. Evans)
+
+ - RT69059 - Despite OCIPing being documented as added in 10.2 AIX
+ does not seem to have it in 10.2 leading to undefined symbol -
+ Martin J. Evans
+
+ [DOCUMENTATION]
+ - Promoted the troubleshooting for the different architectures to
+ POD documents, for easier/prettier access.
+
+ - Added a troubleshooting entry for RT71819 - bound output
+ parameters may be returned in the wrong order (Martin J. Evans)
+
+1.46 2012-07-11
+ - promote 1.45_00 to official release
+
+1.45_00 2012-06-21
+
+ [CHANGE IN BEHAVIOUR]
+
+ - In future versions of DBD::Oracle ora_verbose will be changed
+ so that it is simply a switch to turn DBI's DBD tracing on or off.
+ A true value will turn it on and a false value will turn it off.
+ DBI's "DBD" tracing was not available when ora_verbose was created
+ and ora_verbose adds an additional test to every trace test.
+
+ [BUG FIXES]
+
+ - Fixed RT76695 - offset passed to ora_fetch_scroll should not affect
+ normal fetches (Martin J. Evans)
+
+ - Fixed RT76410 - fetch after fetch absolute always returns
+ the same row (Martin J. Evans);
+
+ - Fixed RT75721 - does not build with Oracle 9.2 (Martin J. Evans)
+
+ - Fixed RT71343 - Oracle 9i does not have OCI_ATTR_TAF_ENABLED
+ or OCI_ATTR_RESERVED_15/16 so cannot build (Martin J. Evans)
+
+ - skip 24implicit_utf8.t if chr set is not UTF-8 (Martin J. Evans)
+
+ - Fixed RT76269 - ora_taf_sleep was documented as taf_sleep by
+ accident. There was no way to stop the TAF reconnect attempts.
+ If you want to try another connect attempt in your taf handler you
+ now need to return OCI_FO_RETRY from it. (Martin J. Evans)
+
+ [MISCELLANEOUS]
+
+ - minor change to confusing debug output for input parameters
+ (Martin J. Evans)
+
+ - RT72989 - add note to trouble shooting guide re this RT and
+ Module::Runtime (Martin J. Evans)
+
+1.44 2012-04-23
+ - promote 1.43_00 to official release
+
+1.43_00 2012-03-30
+
+ [BUG FIXES]
+ - Applied patch from Rafael Kitover (Caelum) to column_info to handle
+ DEFAULT columns greater in length than the DBI default of 80. The
+ DEFAULT column is a long and it is a PITA to have to set
+ LongReadLen which you can only do on a connection handle in
+ DBD::Oracle. The default maximum size is now 1Mb; above that you
+ will still have to set LongReadLen (Martin J. Evans)
+
+ - Fixed 70meta and rt74753-utf8-encoded to not die if you cannot
+ connect to Oracle or you cannot install from CPAN if you have not
+ set up a valid Oracle connection.
+
+ - Fixed 75163. Bfile lobs were not being opened before fetching if
+ ora_auto_lobs was disabled (Martin J. Evans).
+
+ Note: this has a minor impact on non bfile lobs when ora_auto_lobs
+ is not in force as an additional call to OCILobFileIsOpen will be
+ made.
+
+ - Removed all DBIS usage fixing and speeding up threaded
+ Perls (Martin J. Evans).
+
+ - Minor fix to avoid use of uninitialised variable in 31lob.t (Martin J. Evans)
+
+ [DOCUMENTATION]
+ - clarification of when StrictlyTyped/DiscardString can be used and
+ LongReadLen (Martin J. Evans)
+
+ - Documented the 3rd type of placeholder and rewrote the existing
+ pod for placeholders (Martin J. Evans).
+
+1.42 2012-03-13
+ - skip rt74753-utf8-encoded.t if db is not unicode
+
+1.40 2012-03-08
+ - promote 1.39_00 to official release
+
+1.39_00 2012-02-24
+
+ [BUG FIXES]
+ - TAF supports now conditional to presence of OCI_ATTR_TAF_ENABLED
+ [RT73798]
+ - detect broken Win32::TieRegistry (patch by Rafael Kitover (Caelum))
+ [RT74544]
+ - PL/SQL out values were not utf8 encoded [RT74753]
+ (Steve Baldwin + Martin J. Evans)
+
+ [DOCUMENTATION]
+ - Mention the release of Oracle Instant Client 64 bit which does not work
+ on Lion. (Martin J. Evans)
+ - fix DBD::Oracle::GetInfo blurb (patch by Julián Moreno Patiño) [rt74000]
+ - fix typos. (patch by Julián Moreno Patiño) [rt73999]
+ - add troubleshoot doc and diag for error with bequeather. [rt75263]
+
+ [OTHERS]
+ - change the shebang line of examples to the more modern '/usr/bin/env perl'
+ [RT74001]
+
+1.38 2012-01-13
+
+ - promote 1.37_00 to official release
+
+1.37_00 2011-12-30
+
+ [ENHANCEMENTS]
+ - added SYSASM session mode. [RT651211] (patch from
+ Anthony DeRobertis, reported by Julián Moreno Patiño)
+
+ [BUG FIXES]
+
+ - applied patch from Charles Jardine avoiding undefined values
+ warnings in ora_server_version when the database is not open
+ [RT72623] (Martin J. Evans)
+ - TNS_ADMIN was ignored [RT73456]
+
+ [DOCUMENTATION]
+
+ - Document possible problem with
+ ora_connect_with_default_signals and connect_cached
+ [RT72716] (Martin J. Evans)
+ - Fix documentation for 'ora_fetch_scroll()'
+
+Changes in DBD-Oracle 1.36 (6-12-2011)
+
+ - promote 1.35_00 to official release
+
+Changes in DBD-Oracle 1.35_00 (18-11-2011)
+
+ [BUG FIXES]
+ - if bind_col is called with a TYPE but no bind attributes like
+ StrictlyTyped or DiscardString are set DBD::Oracle still attempts
+ to call sql_type_cast which is pointless (Martin J. Evans)
+ - if bind_col is called with a TYPE other than SQL_NUMERIC,
+ SQL_INTEGER or SQL_DOUBLE and bind attributes like StrictlyTyped or
+ DiscardString a warning was not issued that the type is unsupported
+ and no data was returned (Martin J. Evans)
+ - Fix test so it works with perl compiled with -Duselongdouble [RT71852]
+ - Apply patch from Charles Jardine for better building against a full
+ Oracle 11 install [RT72463] (Martin J. Evans)
+
+ [DOCUMENTATION]
+ - Added notes to bind_col documenting the fact that setting a TYPE
+ does not affect how the column is bound in Oracle, only what
+ happens after the column data is retrieved (Martin J. Evans)
+ - fix typo (thanks to Julián Moreno Patiño) [RT72038]
+ - shuffle POD around to improve documentation flow [RT72252]
+ - major tidying up of the connect() documentation. (by Gwen Shapira)
+ - Moved LONG examples out of POD and into examples/
+
+ [OTHER]
+ - Commented out some functions in oci8.c which were not used to
+ reduce the size of the driver a little (Martin J. Evans)
+
+Changes in DBD-Oracle 1.34 (31-10-2011)
+
+ - promote 1.33_00 to official release
+
+Changes in DBD-Oracle 1.33_00 (18-10-2011)
+
+ [BUG FIXES]
+ - COLUMN_SIZE of VARCHAR2 returns size in chars, not bytes. [RT#13865]
+ (reported by Stefano and Laurent Dami)
+
+ [DOCUMENTATION]
+ - add mention of the github mirror of the subversion repository
+ - add 'resources' info to META.yml
+ - fixed broken link to Oracle DRCP doc in POD (John Scoles)
+
+Changes in DBD-Oracle 1.32 (16-10-2011)
+
+ - promote 1.31_00 to official release
+
+Changes in DBD-Oracle 1.31_00
+
+ [ENHANCEMENTS]
+ - Makefile.PL's options are now documented
+ - move 'explain' to '/examples' directory
+
+ [BUG FIXES]
+ - support development release versions in GetInfo (Martin J. Evans)
+ - don't gag diag() on the tests by default
+ - SKIP condition in 10general.t was reversed (reported by Alois) [RT#46761]
+ - Check for LD_LIBRARY_PATH_(32|64) as well for solaris [RT#46761]
+ - convert a symbolically linked ORACLE_HOME to an absolute path
+ (patch by H.Merijn Brand, applied by Martin J. Evans) [rt70785]
+
+ [DOCUMENTATION]
+ - announce that Oraperl will be removed from the dist by v1.38.
+ - add Mac OS instructions for Lion (patch by David Wheeler) [rt71109]
+ - fixed minor typo in POD (John Scoles)
+
+Changes in DBD-Oracle 1.30
+ [DOCUMENTATION]
+ - add warning about RT#69350 in documentation
+
+Changes in DBD-Oracle 1.29_1
+ [ENHANCEMENTS]
+ - added support for TAF callback (John Scoles)
+ - now trap OCIServerAttach errors (patch by Marc Fielding, applied
+ by Martin J. Evans) [rt68958]
+ - added installation notes for MAC Snow Leopard (Martin J. Evans)
+ - added '/etc' to the search paths for tnsnames.ora (Martin J. Evans, Jay Senseman)
+ [rt67942]
+ - removed support for ProcC connections (John Scoles)
+ - added ora_db_shutdown and ora_db_startup private functions (Steffen Goeldner)
+ - added Test::Simple 0.90 to build_requires as we use note etc (Martin J. Evans)
+
+ [BUG FIXES]
+ - fixed bug in bind_col which was broken in 1.27 and stopped anyone using
+ a string as a column number. e.g., '1' (Martin J. Evans, Alexander
+ Foken)
+ - removed obsolete oparse_lang (John Scoles)
+ - fixed some compiler warnings in dbdimp.c and oci8.c (Martin J. Evans)
+ - added missing OCIServerRelease to oci.def (Martin J. Evans) [rt68172]
+ - fixed up the POD based on DBD::Pg (John Scoles)
+ - POD review rephrasing, fixing typos and spelling mistakes up to
+ "Placeholder Binding Attributes" (Martin J. Evans)
+ - rt 56824 - add META_MERGE mentioning DBI required version (Martin J. Evans)
+
+* Changes in DBD-Oracle 1.28 (svn rev 14765)
+
+ Changed 26exe_array.t so it is compatible with older version of Test::More by John Scoles
+ A fix from Charles Jardine for 58object.t to stop an error on some 64 bit systems
+ A few quick changes from H. Merijn Brand to fix some compiler warings and a fix for Oracle 9 clients
+ Added connection attribute 'ora_connect_with_default_signals' that will localize Perl's $SIG{INT} handler from Brian Phillips and T. Bunce
+ Fix in execute_array to stop possible endless loop when using a fetch sub by Martin J. Evans
+ Adapted Martin J. Evans' ODBC 70execute_array.t into t/26exe_array.t by John Scoles
+ Fix for execute_array to bring it up to spec. by Martin J. Evans and John Scoles
+ Marked ProC, Oraperl.pm, ora_explain.pl, ora_context, ora_use_proc_connection and ora_parse_lang as deprecated to be removed in 1.29
+ Added in 4 new server side debug/trace attributes, ora_driver_name, ora_client_info, ora_session_user and ora_action on the connection handle from John Scoles
+ Cleaned up the pod a little by John Scoles
+ Fix for function name length, Some function names are over 31char long which may cause problems for some OS/Compilers (VMS IA64 box.) from Jakob Snoer
+ Fix for OCIPing in case where a 10 client tries to ping a <10 DB from Tim Oertel
+ Fix for DBD-Oracle stored proc with array bug where second call array size is unchanged from Tim Oertel
+ Fix for rt.cpan.org Ticket #=63332: Spelling error in POD from jonasbn
+ Fix for rt.cpan.org Ticket #=62152: t/28array_bind.t and t/31lob.t may call plan() twice and others do not fail on not connect from John Scoles
+ Fix for rt.cpan.org Ticket #=61511 ORA-00942 when inserting into a table with a LOB column over a synonym on HP-UX from Kris Lemaire
+ Fix for rt.cpan.org Ticket #=42842 Test 31lob fails with 64-bit Instant Client by John Scoles
+ Fix for support for objects on big endian platforms from Charles Jardine, John R Pierce
+ Fix for rt.cpan.org Ticket #=61225 Windows install (Stawberry Perl) fails on long path names from David Tulloh
+ Fix for rt.cpan.org Ticket #=rt64524 Memory Leak when Oracle connection fails by Martin J. Evans
+ Added all the missing ora_drcp values to dbh private_attribute_info by Martin J. Evans
+ Removed a load of attributes from sth private_attribute_info which are not handle attributes but attributes to bind_param/prepare by Martin J. Evans
+ Fix for rt.cpan.org Ticket #=64244 - don't bail out, skip tests when we cannot connect by Martin J. Evans and John Scoles
+ Added DBI to PREREQ_PM in Makefile.PL by Martin J. Evans
+ Added build_requires in Makefile.PL by Martin J. Evans
+ Added workaround for ExtUtils::MakeMaker problems by Martin J. Evans
+ Added LICENSE to Makefile.PL by Martin J. Evans
+
+
+* Changes in DBD-Oracle 1.27 (svn rev 14583)
+
+ This version removes 'PERL_POLLUTE' and adds in PL_ where required so it will be fully compatible with Perl 5.13
+
+* Changes in DBD-Oracle 1.26 (svn rev 14411)
+
+ Manual re-release of 1.25 with changes to file permissions.
+
+* Changes in DBD-Oracle 1.25(svn rev 14411)
+
+ Added support for the OCIPing by John Scoles
+ Spell checked the pod (the first time in a while me thinks) updated the todo By John Scoles
+ Added support for DCRP (Database Resident Connection Pooling) by John Scoles with Luben Karavelov
+ Fix for odd error with Ping from Tom Payerle
+ Removed the NEW_OCI_INIT compile directive and the deprecated OCIInitialize calls
+ Fix for rt.cpan.org Ticket #=57256 : Double free problem in dbdimp.c by John Scoles
+ Fix for invalid format in trace of OCILobLocatorIsInit_log_stat reported by Martin Evans Fixed by John Scoles
+ Fix for very odd UNKNOWN OCI STATUS 1041 (OCILobFreeTemporary) on disconnect reported by John Parker and Bob Mcgowan fixed by John Scoles
+ Fix for rt.cpan.org Ticket #=55445: get_info(28) SQL_IDENTIFIER_CASE seems to return the wrong value from Martin J Evans and a bunch of re jigging from John Scoles
+ Patch for PL/SQL: numeric or value error: character string buffer too small from Scott T. Hildreth
+ Fix for rt.cpan.org Ticket #=51594 type_info and type_info_all miss vital information from John Scoles
+ Added ora_lob_is_init function by John Scoles
+ Fix for rt.cpan.org Ticket #=55031 Ubuntu Server Building with Oracle XE under 32-bit from Brian Candler
+ Fix for rt.cpan.org Ticket #=56810 bug with multiple nested cursor from John Scoles
+ Fix for bug found only on Big-Endian hardware reported by Timothy Everett and others from Charles Jardine
+ Fix for memory leak when using prepared_cached and lobs reported by Mark Bobak and Martin Evans found and fixed by John Scoles and a test from Martin Evans
+ Added more entries to the Readmes from John Scoles
+
+* Changes in DBD-Oracle 1.24_01(svn rev 14060)
+
+ This release has been prepared specifically for the 'Debian' http://www.debian.org project. It contains no changes
+ to functionality or usage. The following has been changed
+
+ Fixed some formatting and typos in Pod from Julián Patiño
+ The Copyright terms for ora_explain have changed and now read as follows:
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+
+* Changes in DBD-Oracle 1.24(svn rev 13793)
+
+ Extended precision for OCIDateTimeToText to 6 instead of 0 for embedded types from John Scoles
+ Extended support of Oracle Embedded objects from Charles Jardine
+ Added support for RowsInCache as RO and RowCacheSize as a set-able value on the Statement Handle. So it would comply with DBI spec By John Scoles with thanks to Martin J. Evans
+ Added extended support for 64 bit clients in Makefile.PL from Ralph Doncaster
+ Added extended nvarchar support from Jan Mach
+ Added support for the TYPE attribute on bind_col and the new DBI bind_col attributes StrictlyTyped and DiscardString from Martin J. Evans
+ Added ora_ncs_buff_mtpl and environment var ORA_DBD_NCS_BUFFER so we can control the size of the buffer when doing nclob reads
+ Fix for rt.cpan.org Ticket #=49741 Oracle.h has commented out params in OCIXMLTypeCreateFromSrc from Kartik Thakore
+ Added from rt.cpan.org Ticket #=49436 Patch to add support for a few Oracle data types to type_info_all from David Hull
+ Added from rt.cpan.org Ticket #=49435 Patch to add support for a few Oracle data types to dbd_describe from David Hull
+ Fix for rt.cpan.org Ticket #=49331 Bad code example in POD from John Scoles
+ Added support for looking up OCI_DTYPE_PARAM Attributes
+ Added support for looking up csform values
+ Fix for rt.cpan.org Ticket #=46763,46998 enhancement -Rowcache size is now being properly implemented with row fetch buffer from John Scoles
+ Fix for rt.cpan.org Ticket #=46438 enhancement -Errors returned by procedures are now unicode strings from Martin Evans, John Scoles and Tim Bunce
+ Fix for rt.cpan.org Ticket #=47503 bugfix - using more than 1 LOB in insert broken from APLA
+ Fix for rt.cpan.org Ticket #=46613 bugfix - sig-abort on nested objects with ora_objects=1 from TomasP
+ Fix for rt.cpan.org Ticket #=46661 DBD::Oracle hangs when insert/update with LOB and quoted table name from APLA
+ Fix for rt.cpan.org Ticket #=46246 fetching from nested cursor (returned from procedure) leads to application crash (abort) from John Scoles
+ Fix for rt.cpan.org Ticket #=46016 LOBs bound with ora_field broken from RKITOVER
+ Fix for bug in 58object.t when test run as externally identified user from Charles Jardine
+
+* Changes in DBD-Oracle 1.23(svn rev 12724)
+
+ Fix from rt.cpan.org ticket #=44788 bool in_lite should be char in_literal
+ Fix for UTF8 and blobs by John Scoles with Milo van der Leij
+ Fix for some warnings and one bug in ocitrace.h from Charles Jardine
+ Fix in case there may be a bug in 11 where the OCI_ATTR_DATA_SIZE my return 0 which should never happen, John Scoles
+ Fix on the Makefile.PL for a possible sql bug in IC from Martin Evans
+ Added a change from a suggestion from Martin Evans for making ref cursors faster.
+ Added rt.cpan.org Ticket #=42328 ora_objects attribute for extended embedded objects support from Tomas Pokorny
+ Fix for rt.cpan.org Ticket #=42328 user defined types from different schema in describe_obj from Tomas Pokorny
+ Added a README for sun suggested by Jim McCullars
+ Clean up of white space and formatting to 4 tabs from John Scoles
+ Fix for GCC 4.3 warnings from Eric Simon
+ Standardized the dbd_verbose levels so they are all 3 and over. from John Scoles
+ Added private statement functions ora_stmt_type_name and ora_stmt_type from John Scoles
+ Update to POD from Chris Underhill
+ Added README.win64.txt with content from Alex Buttery
+ Fix for rt.cpan.org Ticket #=21920 Bug with Oracle DBD for Mac OS X Instant Client From boingolover
+ Added a few more constants to get rid of magic numbers from John Scoles
+ Fix for rt.cpan.org Ticket #=38267 Inserts/Updates to BLOB's via synonyms fails from John Scoles
+ Fix for rt.cpan.org Ticket #=39603 build problem and fix missing functions in oci.def from Zoltán Sebestyén
+ Fix for rt.cpan.org Ticket #=39374 Makefile.PL: error when reducing echo messages from make from Tippa
+ Fix for rt.cpan.org Ticket #=39232 binding large XMLTYPE fails on 64-bit perl from Jeff Klein
+ Fix for rt.cpan.org Ticket #=38749 Warning of a NULL column in an aggregate function also added ora_oci_success_warn to display silent OCI warnings from John Scoles
+ Patch for UTF8 check on execute_array from David Mansfield and a little by John Scoles
+
+
+* Changes in DBD-Oracle 1.22(svn rev 11618) 1st Aug 2008
+
+ Patch to remove compiler warnings from H.Merijn Brand
+ Patch to Makfile for 64bit boxes from Alex Laslavic
+ Added OCILobGetLength to lob functions from Milo van der Leij
+ Updated readmes to state the test user has to have create, call and drop a procedure privileges by John Scoles suggested by Gisle Aas
+ Patch to Makfile to prevent the installation of the lib/DBD/mkta.pl fil from Gisle Aas
+ Added new Test 31lob_extended.t for use of LOBs when returned via stored procedures with bind_param_inout from Martin Evans
+ Update to connection part of POD from John Scoles
+ Fix to test suite to bring it up to standard from Martin Evans
+ Fix for memory hemorrhage in bind_param_inout_array found by Ricky Egeland, Fix by John Scoles
+ Fix for a typo in oracle.xs from Milo van der Leij
+ Fix for bugs on SPs with Lobs reported by Martin Evans, Fix by J Scoles
+ Changed the way Ping works rather than using prepare and execute it now makes a single round trip call to DB by John Scoles
+ Fix for rt.cpan.org Ticket #=37501 fail HP-UX Itanium 11.31 makefile also added the OS and version to the output of the Makefile.PL for easier debugging. from John Scoles and Rich Roemer
+ Added a number of internal functions for decoding OCI debug values from John Scoles
+ Fix for hpux 11.23 linker error unrecognized argument on the Makefile from someone on CPAN forum
+ Added fetch by piece for lobs, fixed persistent lobs and expansed thier usage for LONG and LONG RAW and changed to pod to reflect the changes from John Scoles
+ Added comment to POD on case sensitivity of ORACLE environment variables suggested by Gerhard Lausser
+ Added patch to fix a number of harmless, but annoying, GCC warnings from Eric Simon
+ Added (finally) ora_verbose for DBD only tracking from John Scoles and thanks to H.Merijn Brand
+ Fix for rt.cpan.org Ticket #=32396 from John Scoles
+ Fix for memory leak that snuck into 1.21 from John Scoles
+ Fix for rt.cpan.org Ticket #=36069: Problem with synonym from John Scoles
+ Fix for rt.cpan.org Ticket #=28811 ORA_CHAR(s) not returning correct length in functions and procedures from John Scoles
+ Makefile.PL now working without flags for Linux 11.1.0.6 instant client and regular client from John Scoles, Andy Sautins, H.Merijn Brand, Nathan Vonnahme and Karun Dutt
+ Fixed how persistent lob fetch works now uses callback correctly, from John Scoles & Darren Kipp
+
+
+* Changes in DBD-Oracle 1.21(svn rev 11067) 11th April 2008
+
+ Added Notes to README.win32.txt on installing Instant Client 11.1.0.6.0 from John Scoles
+ Added the oci_typecode_name method to get the name rather than just the number of an OCI_TYPECODE from John Scoles
+ Fixed a unreported bug with Embedded Objects from John Scoles
+ Fixes for #34621 & 33791 from RT cpan
+ Added patch to allow faster fetch from REF CURSORs from Biswadeep Chowdhury
+ Updated the Todo file for next version from John Scoles
+ Added support for the 10.2 Data Interface for Persistent LOBs by John Scoles
+ Changed the way pre-fetching is done by John Scoles
+ Added support for Scrollable cursors from John Scoles
+ Changed the max size of cache_rows to a sb4 rather than a int and or a ub4 from John Scoles
+ Added support for Lobs in select of OCI Embedded Objects from John Scoles with a big thankyou to Paul Weiss
+ Fixed for embedded object in object from Paul Weiss
+ Added support for direct insert of large XML data into XMLType fields from Hendrik Fuss & John Scoles
+ Fixed memory leak (not releasing Temp Lob with OCILobFreeTemporary) when created for a bind from John Scoles
+ Added support for bind_param_inout_array for use with execute_array from John Scoles
+ Added enhancement for Embedded Objects handling from Paul G. Weiss
+ Fixed to Makefile.PL let it read makefiles from other makes from Alexander V Alekseev
+ Updated POD to tell users to Avoid Using "SQL Call" from Charles Jardine
+ Updated POD to account for rt.cpan.org #30910: "DBD-Oracle crashes when trying to read empty LOB" from John Scoles
+ Added DBD::Oracle impdata/threads patch from Jeffrey Klein
+
+* Changes in DBD-Oracle 1.20(svn rev 10517) 11th January 2008
+
+ Fixed lob test so it skips the one test that relies on it if v$ session. from Rafael Kitover
+ Fixed // with /* */ in dbdimp.c from John Scoles
+ Fixed for execute_for_fetch in Oracle.pm returning 0 instead of 0E0. from Martin J. Evans
+ Added README.64bit.txt that contains help for compiling on 64 bit boxes from John Scoles
+ Fixed typo in Oracle.pm from Tom R.
+ Added support for ora_charset, ora_ncharset from Stephen J. Smith
+ Fixed Makefile.PL for better handling of empty array in File::Find::find from Slaven Rezic
+ Fixed references to README.clients.txt in Makefile.PL from John Scoles
+ Added PERL_NO_GET_CONTEXT for better multi-threaded support from John Scoles
+ Changed required version of DBI to be 1.51 from John Scoles
+ Fixed bug in 31lob.t from John Scoles
+ Added notes on installing Instantclient .rpm to README.Lunix.txt
+ Added support for OCI array bind from Alexander V Alekseev
+ Added support for select of OCI Embedded Objects from John Scoles
+ Added a tip in README.64bit.txt from cartmanltd
+ Added fix to Makefile.PL for finding SQLplus for Ubuntu Server (but should work for others) from Martin J. Evans
+ Added fix to Makefile.PL for Gentoo AMD64 from Tom R.
+ Added fix to dbdimp.c for speed up of Null-Operations from Andreas Behal
+ Added fix to dbdimp.c for SQLCS_NCHAR index use on varchar2s from Peter J. Holzer
+
+* Changes in DBD-Oracle 1.19 (svn rev 8002) 3rd November 2006
+
+ Fixed execute_array to comply with DBI standard from Martin J. Evans, Xho Jingleheimerschmidt and others
+ Fixed execute_array so it will not throw a Perl warning on undef values in Tuples from John Scoles
+ Fixed execute_array so it will take the ora_array_chunk_size DB handle attribute
+ Fixed some typos in code and READMEs from John Scoles
+ Fixed a few other little bugs dealing with compatibility with Oracle 8
+ Changes to README from Karl Auer
+ Suppress warning in 26exe_array.t from Philip Garrett
+ Added support for array context aware execute_for_fetch from Martin J. Evans
+ Fixed Makefile.PL for an incompatibility with ExtUtils::MM_Unix v1.50 (invoked byExtUtils::MakeMaker) from Dennis McRitchie
+ Updated POD to reflect that OCI after 9.2 no longer strips trialing spaces
+
+
+* Changes in DBD-Oracle 1.18 (svn rev 6697)
+
+ Added support for native Oracle Array interface thanks Kristian Nielsen
+ Added suppot for LOB Locators from Jeffrey Klein.
+ Updated README.win32.txt for Oracle 10xe and new Visual C++ version
+ Updated README.lunix.txt for work-araound for UTF8 bug
+ Fixed a number of compile warings
+
+please enjoy.
+
+* Changes in DBD-Oracle 1.17 (svn rev 3726)
+
+ Updated README.win32.txt fixed some typos
+ Fixed expanded support for Lobs support from Jeffrey Klein
+ Added notes on expanded support for Lobs to Oracle.pm
+
+* Changes in DBD-Oracle 1.17 (svn rev 3725)
+
+ Added expanded support for Lobs from Jeffrey Klein
+
+* Changes in DBD-Oracle 1.17 (svn rev 2487) 7th February 2006
+
+ NOTE: With this release of DBD::Oracle pythian.com (http://www.pythian.com)
+ are taking on the role of lead maintainer - with my support and gratitude.
+ John Scoles at pythian.com is now the man in the hot seat for support and
+ maintenance!
+
+ Fixed automatic csform setting for some UTF8 cases and for Oracle 8.0
+ Fixed truncation error on fetch into UTF8 charset thanks to Honza Pazdziora.
+ Fixed INTERVAL DAY TO SECOND thanks to Honza Pazdziora.
+ Fixed unicode tests for cygwin thanks to Andy Hassall.
+ Fixed undef warnings when connecting with undef $user.
+ Fixed undef warnings from $dbh->get_info(18);
+ Fixed LOB streaming example thanks to Pablo Zorzoli.
+
+ Added support for nested cursors in select lists thanks to Charles Jardine.
+ Added "Trailing Spaces" section to docs thanks to Michael A Chase.
+ Added support for binary floats/doubles thanks to Dennis Box.
+ Added INSTANCE_NAME, SERVER and SERVICE_NAME as valid connect keywords
+ in the 'dbi:Oracle:x=y' short form of connecting without tnsnames.ora.
+ For example 'dbi:Oracle:host=localhost;service_name=xe;server=dedicated'
+ Added auto-detection of ORACLE_HOME in some configurations.
+
+ Changed "Binding Cursors" docs, clarifying examples thanks to Charles Jardine.
+ Changed tests to use ORACLE_DSN or DBI_DSN env vars if defined thanks to Jill Vogel.
+ Updated README.vms re logical name tables thanks to Jakob Snoer.
+ Removed README.utf8 since the topic was covered better in the main docs.
+ Updated README.hpux.txt and restructured examples thanks to H.Merijn Brand.
+ Updated README.aix thanks to Stephen de Vries and Nathan Vonnahme.
+ Updated README.macosx thanks to Stephen de Vries.
+ Renamed README.*'s to add .txt suffix to make life easier for some.
+
+ Changes to Makefile.PL:
+ Instant Client support thanks to Hilmar Lapp, John Scoles and others.
+ Improved HP-UX support thanks to H.Merijn Brand.
+ Avoid risk of sqlplus hanging thanks to Mark Dedlow.
+ More reliably use correct sqlplus thanks to Honza Pazdziora.
+ Improved build rule and Oracle header file detection.
+ Improved cygwin build thanks to Andy Hassall.
+ VMS logical name checks thanks to Jakob Snoer.
+
+ The Copyright terms for DBD::Oracle have been simplified and now read:
+ The DBD::Oracle module is free open source software; you can
+ redistribute it and/or modify it under the same terms as Perl 5.
+
+* Changes in DBD-Oracle 1.16 (svn rev 515) 22nd October 2004
+
+ NOTE:
+ This release has major changes to Unicode support. See below.
+ It no longer supports the old Oracle 7 OCI interface.
+ It requires DBI >= 1.38 for some of the tests if using Perl 5.6.
+ It no longer supports Perl 5.5 or earlier.
+
+ Fixed placeholder names to be case insensitive thanks to Charles Jardine.
+ Fixed some LOB test problems with Oracle 8.1.7 by implementing ora_lob_append
+ with OCILobGetLength() and OCILobWrite(), instead of buggy OCILobWriteAppend(),
+ if the Oracle client version is < 9.0. Thanks to Jeff Urlwin.
+ Fixed handling of temporary LOBs thanks to Chris Donnelly.
+ Fixed memory leaks in auto LOB refetch code thanks to Dongqiang Bai.
+ Fixed reporting of length truncated in error message thanks to Jeff Urlwin.
+ Fixed column_info() to handle TIMESTAMP and INTERVAL datatypes
+ for Oracle >= 8 thanks to Stephen Clouse.
+ Fixed STORE to cache attribute value in handle cache.
+ Fixed seg fault returning LOB Locators reported by Raj Chandran.
+ Fixed binding to allow overloaded scalars (not for 'inout' params).
+ Fixed setting of $DBI::err to 0 triggering PrintWarn in DBI >= 1.41.
+ Fixed some edge cases in row cache sizing.
+ Fixed truncation error fetching very small numbers (1 ^ -130).
+ Fixed Oraperl to not enable PrintError or AutoCommit (broken since 1.13).
+
+ Changed some utf8 internals for LOBs.
+ Changed ORA_OCI constant from being just 7 or 8 to being a dualvar:
+ in numeric context returns the major.minor version number (8.1, 9.2 etc)
+ in string context it returns the full "major.minor.foo.bar" version string.
+ Changed some SUCCESS_WITH_INFO situtions to be treated as a "warning"
+ by setting $DBI::err to "0" (and so trigger PrintWarn in DBI >= 1.43)
+ eg "ORA-28011: the account will expire soon; change your password now"
+ and package compilation errors.
+
+ Added automatic support for UTF-8 for both NLS_LANG and NLS_NCHAR
+ Many thanks to Lincoln Baxter who did most of the hard work and testing
+ and to Jeff Urlwin and others who also helped out.
+ Perl 5.8.x and Oracle 9+ are highly recommended if you want to use Unicode.
+ See POD for more information and documentation.
+ Added support for "... RETURNING lob_locator_column INTO ?"
+ using $sth->bind_param_inout(2, \$loc, 0, {ora_type => ORA_BLOB});
+ Added bind_param() ora_csform, ora_csid, and ora_maxdata_size attributes.
+ Added bind_param() support for SQL_BLOB & SQL_CLOB thanks to Stephen Clouse.
+ Added $dbh->ora_can_unicode and $dbh->ora_nls_parameters thanks to Andy Hassall.
+
+ Documentation changes:
+ Corrected typo in ora_lob_read() example thanks to Johannes Wierny.
+ Corrected LOB example thanks to Sascha Pfalz and Thomas Upton.
+ Updated README.macosx thanks to Hilmar Lapp.
+ Updated README.hpux thanks to Gram Ludlow and Lincoln Baxter.
+ Added $dbh->reauthenticate($user,$pass) docs thanks to Andy Hassall.
+ Added $dbh->{ora_parse_error_offset} docs thanks to Andy Hassall.
+ Added gcc example to README.aix thanks to Adrian Terranova.
+ Added INSERT ... RETURNING ... example prompted by Steven Lembark.
+
+ Build Changes:
+ Fixed build32/build64 Makefile.PL bug spotted by Sean Kelly.
+ Fixed Oracle version detection on clients thanks to Marko Asplund.
+ Fixed Oracle 10 version detection on clients thanks to Andy Hassall.
+ Fixed HP-UX 64bit build issues thanks to Weiguo Sun.
+ Fixed VMS build issues thanks to Jakob Snoer.
+ Fixed suprious warning from Makefile.PL thanks to Marko Asplund.
+ Fixed compiler warnings thanks to Robert Baron.
+ Fixed oci.def for Cygwin by adding OCILobWriteAppend thanks to Gert-Jan Paulissen.
+ Changed to use ANSI C prototypes thanks to Steffen Goeldner.
+ Changed to not warn if ORACLE_HOME env var is not defined
+ as it's not used with Oracle's new 'Instant Client'.
+ Added Test::More as a prerequisite module.
+ Added many Unicode related tests thanks to Lincoln Baxter.
+
+* Changes in DBD-Oracle 1.15 27th January 2004
+
+ NOTE: DBD::Oracle now requires DBI version 1.28 (June 2002) or later.
+
+ NOTE: This is probably the last release that will support being
+ built with the old Oracle 7 OCI interface.
+
+ NOTE: This release will build for perl 5.5 only after some manual edits
+ which are detailed in README.help. Future releases may not build for 5.5.
+ Perl 5.5.3 is very old and and upgrading to at least 5.6.1 is recommended.
+ The DBI itself has required perl >= 5.6.0 since DBI 1.38, August 2003.
+
+ Fixed Makefile.PL for HPUX thanks to H.Merijn Brand & Sweth Chandramouli.
+ Fixed Makefile.PL for handling 32/64bit libs thanks to Lincoln Baxter,
+ Sean Kelly, Joel Van Boeckel and others. Oh the fun we've had.
+ Fixed Makefile.PL error typo thanks to Martijn Koster.
+ Fixed to build okay for Oracle 8.0.x and for older C compilers.
+ Fixed minor omission in t/ph_test.t thanks to Tom Malaher.
+ Fixed for extproc_perl (http://search.cpan.org/author/JHORWITZ/extproc_perl/)
+ Fixed Oraperl handling of ora_errno and ora_errstr thanks to Martin Busik.
+ Fixed PRECISION for "NUMBER" to be 126 not 0 thanks to Steffen Goeldner.
+ Fixed bind_param_inout() for placeholders not assigned to in PL/SQL.
+
+ Changed bind_param_inout for CHAR types to no longer use a minimum
+ length of 28 characters. Warning: this change may break code that
+ doesn't pass bind_param_inout() a length value large enough for the
+ returned string. (The minimum length was not documented and should
+ not have been relied upon. This change currently only applies to the
+ CHAR type but may extended to all string types in a later release.)
+ Changed type_info_all() to return the same type info as Oracle's own
+ ODBC driver does, thanks to Andy Hassall for the data.
+ The types include LOBs but not the new TIMESTAMP and INTERVAL types.
+
+ Added direct access to LOB Locators and major LOB Locator functions
+ such as $sth->ora_lob_read(...), $sth->ora_lob_write(...) etc.
+ This work was sponsored by Geospiza Inc.
+ Added LOB Locator example docs thanks to Mark Dilger at Geospiza.
+ Added TIMESTAMP [WITH [LOCAL] TIME ZONE]] support
+ thanks to Stephen Clouse and Robert Wyrick.
+ Added INTERVAL YEAR TO MONTH, INTERVAL DAY TO SECOND support.
+ Added warning for bad DSN string format thanks to Michael A Chase.
+ Added /*+RULE*/ hint to metadata method SQL thanks to Andy Hassall.
+ Added README.linux thanks to William Fishburne, Stephen Clouse and Brent LaVelle.
+ Added README.aix thanks to KC, Mike Paladino and Rafael Caceres.
+ Added connect example using OS authentication thanks to Bob Thomson.
+ Added prepare("...", { ora_placeholders => 0 }) to disable placeholders.
+ Added docs for returning a recordset (table/array) using Oracle >=9.0.1
+ via "FUNCTION foo RETURN type PIPELINED" thanks to Steve Baldwin.
+ Added docs on ora_check_sql=>0 in prepare() to avoid server-side parses.
+ Added support for sharing database connections with ProC/SQLLIB code
+ via ora_use_proc_connection attribute, thanks to Kristian Nielsen
+ needs build time option thanks to Steffen Goeldner
+ Added (restored) the error "possibly near <*> indicator" marker for
+ syntax errors thanks to Jason Hitt and Andy Hassall.
+ Added $dbh->{ora_parse_error_offset} attribute thanks to Andy Hassall.
+ Added auto setting of $dbh->{Username} if not given to connect
+ i.e. using Oracle OS authentication and connecting as "/"
+ by selecting SYS_CONTEXT('userenv','session_user') from the db
+ thanks to Eric Lenio and Andy Hassall.
+
+ Updated README.macosx thanks to Danial Pearce and William Goedicke.
+ Updated README.help for UnixWare thanks to Earle Nietzel.
+ Updated PL/SQL cursor examples, plus Oracle.ex/README and curref.pl
+ examples thanks to Michael A Chase.
+ Updated PL/SQL example setup thanks to Bob Kline.
+
+* Changes in DBD-Oracle 1.14 27th March 2003
NOTE: OCI 7 and Oraperl will not be supported in future releases.
@@ -13,7 +963,7 @@
Updated README.hpux thanks to H.Merijn Brand, Jay Strauss, and Lincoln Baxter.
Updated README and README.utf8 with minor changes thanks to Alexey Mahotkin.
-=head1 Changes in DBD-Oracle 1.13 14th March 2003
+* Changes in DBD-Oracle 1.13 14th March 2003
Fixed null user issue when using OS Authentication thanks to Christopher R. Baker
Fixed precision for Raw types in oci7.c thanks to J.D. Laub.
@@ -54,7 +1004,7 @@
Updated tests and Oraperl.pm to not use old style connect (deprecated in DBI 1.33).
-=head1 Changes in DBD::Oracle 1.12 31th August 2001
+* Changes in DBD::Oracle 1.12 31th August 2001
Improved LD_RUN_PATH code in Makefile.PL thanks to John Groenveld.
Improved HPUX code in Makefile.PL thanks to H.Merijn Brand.
@@ -62,7 +1012,7 @@
Updated $dbh->primary_key_info() to new DBI spec thanks to Steffen Goeldner.
Version 1.11 was skipped (uploaded to PAUSE with an error).
-=head1 Changes in DBD::Oracle 1.10 30th August 2001
+* Changes in DBD::Oracle 1.10 30th August 2001
Explicitly require DBI version 1.20 (or later).
Support multiple oracle home's in Win32 registry thanks to Jeff Urlwin.
@@ -71,7 +1021,7 @@
Fixed t/ph_type.t to be better behaved thanks to Ville Skytta.
Added OCI8 handle/descriptor name to trace output for some API calls.
-=head1 Changes in DBD::Oracle 1.09 27th August 2001
+* Changes in DBD::Oracle 1.09 27th August 2001
Changed behaviour when OCIStmtExecute() returns OCI_SUCCESS_WITH_INFO:
used to be treated as OCI_SUCCESS, now also sets $DBI::err/$DBI::errstr
@@ -113,7 +1063,7 @@
Added more notes to README.java thanks to Peter Ludemann and Dave C.
Added more notes to README.login thanks to Geoff Young.
-=head1 Changes in DBD::Oracle 1.08 7th August 2001
+* Changes in DBD::Oracle 1.08 7th August 2001
Fix Oracle 7 build broken in previous release.
Fix for 64bit builds thanks to Alan Burlison.
@@ -123,7 +1073,7 @@
when using Oracle >= 8.1.x (untested at the moment)
Updated Makefile.PL and README.hpux thanks to Lincoln Baxter.
-=head1 Changes in DBD::Oracle 1.07 5th June 2001
+* Changes in DBD::Oracle 1.07 5th June 2001
This release is mostly targeted at the needs of the new Oracle::OCI module.
It's not a general release and not recommended for production use.
@@ -141,12 +1091,12 @@
in relation to the start of some basic array support.
Updated email and web page details to dbi-users@perl.org and dbi.perl.org.
-=head1 Changes in DBD::Oracle 1.06 14th July 2000
+* Changes in DBD::Oracle 1.06 14th July 2000
Fixed ora_ph_type attribute to allow 96 or 97.
Fixed compile failure with Oracle 7.
-=head1 Changes in DBD::Oracle 1.05 13th July 2000
+* Changes in DBD::Oracle 1.05 13th July 2000
Added $dbh->{ora_ph_type} attribute to define default bind type:
1=> VARCHAR2, does strip trailing spaces, embedded \0 bytes okay
@@ -165,7 +1115,7 @@
Re-enable row cache by default for OCI8 (can give big speed increase).
Fixed bug in OCI8 row cache calculation thanks to Greg Stark.
-=head1 Changes in DBD::Oracle 1.04 11th July 2000
+* Changes in DBD::Oracle 1.04 11th July 2000
Added info on workarounds for Java thread related linker errors
on Solaris with Oracle 8.1.6. Thanks to Andi Lamprecht.
@@ -181,7 +1131,7 @@
Improved reliability of ping method.
Fixed broken SQL type warning in bind_param.
-=head1 Changes in DBD::Oracle 1.03 12th July 1999
+* Changes in DBD::Oracle 1.03 12th July 1999
Added "perl Makefile.PL -b" configure option. Links DBD::Oracle
using same linker args as Oracle's own OCI demo applications.
@@ -195,7 +1145,7 @@
Enhanced $dbh->func('plsql_errstr') output.
Replaced old Oraperl examples with DBI/DBD::Oracle ones.
-=head1 Changes in DBD::Oracle 1.02 14th June 1999
+* Changes in DBD::Oracle 1.02 14th June 1999
LongReadLen no longer limited to 64KB for OCI 7 & 8!
But beware of OCI 7 bug when fetching >64KB.
@@ -203,7 +1153,7 @@
Fixed OCI7 ref cursor missing data row.
Fixed OCI8 LOB statement handle leak & improved trace.
-=head1 Changes in DBD::Oracle 1.01 8th June 1999
+* Changes in DBD::Oracle 1.01 8th June 1999
Enhanced diagnostics in t/long.t test suite.
Removed byte with high-bit set from t/long.t test data.
@@ -212,7 +1162,7 @@
Added Cygwin support thanks to Alexander Smishlajev.
Fixed 'undeclared identifier' error building with old Oracle's.
-=head1 Changes in DBD::Oracle 1.00 4th June 1999
+* Changes in DBD::Oracle 1.00 4th June 1999
Increased default row cache size for improved performance.
Added OCI8 binding of cursors! Sponsored by cp.net.
@@ -231,14 +1181,14 @@
Fixed ora_check_sql prepare attribute (for selects).
Fetch errors (non-row level) now turn off the Active attribute.
-=head1 Changes in DBD::Oracle 0.61, 9th April 1999
+* Changes in DBD::Oracle 0.61, 9th April 1999
Fixed execute() always returning 0 rows! (with OCI 7).
Fixed $sth->bind_param(..., SQL_CHAR);
Assorted minor Makefile.PL improvements.
Added ora_check_sql attribute to prepare() for OCI8.
-=head1 Changes in DBD::Oracle 0.60, 10th March 1999
+* Changes in DBD::Oracle 0.60, 10th March 1999
Fetching all records now resets Active flag as it should.
Finally fixed "Can't bind unknown placeholder" (hopefully :-).
@@ -257,7 +1207,7 @@
Modified hints/svr4.pl - SVR4 users please test.
Updated Alan Burlison's ora_explain Tk tool to version 1.0.
-=head1 Changes in DBD::Oracle 0.59 (Oraperl 1.37), 27th December 1998
+* Changes in DBD::Oracle 0.59 (Oraperl 1.37), 27th December 1998
Fixed detection of ambiguous LOB-param-to-table-field assignment
(previous fix had typo). Only affects multiple LOBs in same table.
@@ -266,17 +1216,17 @@
Cleaned up the code.
Improved Oracle 8 library selection code for Win32 (untested).
-=head1 Changes in DBD::Oracle 0.58 (Oraperl 1.37), 22nd December 1998
+* Changes in DBD::Oracle 0.58 (Oraperl 1.37), 22nd December 1998
Fixed detection of ambiguous LOB-param-to-table-field assignment.
Added bind_param ora_field attribute to disambiguate if needed.
-=head1 Changes in DBD::Oracle 0.57 (Oraperl 1.37), 21st December 1998
+* Changes in DBD::Oracle 0.57 (Oraperl 1.37), 21st December 1998
Fixed bug preventing fetching LONGs when using OCI 8, better.
(Oracle bug #641812 not involved. Should work for all 8.0.x)
-=head1 Changes in DBD::Oracle 0.56 (Oraperl 1.37), 19th December 1998
+* Changes in DBD::Oracle 0.56 (Oraperl 1.37), 19th December 1998
Fixed bug preventing fetching LONGs when using OCI 8.
(Oracle bug #641812 may still cause failure prior to v8.0.5.)
@@ -284,7 +1234,7 @@
Fixed bug in table name detection code for OCI8 LOB refetch.
SCALE & PRECISION work for OCI 7 & 8.
-=head1 Changes in DBD::Oracle 0.55 (Oraperl 1.37), 16th December 1998
+* Changes in DBD::Oracle 0.55 (Oraperl 1.37), 16th December 1998
Major internal work to support Oracle 8 OCI.
Oracle 8 LOBs are supported and treated as LONGs (DBD::Oracle works
@@ -297,7 +1247,7 @@
Builds with 5.004_04, 5.005_02 and 5.005_54 (not _53).
Added "use DBD::Oracle qw(:ora_types);"
-=head1 Changes in DBD::Oracle 0.54 (Oraperl 1.37), 14th August 1998
+* Changes in DBD::Oracle 0.54 (Oraperl 1.37), 14th August 1998
Added $dbh->type_info_all.
Fixed $dbh->tables (partly by renaming to new $dbh->table_info).
@@ -309,14 +1259,14 @@
now be disabled by setting the env var DBD_ORACLE_SIGCHLD=0.
Fixed Makefile.PL -c to better avoid shared Oracle lib.
-=head1 Changes in DBD::Oracle 0.53 (Oraperl 1.37), 3rd August 1998
+* Changes in DBD::Oracle 0.53 (Oraperl 1.37), 3rd August 1998
Further build fixes (esp kpudc problem with Oracle 8).
Now prefers oracle.mk over proc.mk again.
Only $ENV{ORA_CLIENT_LIB} ||= 'shared' if shared lib exists.
Builds okay with 5.005-thread (not tested).
-=head1 Changes in DBD::Oracle 0.52 (Oraperl 1.37), 28th July 1998
+* Changes in DBD::Oracle 0.52 (Oraperl 1.37), 28th July 1998
Assorted build fixes (esp. Win32, HP-UX and AIX).
More hints on error messages, especially long truncation and
@@ -324,7 +1274,7 @@
Compiles okay now for systems without SQLT_CUR defined.
Only sets SA_RESTART on SIGCLD if connect was successful.
-=head1 Changes in DBD::Oracle 0.51 (Oraperl 1.37), 5rd July 1998
+* Changes in DBD::Oracle 0.51 (Oraperl 1.37), 5rd July 1998
Makefile.PL no longer tries to link with just -lclntsh directly :-(
Improvements to some HP-UX builds (hopefully).
@@ -332,7 +1282,7 @@
connect failure now shows actual Oracle error message again.
Initial (incomplete) support for binding cursor vars (see t/plsql.t).
-=head1 Changes in DBD::Oracle 0.50 (Oraperl 1.36), 3rd June 1998
+* Changes in DBD::Oracle 0.50 (Oraperl 1.36), 3rd June 1998
Makefile.PL changes: fixed -c option, now searches for .h files,
tries alternate location for sysliblist, checks for executable
@@ -340,7 +1290,7 @@
Fixed cursor leak.
Added first word of tnsnames.ora name as aliases if no clash.
-=head1 Changes in DBD::Oracle 0.49 (Oraperl 1.36), 1st June 1998
+* Changes in DBD::Oracle 0.49 (Oraperl 1.36), 1st June 1998
Further improvements to build process over 0.48.
Fixed broken truncation error in 0.48.
@@ -349,7 +1299,7 @@
Added $sth->{ora_cache_rows} and $sth->{ora_est_row_width}
as read-only attributes to make cache size logic easier to test.
-=head1 Changes in DBD::Oracle 0.48 (Oraperl 1.36), 25th May 1998
+* Changes in DBD::Oracle 0.48 (Oraperl 1.36), 25th May 1998
THIS IS AN EXPERIMENTAL RELEASE - USE WITH CAUTION!
Now links to -lclntsh directly (Thanks to Bruce Nelson and others)
@@ -365,7 +1315,7 @@
Improved quality and clarity of trace information.
Requires DBI 0.92
-=head1 Changes in DBD::Oracle 0.47 (Oraperl 1.35), 8th Sept 1997
+* Changes in DBD::Oracle 0.47 (Oraperl 1.35), 8th Sept 1997
$h->{InactiveDestroy} = 1; now works reliably (with DBI 0.90).
Makefile.PL changed for Oracle8. Thanks to Philippe Vanhaesendonck.
@@ -379,7 +1329,7 @@
LongReadLen now works (if $Oraperl::ora_trunc unset or <= 0)
LongTruncOk now works (for non oraperl mode handle).
-=head1 Changes in DBD::Oracle 0.46 (Oraperl 1.34), 20th June 1997
+* Changes in DBD::Oracle 0.46 (Oraperl 1.34), 20th June 1997
Fixed Makefile.PL to work with 5.004_01.
Some VMS support from Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
@@ -387,7 +1337,7 @@
bind_param_inout now checks for read-only variables.
Requires DBI 0.84.
-=head1 Changes in DBD::Oracle 0.45 (Oraperl 1.33), 16th June 1997
+* Changes in DBD::Oracle 0.45 (Oraperl 1.33), 16th June 1997
A $dbh DESTROY without an explicit disconnect does a rollback.
Note that this may 'break' existing 'lazy' code but is completely
@@ -429,7 +1379,7 @@
with the exception that it cannot be placed on a CD-ROM or similar media
for commercial distribution without the prior approval of the author.
-=head1 Changes in DBD::Oracle 0.44 (Oraperl 1.30), 14th Jan 1997
+* Changes in DBD::Oracle 0.44 (Oraperl 1.30), 14th Jan 1997
Fixed leak in read_blob (thanks to Jurgen Botz for the patch).
Improved automatic cache sizing (so better default caching).
@@ -444,7 +1394,7 @@
Makefile.PL deletes non-existant files from $(COMPOBJS)
(thanks to aburlison@cix.compulink.co.uk for the original patch)
-=head1 Changes in DBD::Oracle 0.43 (Oraperl 1.30), 29nd Oct 1996
+* Changes in DBD::Oracle 0.43 (Oraperl 1.30), 29nd Oct 1996
Fixed serious 'false ora_errno 1 after short select' bug.
Worked around oracle bug that makes cda->ft unreliable.
@@ -455,7 +1405,7 @@
select between oexec() and oexfet() in execute().
Added more internal debugging. Improved test.pl.
-=head1 Changes in DBD::Oracle 0.42 (Oraperl 1.30), 28nd Oct 1996
+* Changes in DBD::Oracle 0.42 (Oraperl 1.30), 28nd Oct 1996
Fixed serious 'cache empty after re-bind' bug.
Do not use DBD::Oracle 0.41.
@@ -464,7 +1414,7 @@
Many selects now make only one trip to Oracle (after prepare)
which combines the execute and fetching multiple rows.
-=head1 Changes in DBD::Oracle 0.41 (Oraperl 1.30), 22nd Oct 1996
+* Changes in DBD::Oracle 0.41 (Oraperl 1.30), 22nd Oct 1996
Added the long overdue row cache to DBD::Oracle.
(Thanks to Reetnem@aol.com for providing a patch that prompted
@@ -475,7 +1425,7 @@
Added a more internal debugging.
Further updates to the README files.
-=head1 Changes in DBD::Oracle 0.40 (Oraperl 1.29), 14th Oct 1996
+* Changes in DBD::Oracle 0.40 (Oraperl 1.29), 14th Oct 1996
WARNING - This release contains significant changes to the
placeholding binding code. You should test it carefully
@@ -491,7 +1441,7 @@
Fixed bind_param ora_type attribute. Thanks to Stephen Zander
for the patch. Updated README's. Added README.longs.
-=head1 Changes in DBD::Oracle 0.39 (Oraperl 1.29), 23rd Sep 1996
+* Changes in DBD::Oracle 0.39 (Oraperl 1.29), 23rd Sep 1996
Fix for DEC "target := MACRO = string" Makefile syntax.
Added README notes from Dave Moellenhoff, Lou Henefeld and others.
@@ -501,7 +1451,7 @@
Extra parameters to ora_do are now passed to DBI's do().
(This is an extension to the original oraperl ora_do.)
-=head1 Changes in DBD::Oracle 0.38 (Oraperl 1.28), 22th Aug 1996
+* Changes in DBD::Oracle 0.38 (Oraperl 1.28), 22th Aug 1996
Overhaul of Makefile variable parsing. Should now cope with
complex variables which expand to nested shell escapes.
@@ -509,14 +1459,14 @@
Updated README, Makefile.PL and test.pl messages for clarity.
Fixed possible memory corruption in dbd_bind_ph().
-=head1 Changes in DBD::Oracle 0.37 (Oraperl 1.28), 25th July 1996
+* Changes in DBD::Oracle 0.37 (Oraperl 1.28), 25th July 1996
Fixed Makefile.PL for Oracle 7.3.2.
Fixed $num_fields = ora_fetch($csr) before first fetch for
queries with bind vars.
Fixed occasional core dump on global destruct.
-=head1 Changes in DBD::Oracle 0.36 (Oraperl 1.28), 10th July 1996
+* Changes in DBD::Oracle 0.36 (Oraperl 1.28), 10th July 1996
Fixed bind_param ora_type attribute.
Fixed preparse to allocate enough memory for worst case.
@@ -524,12 +1474,12 @@
Other assorted Makefile.PL improvements.
(Many thanks to those who sent in fixes.)
-=head1 Changes in DBD::Oracle 0.35 (Oraperl 1.28), 21st June 1996
+* Changes in DBD::Oracle 0.35 (Oraperl 1.28), 21st June 1996
Fixed broken Solaris 2.5 check in Makefile.PL.
Added ld path to the log.
-=head1 Changes in DBD::Oracle 0.34 (Oraperl 1.28), 21st June 1996
+* Changes in DBD::Oracle 0.34 (Oraperl 1.28), 21st June 1996
Workaround Solaris 2 bug #1224467 (_rmutex_unlock).
With many thanks to James Taylor.
@@ -541,7 +1491,7 @@
Further additions to the README about Bad free()'s.
-=head1 Changes in DBD::Oracle 0.33 (Oraperl 1.27), 19th June 1996
+* Changes in DBD::Oracle 0.33 (Oraperl 1.27), 19th June 1996
Added Makefile.PL -g option to enable debugging.
Added Makefile.PL -s symbol_name option to search for symbols.
@@ -551,13 +1501,13 @@
Added README notes about -g option, core files and stack traces.
Small change to $dbname/$user/$passwd logic in connect.
-=head1 Changes in DBD::Oracle 0.32 (Oraperl 1.25), 30th May 1996
+* Changes in DBD::Oracle 0.32 (Oraperl 1.25), 30th May 1996
Fixed memory leak when FETCH'ing attributes.
Fixed Makefile.PL FileHandle problem (forgot 'use FileHandle;').
Enhanced Makefile.PL support for Oracle 7.3.
-=head1 Changes in DBD::Oracle 0.31 (Oraperl 1.25), 20th May 1996
+* Changes in DBD::Oracle 0.31 (Oraperl 1.25), 20th May 1996
Makefile.PL for HP-UX now defaults to dynamic for hpux >= 10.
@@ -571,7 +1521,7 @@
Fixed small memory leak in ora_titles etc functions.
-=head1 Changes in DBD::Oracle 0.30, 7th May 1996
+* Changes in DBD::Oracle 0.30, 7th May 1996
THE ORAPERL EMULATION LAYER IS NOW FORMALLY RELEASED (NO LONGER ALPHA).
@@ -585,18 +1535,18 @@
Fixed typecast warning (s/safefree/Safefree).
Automatically sets/resets ORACLE_HOME from oratab value for sid.
-
- TO DO: Automatic configuration from Oracle 7.3 is not yet working
+
+ TO DO: Automatic configuration from Oracle 7.3 is not yet working
(Oracle have reorganised the makefiles yet again!).
-=head1 Changes in DBD::Oracle 0.29, 2 March 1996
+* Changes in DBD::Oracle 0.29, 2 March 1996
Fixed Makefile.PL to get DBIXS.h from right spot.
Changes to suit perl5.002 and site_lib directories.
Detects old versions ahead of new in @INC.
Random tidy-ups.
-=head1 Changes in DBD::Oracle 0.28, 29 Jan 1996:
+* Changes in DBD::Oracle 0.28, 29 Jan 1996:
Minor release for Perl5.002 (beta2 or later).
Requires Perl5.002 and DBI 0.66;
@@ -604,7 +1554,7 @@
Only functional change is to suppress (rare) 'handle not setup'
warnings unless debugging.
-=head1 Changes in DBD::Oracle 0.27, 16 Nov 1995:
+* Changes in DBD::Oracle 0.27, 16 Nov 1995:
Improved oraperl compatibility in assorted ways.
Added the original oraperl manual to Oraperl.pm as pod.
@@ -626,14 +1576,14 @@
(The DBD::Oracle module itself will remain alpha for awhile yet.)
-=head1 Changes in DBD::Oracle 0.26, 23 Oct 1995:
+* Changes in DBD::Oracle 0.26, 23 Oct 1995:
Removed error message (sql) size limits in parse and ora_error.
Fixed FETCH NUM_OF_PARAMS so it doesn't trigger a describe.
The ora_lengths and ora_types attributes work in non-oraperl mode.
-=head1 Changes in DBD::Oracle 0.25, 26 Aug 1995:
+* Changes in DBD::Oracle 0.25, 26 Aug 1995:
User visible changes:
@@ -653,7 +1603,7 @@
Updated NEED_DBIXS_VERSION in Oracle.h
-=head1 Changes in DBD::Oracle 0.24, 22 Aug 1995:
+* Changes in DBD::Oracle 0.24, 22 Aug 1995:
User visible changes:
@@ -675,7 +1625,7 @@
and new DBI macros used to access fields.
-=head1 Changes in DBD::Oracle 0.23, 18 Aug 1995:
+* Changes in DBD::Oracle 0.23, 18 Aug 1995:
Fixed Oraperl.pm debug which was left on by default by accident.
Added small patches from Davide.Migliavacca@inferentia.it for
@@ -684,7 +1634,7 @@
Changed dbd_describe to return true for success (to be consistent).
-=head1 Changes in DBD::Oracle 0.22, 17 Aug 1995:
+* Changes in DBD::Oracle 0.22, 17 Aug 1995:
Much more maturity, in line with the required DBI-0.60 release.
The .xs file is now very 'clean'. It's an excellent base for
@@ -697,7 +1647,7 @@
Please test heavily.
-=head1 Changes in DBD::Oracle 0.21, 15 Aug 1995:
+* Changes in DBD::Oracle 0.21, 15 Aug 1995:
NOTE: THIS IS AN UNSTABLE RELEASE!
It requires the closely related DBI 0.59 release.
@@ -715,14 +1665,14 @@
In future oraperl mode handles will have those warnings disabled.
...other changes to numerous/minor to mention
-=head1 Changes in DBD::Oracle 0.20, 1 Aug 1995:
+* Changes in DBD::Oracle 0.20, 1 Aug 1995:
Fixed core dump when binding an undef (treated as a NULL)
Binding a string longer that 2000 bytes will use LONG type.
Workaround OSF makefile and oratype.h problems
PL/SQL := construct will no longer confuse dbd_preparse()
-=head1 Changes in DBD::Oracle 0.19, 21 June 1995:
+* Changes in DBD::Oracle 0.19, 21 June 1995:
Added $VERSION
disconnect_all now gives error 'not implemented'.
@@ -732,8 +1682,8 @@
&ora_do() now returns "OK" for 0 rows (as per oraperl).
Reworked logging to use DBILOGFP macro.
Now test code added to loop through logon/prep/fin/logoff.
-
-=head1 Changes in DBD::Oracle 0.18:
+
+* Changes in DBD::Oracle 0.18, 17th June 1995
Makefile.PL: HPUX now builds with LINKTYPE=static automatically.
Fixed errors on logout/global destruction.
@@ -745,4 +1695,69 @@
'readblob' => {'U'=>[4,5,'$field, $offset, $len [, \\$buf]']},
in order to access the new readblob method.)
-=cut
+* Changes in DBD::Oracle 0.17, 9th June 1995
+
+ Further enhancements to proc.mk parsing (this should fix
+ the bug introduced in the last version which required the
+ manual editing of -lora etc into the link line).
+ Automatic use of proc16.mk if proc.mk not found.
+ Automatic use of -Xa if compiler is 'clcc' (CenterLine).
+ Further migration of code from Oracle.xs to dbdimp.c. This is
+ not complete but may give you a flavor of my current direction.
+ Fixed more warnings from pedantic compilers.
+ [Released with DBI 0.56]
+
+* Changes in DBD::Oracle 0.16, 25 May 1995
+
+ Makefile.PL more robust and flexible.
+ Code restructured - much more still to do.
+ Changes to ora_do. It's probably still not right.
+ [Released with DBI 0.55]
+
+* Changes in DBD::Oracle 0.15, 25 Apr 1995
+
+ Fixed all known build problems/core dumps/truncated data etc.
+ Returns undef for NULLS.
+ Bind vars still not supported (soon I hope).
+ Bind vars produce errors rather than being ignored.
+ Login usage of ORACLE_SID and TWO_TASK slightly revised.
+ test.pl now uses ORACLE_SID, TWO_TASK and ORACLE_USER if defined.
+
+* Changes in DBD::Oracle 0.14, 5 Apr 1995
+
+ Fixed assorted build and core-dump problems.
+
+* Changes in DBD::Oracle 0.13, 8th March 1995
+
+ "Another alpha release but hey, guess what, this one actually allows
+ you to fetch data :-)"
+
+* Changes in DBD::Oracle 0.12, 1st March 1995
+
+ "For DBD::Oracle I have implemented a fairly radical way to deal with
+ the nightmare of Oracle OCI makefiles. Rather than try to maintain a
+ *large* and complicated set of Makefile macros the DBD::Oracle
+ Makefile.PL now actually extracts the macros which oracle itself uses
+ from $ORACLE_HOME/rdbms/lib/oracle.mk! (The horses mouth, so to speak.)"
+ [Released with DBI 0.53]
+
+* Changes in DBD::Oracle 0.11, 24th Feb 1995
+
+ "The first fruits of that work are now available for the brave (or
+ foolhardy). Take note: this very much *unsupported* *alpha* software
+ (it does not even fetch records from oracle yet). Feel free to ftp it
+ but don't expect to do anything very useful with it."
+ Also first release of the Oraperl emulation module:
+ "Yes, that's real oraperl code and it works! The only addition is
+ the 'use DBD::Oraperl' line."
+ [Released with DBI 0.51]
+
+* 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.
+
@@ -0,0 +1,44 @@
+
+This is the Perl distribution DBD-Oracle.
+
+Installing DBD-Oracle is straightforward.
+
+## Installation with cpanm
+
+If you have cpanm, you only need one line:
+
+ % cpanm DBD::Oracle
+
+If you are installing into a system-wide directory, you may need to pass the
+"-S" flag to cpanm, which uses sudo to install the module:
+
+ % cpanm -S DBD::Oracle
+
+## Installing with the CPAN shell
+
+Alternatively, if your CPAN shell is set up, you should just be able to do:
+
+ % cpan DBD::Oracle
+
+## Manual installation
+
+As a last resort, you can manually install it. Download the tarball, untar it,
+then build it:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+If you are installing into a system-wide directory, you may need to run:
+
+ % sudo make install
+
+## Documentation
+
+DBD-Oracle documentation is available as POD.
+You can run perldoc from a shell to read the documentation:
+
+ % perldoc DBD::Oracle
@@ -0,0 +1,379 @@
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+Terms of the Perl programming language system itself
+
+a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+b) the "Artistic License"
+
+--- The GNU General Public License, Version 1, February 1989 ---
+
+This software is Copyright (c) 1994 by Tim Bunce.
+
+This is free software, licensed under:
+
+ 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!
+
+
+--- The Artistic License 1.0 ---
+
+This software is Copyright (c) 1994 by Tim Bunce.
+
+This is free software, licensed under:
+
+ 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.
+ - "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 ftp.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) accompany any non-standard executables with their corresponding Standard
+ Version executables, giving the non-standard executables non-standard
+ names, and clearly documenting 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.
+
+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 whomever generated them, and may be sold
+commercially, and may be aggregated with this Package.
+
+7. C or perl subroutines supplied by you and linked into this Package shall not
+be considered part of this Package.
+
+8. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+9. 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.
+
+The End
+
@@ -1,56 +1,95 @@
+CONTRIBUTING.mkd
+CONTRIBUTORS
Changes
+INSTALL
+LICENSE
MANIFEST
+META.json
+META.yml
Makefile.PL
-Oracle.ex/Readme
-Oracle.ex/bind.pl
-Oracle.ex/commit.pl
-Oracle.ex/curref.pl
-Oracle.ex/ex.pl
-Oracle.ex/japh
-Oracle.ex/mktable.pl
-Oracle.ex/oradump.pl
-Oracle.ex/proc.pl
-Oracle.ex/sql
-Oracle.ex/tabinfo.pl
Oracle.h
-Oracle.pm
Oracle.xs
-Oraperl.pm
README
-README.clients
-README.explain
-README.help
-README.hpux
-README.java
-README.login
-README.longs
-README.macosx
-README.sec
-README.utf8
-README.win32
-README.wingcc Notes about building with mingw32 and cygwin32
+README.help.txt
+README.mkdn
Todo
dbdimp.c
dbdimp.h
-hints/svr4.pl
+dbivport.h
+examples/README
+examples/bind.pl
+examples/commit.pl
+examples/curref.pl
+examples/ex.pl
+examples/inserting_longs.pl
+examples/japh
+examples/mktable.pl
+examples/ora_explain.pl
+examples/oradump.pl
+examples/proc.pl
+examples/read_long_via_blob_read.pl
+examples/sql
+examples/tabinfo.pl
+hints/dgux.pl
hints/macos_bundle.syms
hints/macos_lib.syms
hints/macos_syms.pl
-hints/dgux.pl
+hints/svr4.pl
+lib/DBD/Oracle.pm
lib/DBD/Oracle/GetInfo.pm
-oci.def OCI.DLL export declarations
-oci7.c
+lib/DBD/Oracle/Object.pm
+lib/DBD/Oracle/Troubleshooting.pod
+lib/DBD/Oracle/Troubleshooting/Aix.pod
+lib/DBD/Oracle/Troubleshooting/Cygwin.pod
+lib/DBD/Oracle/Troubleshooting/Hpux.pod
+lib/DBD/Oracle/Troubleshooting/Linux.pod
+lib/DBD/Oracle/Troubleshooting/Macos.pod
+lib/DBD/Oracle/Troubleshooting/Sun.pod
+lib/DBD/Oracle/Troubleshooting/Vms.pod
+lib/DBD/Oracle/Troubleshooting/Win32.pod
+lib/DBD/Oracle/Troubleshooting/Win64.pod
+mkta.pl
+oci.def
oci8.c
ocitrace.h
-ora_explain.PL
-oraperl.ph Old oraperl file included for completeness of emulation
-t/base.t
-t/cursor.t
-t/general.t
-t/long.t
-t/meta.t
-t/ph_type.t
-t/plsql.t
-t/reauth.t
-t/select.t
-test.pl
+t/000-report-versions-tiny.t
+t/00versions.t
+t/01base.t
+t/10general.t
+t/12impdata.t
+t/14threads.t
+t/15nls.t
+t/20select.t
+t/21nchar.t
+t/22nchar_al32utf8.t
+t/22nchar_utf8.t
+t/23wide_db.t
+t/23wide_db_8bit.t
+t/23wide_db_al32utf8.t
+t/24implicit_utf8.t
+t/25plsql.t
+t/26exe_array.t
+t/28array_bind.t
+t/30long.t
+t/31lob.t
+t/31lob_extended.t
+t/32xmltype.t
+t/34pres_lobs.t
+t/36lob_leak.t
+t/38taf.t
+t/39attr.t
+t/40ph_type.t
+t/50cursor.t
+t/51scroll.t
+t/55nested.t
+t/56embbeded.t
+t/58object.t
+t/60reauth.t
+t/70meta.t
+t/80ora_charset.t
+t/lib/ExecuteArray.pm
+t/nchar_test_lib.pl
+t/rt13865.t
+t/rt74753-utf8-encoded.t
+t/rt85886.t
+typemap
@@ -0,0 +1,105 @@
+{
+ "abstract" : "Oracle database driver for the DBI module",
+ "author" : [
+ "Tim Bunce <timb@cpan.org>",
+ "John Scoles <byterock@cpan.org>",
+ "Yanick Champoux <yanick@cpan.org>",
+ "Martin J. Evans <mjevans@cpan.org>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Dist::Zilla version 5.014, CPAN::Meta::Converter version 2.140640",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "DBD-Oracle",
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "DBI" : "1.51",
+ "ExtUtils::MakeMaker" : "6.30"
+ }
+ },
+ "develop" : {
+ "requires" : {
+ "version" : "0.9901"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "DBI" : "0",
+ "DynaLoader" : "0",
+ "Exporter" : "0",
+ "perl" : "5.006",
+ "strict" : "0",
+ "warnings" : "0"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "B" : "0",
+ "Carp" : "0",
+ "Data::Dumper" : "0",
+ "Devel::Peek" : "0",
+ "Encode" : "0",
+ "Math::BigInt" : "0",
+ "Test::More" : "0.88",
+ "Thread::Semaphore" : "0",
+ "lib" : "0",
+ "utf8" : "0",
+ "vars" : "0"
+ }
+ }
+ },
+ "provides" : {
+ "DBD::Oracle" : {
+ "file" : "lib/DBD/Oracle.pm",
+ "version" : "1.74"
+ },
+ "DBD::Oracle::GetInfo" : {
+ "file" : "lib/DBD/Oracle/GetInfo.pm",
+ "version" : "1.74"
+ },
+ "DBD::Oracle::Object" : {
+ "file" : "lib/DBD/Oracle/Object.pm",
+ "version" : "1.74"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/pythian/DBD-Oracle/issues"
+ },
+ "homepage" : "http://search.cpan.org/dist/DBD-Oracle/",
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/pythian/DBD-Oracle.git",
+ "web" : "https://github.com/pythian/DBD-Oracle"
+ }
+ },
+ "version" : "1.74",
+ "x_authority" : "cpan:PYTHIAN",
+ "x_contributors" : [
+ "David E. Wheeler <david@justatheory.com>",
+ "David Perry <perry@pythian.com>",
+ "David Steinbrunner <dsteinbrunner@pobox.com>",
+ "Gwen Shapira <shapira@pythian.com>",
+ "Joe Crotty <joe.crotty@returnpath.net>",
+ "Michael Portnoy <portnoy@pythian.com>",
+ "StephenCIQG <StephenCIQG@50811bd7-b8ce-0310-adc1-d9db26280581>",
+ "cjardine <cjardine@50811bd7-b8ce-0310-adc1-d9db26280581>",
+ "gregor herrmann <gregoa@debian.org>",
+ "jurl <jurl@50811bd7-b8ce-0310-adc1-d9db26280581>",
+ "lbaxter <lbaxter@50811bd7-b8ce-0310-adc1-d9db26280581>",
+ "robert <robert@50811bd7-b8ce-0310-adc1-d9db26280581>"
+ ],
+ "x_help_wanted" : [
+ "developer",
+ "documenter",
+ "tester"
+ ]
+}
+
@@ -0,0 +1,69 @@
+---
+abstract: 'Oracle database driver for the DBI module'
+author:
+ - 'Tim Bunce <timb@cpan.org>'
+ - 'John Scoles <byterock@cpan.org>'
+ - 'Yanick Champoux <yanick@cpan.org>'
+ - 'Martin J. Evans <mjevans@cpan.org>'
+build_requires:
+ B: '0'
+ Carp: '0'
+ Data::Dumper: '0'
+ Devel::Peek: '0'
+ Encode: '0'
+ Math::BigInt: '0'
+ Test::More: '0.88'
+ Thread::Semaphore: '0'
+ lib: '0'
+ utf8: '0'
+ vars: '0'
+configure_requires:
+ DBI: '1.51'
+ ExtUtils::MakeMaker: '6.30'
+dynamic_config: 0
+generated_by: 'Dist::Zilla version 5.014, CPAN::Meta::Converter version 2.140640'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: DBD-Oracle
+provides:
+ DBD::Oracle:
+ file: lib/DBD/Oracle.pm
+ version: '1.74'
+ DBD::Oracle::GetInfo:
+ file: lib/DBD/Oracle/GetInfo.pm
+ version: '1.74'
+ DBD::Oracle::Object:
+ file: lib/DBD/Oracle/Object.pm
+ version: '1.74'
+requires:
+ DBI: '0'
+ DynaLoader: '0'
+ Exporter: '0'
+ perl: '5.006'
+ strict: '0'
+ warnings: '0'
+resources:
+ bugtracker: https://github.com/pythian/DBD-Oracle/issues
+ homepage: http://search.cpan.org/dist/DBD-Oracle/
+ repository: https://github.com/pythian/DBD-Oracle.git
+version: '1.74'
+x_authority: cpan:PYTHIAN
+x_contributors:
+ - 'David E. Wheeler <david@justatheory.com>'
+ - 'David Perry <perry@pythian.com>'
+ - 'David Steinbrunner <dsteinbrunner@pobox.com>'
+ - 'Gwen Shapira <shapira@pythian.com>'
+ - 'Joe Crotty <joe.crotty@returnpath.net>'
+ - 'Michael Portnoy <portnoy@pythian.com>'
+ - 'StephenCIQG <StephenCIQG@50811bd7-b8ce-0310-adc1-d9db26280581>'
+ - 'cjardine <cjardine@50811bd7-b8ce-0310-adc1-d9db26280581>'
+ - 'gregor herrmann <gregoa@debian.org>'
+ - 'jurl <jurl@50811bd7-b8ce-0310-adc1-d9db26280581>'
+ - 'lbaxter <lbaxter@50811bd7-b8ce-0310-adc1-d9db26280581>'
+ - 'robert <robert@50811bd7-b8ce-0310-adc1-d9db26280581>'
+x_help_wanted:
+ - developer
+ - documenter
+ - tester
@@ -1,77 +1,192 @@
+## Makefile.PL for DBD::Oracle - see README file for more information.
+# Copyright (c) 1994-2006 Tim Bunce. Ireland.
+# Copyright (c) 2006-2008 John Scoles (The Pythian Group). Canada.
-##
-## You should not need to edit this file.
-##
+use 5.6.0;
-BEGIN { $^W = 1 }
-BEGIN { require 5.004 }
+use strict;
+use warnings;
use ExtUtils::MakeMaker 5.16, qw(&WriteMakefile $Verbose);
use Getopt::Long;
use Config;
use Cwd;
use File::Find;
-use strict;
+use Pod::Usage;
-# This DBI must be installed before we can build a DBD.
+# DBI must be installed before we can build a DBD.
# For those not using Dynamic loading this means building a
# new static perl in the DBI directory by saying 'make perl'
# and then using _that_ perl to make this one.
-use DBI 1.20;
+use DBI 1.51;
use DBI::DBD; # DBD creation tools
# Some MakeMaker's forged some FileHandle methods
-require FileHandle unless defined(&FileHandle::new);
+require FileHandle unless defined &FileHandle::new;
-BEGIN { if ($^O eq 'VMS') {
- require vmsish;
- import vmsish;
- require VMS::Filespec;
- import VMS::Filespec;
-}}
+BEGIN {
+ return unless $^O eq 'VMS';
+ eval q{
+ use vmsish;
+ use VMS::Filespec;
+ 1;
+ } or die $@;
+
+}
-my $dbi_dir = dbd_dbi_dir();
my $dbi_arch_dir = dbd_dbi_arch_dir();
-my $os = $^O;
+my $so = $Config{so}; # typically 'so', 'dylib' on Darwin/OSX
my $osvers = $Config{osvers}; $osvers =~ s/^\s*(\d+\.\d+).*/$1/; # drop sub-sub-version: 2.5.1 -> 2.5
-my $exe_ext = ($os eq 'VMS') ? '.pl' : '';
+my $exe_ext = ($^O eq 'VMS') ? '.pl' : '';
my $BELL = "\a";
+# put this here as it might change
$| = 1;
my %opts = (
NAME => 'DBD::Oracle',
- VERSION_FROM => 'Oracle.pm',
- EXE_FILES => [ "ora_explain$exe_ext" ],
+ VERSION_FROM => 'lib/DBD/Oracle.pm',
+ PREREQ_PM => { "Test::Simple" => 0.90, # actually Test::More pkg in T::S dist
+ "DBI" => 1.51},
OBJECT => '$(O_FILES)',
DEFINE => '',
DIR => [],
- clean => { FILES => 'Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def ora_explain mk.pm' },
+ clean => { FILES => 'xstmp.c Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def mk.pm DBD_ORA_OBJ.*' },
dist => {
- DIST_DEFAULT => 'clean distcheck disttest ci tardist',
+ DIST_DEFAULT => 'clean distcheck disttest tardist',
PREOP => '$(MAKE) -f Makefile.old distdir',
COMPRESS => 'gzip -v9', SUFFIX => 'gz',
},
+ META_MERGE => {
+ configure_requires => { "DBI" => '1.51' },
+ build_requires => {"DBI" => '1.51',
+ "ExtUtils::MakeMaker" => 0,
+ "Test::Simple" => '0.90'},
+ resources => {
+ bugtracker => {
+ mailto => 'bug-dbd-oracle at rt.cpan.org',
+ web =>
+ 'http://rt.cpan.org/Public/Dist/Display.html?Name=DBD-Oracle',
+ },
+ homepage => 'http://search.cpan.org/dist/DBD-Oracle',
+ repository => {
+ type => 'git',
+ url => 'git://github.com/yanick/DBD-Oracle.git',
+ web => 'http://github.com/yanick/DBD-Oracle/tree',
+ },
+ },
+ },
);
-if ($ExtUtils::MakeMaker::VERSION >= 5.43) {
+my $eumm = $ExtUtils::MakeMaker::VERSION;
+$eumm =~ tr/_//d;
+
+if ($eumm >= 5.43) {
$opts{AUTHOR} = 'Tim Bunce (dbi-users@perl.org)';
- $opts{ABSTRACT_FROM} = 'Oracle.pm';
- $opts{PREREQ_PM} = { DBI => 0 };
+ $opts{ABSTRACT_FROM} = 'lib/DBD/Oracle.pm';
+ $opts{PREREQ_PM} = { DBI => 1.51 };
$opts{CAPI} = 'TRUE' if $Config{archname} =~ /-object\b/i;
}
+$opts{LICENSE} = 'perl' if $eumm >= 6.3002;
+$opts{CCFLAGS} = "-P $Config{ccflags}" if $Config{cc} eq 'bcc32'; # force C++
$opts{LINKTYPE} = 'static' if $Config{dlsrc} =~ /dl_none/;
my(@MK, %MK, $MK_TEXT, %MK_expanding); # parsed macros from Oracle's makefiles
my %mk_target_deps;
my %mk_target_rules;
+=head1 OPTIONS
+
+=over
+
+=item -b
+
+Try to use Oracle's own 'build' rule. Defaults to true.
+
+
+=item -r
+
+With I<-b>, use this names build rule (eg -r=build64).
+
+=item -m
+
+Path to 'oracle.mk'
+
+=item -h
+
+Path to oracle header files.
+
+=item -p
+
+Alter preference for oracle.mk.
+
+=item -n
+
+Oracle .mk macro name to use for library list to link with.
+
+=item -c
+
+Don't encourage use of shared library.
+
+=item -l
+
+Try direct-link to libclntsh.
+
+=item -g
+
+Enable debugging (-g for compiler and linker).
+
+=item -s
+
+Find a symbol in oracle libs, Don't build a Makefile.
+
+=item -S
+
+Find a symbol in oracle & system libs, Don't build a Makefile.
+
+=item -v
+
+Be more verbose.
+
+=item -d
+
+Much more verbose for debugging.
+
+=item -f
+
+Include text of oracle's .mk file within generated Makefile.
+
+=item -F
+
+Force - ignore errors.
+
+=item -W
+
+Just write a basic default Makefile (won't build).
+
+=item -w
+
+Enable many gcc compiler warnings.
+
+=item -V
+
+Force assumption of specified Oracle version
+If == 8 then we don't use the new OCI_INIT code
+and we force our emulation of OCILobWriteAppend.
+
+=back
+
+=cut
+
# Options (rarely needed)
# to turn off an option prefix with 'no', ie 'perl Makefile.PL -nob'
+#$::opt_ic10 = 1; # Build for Oracle 10g instantclient
$::opt_b = 1; # try to use Oracle's own 'build' rule
-$::opt_m = 0; # path to proc.mk or oracle.mk file to read
-$::opt_p = ''; # alter preference for oracle.mk over proc
+$::opt_r = ''; # With -b above, use this names build rule (eg -r=build64)
+$::opt_m = ''; # path to oracle.mk file to read
+$::opt_h = ''; # path to oracle header files
+$::opt_p = ''; # alter preference for oracle.mk
$::opt_n = ''; # Oracle .mk macro name to use for library list to link with
$::opt_c = 0; # don't encourage use of shared library
$::opt_l = 0; # try direct-link to libclntsh
@@ -80,157 +195,139 @@ $::opt_s = ''; # Find a symbol in oracle libs, Don't build a Makefile
$::opt_S = ''; # Find a symbol in oracle & system libs, Don't build a Makefile
$::opt_v = 0; # be more verbose
$::opt_d = 0; # much more verbose for debugging
-$::opt_8 = 0; # disable use of OCI 8 (where available)
$::opt_f = 0; # include text of oracle's .mk file within generated Makefile
$::opt_F = 0; # force - ignore errors
$::opt_W = 0; # just write a basic default Makefile (won't build)
+$::opt_w = 0; # enable many gcc compiler warnings
+$::opt_V = 0; # force assumption of specified Oracle version
+ # If == 8 then we don't use the new OCI_INIT code
+ # and we force our emulation of OCILobWriteAppend
Getopt::Long::config( qw( no_ignore_case ) );
-GetOptions(qw(b! v! d! g! p! l! c! 8! f! F! W! m=s n=s s=s S=s))
- or die "Invalid arguments";
+GetOptions(qw(b! r=s v! d! g! p! l! c! f! F! W! w! m=s h=s n=s s=s S=s V=s ))
+ or die pod2usage( -verbose => 99, -sections => [ 'OPTIONS' ] );
$::opt_g &&= '-g'; # convert to actual string
$::opt_v = 1 if $::opt_d;
$Verbose = 1 if $::opt_v;
-my $is_me = (-d "/home/timbo/dbi" && ($ENV{LOGNAME}||'') eq 'timbo'); # a reasonable guess
+my $is_developer = (-d ".svn" && -f "MANIFEST.SKIP");
if ($::opt_W) {
- open(MK_PM, ">/dev/null") or die "Unable to create mk.pm: $!";
+ open MK_PM, ">/dev/null" or die "Unable to create 'mk.pm': $!";
exit WriteMakefile( dbd_edit_mm_attribs(\%opts) )
}
# --- Introduction
-print "\n Configuring DBD::Oracle ...\n
->>>\tRemember to actually *READ* the README file!
- \tEspecially if you have any problems.\n
-" unless $::opt_s;
+print qq{
+Configuring DBD::Oracle for perl $] on $^O ($Config{archname})
+Remember to actually *READ* the README file! Especially if you have any problems.
-# --- Where is Oracle installed...
+} unless $::opt_s;
-my $ORACLE_ENV = ($os eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
-my $OH = $ENV{$ORACLE_ENV} || '';
-$OH = win32_oracle_home($OH) if ($os eq 'MSWin32') or ($os =~ /cygwin/i);
-($OH = unixify $OH) =~ s:/$:: if $os eq 'VMS';
-
-die qq{ The $ORACLE_ENV environment variable must be set.
- It must be set to hold the path to an Oracle installation directory
- on this machine (or a machine with a compatible architecture).
- See the README.clients file for more information.
- ABORTED!
-} unless $OH;
+# --- Where is Oracle installed...
+my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
+my $OH = $ENV{$ORACLE_ENV} || '';
+$OH = win32_oracle_home($OH) if ($^O eq 'MSWin32') or ($^O =~ /cygwin/i);
+$OH = unixify $OH if $^O eq 'VMS';
+$OH =~ s:/$::;
+
+if (!$OH) {
+ $OH = find_oracle_home() || die qq{
+ The $ORACLE_ENV environment variable is not set and I couldn\'t guess it.
+ It must be set to hold the path to an Oracle installation directory
+ on this machine (or a machine with a compatible architecture).
+ See the appropriate README file for your OS for more information.
+ ABORTED!
+ \n};
+ $ENV{$ORACLE_ENV} = $OH;
+ print "\n";
+ print "WARNING: Setting $ORACLE_ENV env var to $OH for you.\a\n";
+ print "WARNING: If these tests fail you may have to set ORACLE_HOME yourself!\n";
+ sleep 5;
+}
+-l $OH and $OH = Cwd::abs_path ($OH); # Oracle really dislikes symbolic links
die qq{ The $ORACLE_ENV environment variable value ($OH) is not valid.
It must be set to hold the path to an Oracle installation directory
- on this machine (or a compatible archtecture).
- See the README.clients file for more information.
+ on this machine (or a machine with a compatible architecture).
+ For an Instant Client install, the directory should include an sdk subdirectory.
+ See the appropriate README file for your OS for more information.
ABORTED!
-} unless (($os eq 'VMS') ? -d $OH : -d "$OH/lib/.");
+} unless (-d $OH and $^O eq 'VMS')
+ or -d "$OH/sdk/." # Instant Client with SDK
+ or -d "$OH/lib/." # normal Oracle installation
+ or glob("$OH/libclntsh.$so*") # pre-sdk instant client or rpm
+ or -e "$OH/oci.dll"; # Windows Instant Client
+print "Installing on a $^O, Ver#$osvers\n";
print "Using Oracle in $OH\n";
-# We'll try to dig up some Oracle version information. Not essential.
-my (@inspdver, %inspdver); $inspdver{RDBMS} = 0;
-if ($os ne 'VMS' and $os ne 'MSWin32' ) {
+# $client_version => Major.Minor, $client_version_full => Major.Minor.X.Y.Z
+my ($client_version, $client_version_full) = get_client_version($::opt_V);
- if (open INST, "<$OH/install/unix.rgs") {
- local $/ = undef;
- <INST> =~ m/^rdbms\s+([\d.]+)/m;
- $inspdver{RDBMS} = $1 if $1;
- close INST;
- }
- elsif ( -x "$OH/orainst/inspdver" ) { # client only install does not have this
- open INST, "$OH/orainst/inspdver |";
- my @inspdver = <INST>;
- close INST;
- foreach (@inspdver) {
- chop;
- $inspdver{$2} = $1 if m/^(\S+)\s+(.*)/;
- $inspdver{RDBMS} = $1 if m/^(\d+\.\d+\.\d+)\S*\s+.*RDBMS/;
- next unless $::opt_v
- or m/RDBMS/i or m/PL.SQL/i
- or m/Precomp/i or m/Pro\*C/i;
- print "$_\n";
- }
- }
- elsif ( $OH =~ m!.*(\d+\.\d+\.\d+)! ) { #decode it from $OH if possible
- $inspdver{RDBMS} = $1;
- }
- elsif ( "$OH/" =~ m!\D(1?\d)(\d)(\d)\D!) { # scary but handy
- $inspdver{RDBMS} = join ".", $1, $2, $3;
- }
- else {
- print qq{
-WARNING: could not decode oracle version from
-$OH/orainst/inspdver, or $OH/install/unix.rgs
-or from $ORACLE_ENV path $OH.
-Oracle version based logic in Makefile.PL may produce erroneous results.
-};
- }
- print "\n";
- if ($inspdver{RDBMS} =~ /^7.3.[12]/ and $os eq 'hpux') {
- print "*** DBD::Oracle for Oracle $inspdver{RDBMS} on HP-UX may not build ok.\n";
- print "*** If your have problems read the README (in fact, read it anyway!)\n";
- print "*** An upgrade to at least Oracle 7.3.3 is a good idea.\n";
- sleep 5;
- }
-}
-print "Oracle version $inspdver{RDBMS}\n" if $inspdver{RDBMS};
-# hack up a simple floating point form of the version: 8.1.6 => 8.106
-($inspdver{rdbms_ver} = $inspdver{RDBMS}) =~ s/^(\d+\.\d+)\.(\d+)/${1}0$2/;
-#print "\ninspdver{rdbms_ver}=". $inspdver{rdbms_ver} ."\n";
-
-# Check for symbol table problem in libclntsh.dylib.9.0 on MacOS X
-if ($os eq 'darwin') {
- my $oracle_lib = "$OH/lib/libclntsh.dylib.9.0";
- open FH,"nm $oracle_lib |";
- my $stripped = 1;
- while (<FH> ) {
- if (/^\s+U _(dlsym|dlclose)/) {
- $stripped = 0;
- last;
- }
- }
- close FH;
- unless ($stripped) {
- die "ERROR: symbol table needs modification in Oracle library:\n\t$oracle_lib\nManual modification required - see README.macosx\n";
- }
-}
+die "DBD::Oracle no longer supports Oracle client versions before 9.2 \n Try a version before 1.25 for 9 and 1.18 for 8!"
+ if $client_version < 9;
-my @h_dirs = find_headers();
+
+check_macos_symbol_table();
symbol_search() if $::opt_s or $::opt_S;
# --- How shall we link with Oracle? Let me count the ways...
-my @mkfiles;
-my $linkwith;
-my $linkwith_msg;
+my $mkfile; # primary .mk file to use
+my @mkfiles; # $mkfile plus any files it 'includes'
+my $linkwith = "";
+my $linkwith_msg = "";
my $need_ldlp_env;
-if ($os eq 'VMS') {
- my $OCIINCLUDE = vmsify("$OH/rdbms/") ." ". vmsify("$OH/rdbms/demo/oci_demo/");
+if ($^O eq 'VMS') {
+ my $OCIINCLUDE = join " ", vmsify("$OH/rdbms/"),
+ vmsify("$OH/rdbms/public"),
+ vmsify("$OH/rdbms/demo/"),
+ vmsify("$OH/rdbms/demo/oci_demo/"),
+ vmsify("$OH/netconfig/demo/"); # eg nzt.h in 8.1.7 on VMS
$opts{INC} = "$OCIINCLUDE $dbi_arch_dir";
$opts{OBJECT} = 'oracle.obj dbdimp.obj oci7.obj oci8.obj' if $] < 5.005;
+
+ unless ($ENV{PERL_ENV_TABLES}) {
+ print qq{
+ The logical PERL_ENV_TABLES is not set.
+
+ This may mean that some of the UTF functionallity tests may fail,
+ and that some logicals may be set in the Oracle Table.
+
+ To ensure that testing the package only sets logicals in your process
+ table, please set this logical:
+
+ \$ DEFINE PERL_ENV_TABLES LNM\$PROCESS
+ \a\n};
+ sleep 3;
+ }
}
-elsif (($os eq 'MSWin32') or ($os =~ /cygwin/i)) {
+elsif (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) {
+
my $OCIDIR = "";
find( sub {
print "Found $_ directory\n" if /^OCI\d*$/i;
$OCIDIR = $_ if /^OCI\d*$/i && $OCIDIR lt $_;
$File::Find::prune = 1 if -d $_ && $_ !~ /^\./;
}, $OH );
+
+ $OCIDIR = 'sdk' if !$OCIDIR && -d "$OH/sdk"; # Instant Client SDK
+
die "OCI directory not found, please install OCI in $OH" if ! $OCIDIR;
print "Using OCI directory '$OCIDIR'\n";
if ($Config{cc} =~ /gcc/i) {
system("dlltool --input-def oci.def --output-lib liboci.a")
if ! -f "liboci.a";
- die "Could not find or create liboci.a. See README.wingcc\n"
+ die "Could not find or create liboci.a. See README.wingcc.txt\n"
if ! -f "liboci.a";
my $pwd = cwd();
$opts{LIBS} = [ "-L$pwd -loci" ];
@@ -251,26 +348,28 @@ elsif (($os eq 'MSWin32') or ($os =~ /cygwin/i)) {
my @OCILIB = sort grep { /(OCI|ORA)\d\d+\./i } keys %OCILIB;
# prefer the non-versioned library if present
push @OCILIB, "OCI.LIB" if $OCILIB{'OCI.LIB'};
- # opt_8 means DISABLE use of OCI 8 API
- push @OCILIB, "OCIW32.LIB" if $OCILIB{'OCIW32.LIB'} && $::opt_8;
my $OCILIB = pop @OCILIB || '';
$OCILIB =~ s/\.LIB$//i;
-
+
die qq{
Unable to find required Oracle OCI files for the build. Please check
- that you have your OCI installed in your oracle home ($OH)
+ that you have your OCI installed in your oracle home ($OH)
directory and that it has the following files (and probably more):
-
+
$OH\\$OCIDIR\\include\\oratypes.h
$OH\\$OCIDIR\\lib\\$oci_compiler_dir\\$OCILIB.lib
-
+
Please install OCI or send comments back to dbi-users\@perl.org
- if you have an OCI directory other than $OCIDIR.
-
- } unless (-e "$OH/$OCIDIR/include/oratypes.h"
+ if you have an OCI directory other than $OCIDIR.
+
+ Alternatively, if you\'re using ActiveState perl on Windows try
+ ppm install ftp://ftp.esoftmatic.com/outgoing/DBI/5.8.3/DBI.ppd
+ ppm install ftp://ftp.esoftmatic.com/outgoing/DBI/5.8.3/DBD-Oracle.ppd
+
+ } unless (-e "$OH/$OCIDIR/include/oratypes.h"
&& -e "$OH/$OCIDIR/lib/$oci_compiler_dir/$OCILIB.lib")
or $::opt_F;
-
+
print "Using $OCIDIR/lib/$oci_compiler_dir/$OCILIB.lib\n";
$opts{LIBS} = [ "-L$OH/$OCIDIR/LIB/$oci_compiler_dir $OCILIB" ];
};
@@ -282,28 +381,92 @@ elsif (($os eq 'MSWin32') or ($os =~ /cygwin/i)) {
# --- UNIX Variants ---
elsif ($::opt_l and # use -l to enable this direct-link approach
- @_=grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } <$OH/lib/lib*>
+ @_=grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } <$OH/lib/lib*>
) {
# --- the simple modern way ---
foreach(@_) { s:\Q$OH/lib/::g }
print "Found direct-link candidates: @_\n";
my $lib = ("@_" =~ m:lib(cl(ie)?ntsh)\.:) ? $1 : "oracle";
- $linkwith_msg = "-l$lib.";
my $syslibs = read_sysliblist();
print "Oracle sysliblist: $syslibs\n";
- my $libdir = 'lib';
- #Lincoln: if hpux, pick the right library path
- if ( $os eq 'hpux' and $osvers >= 11 ) {
- $libdir = hpux_libdir();
+ my $libdir = ora_libdir();
+ $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" };
+ my @h_dirs = find_headers();
+ if ($client_version_full =~ /^8.0.6/ && $^O eq 'hpux') {
+ $linkwith_msg = "-lextp -l$lib.";
+ $opts{LIBS} = [ "-L$OH/$libdir -lextp -l$lib $syslibs" ];
+ push @h_dirs, "$OH/network/public";
+ }
+ else {
+ $linkwith_msg = "-l$lib.";
+ $opts{LIBS} = [ "-L$OH/$libdir -l$lib $syslibs" ];
}
- $opts{LIBS} = [ "-L$OH/$libdir -l$lib $syslibs" ];
+ my $inc = join " ", map { "-I$_" } @h_dirs;
+ $opts{INC} = "$inc -I$dbi_arch_dir";
+ check_ldlibpthname();
+}
+
+# --- special case for Oracle 10g instant client (note lack of ../lib/...)
+
+elsif (my @libclntsh = glob("$OH/libclntsh.$so*")) {
+
+ print "Looks like an Instant Client installation, okay\n";
+
+ # the libclntsh.$so (without version suffix) may be missing
+ # we need it to link to so try to create it
+ eval {
+ print "You don't have a libclntsh.$so file, only @libclntsh\n";
+ my $libclntsh_v = (grep { /\d$/ } sort @libclntsh)[0]; # tacky but sufficient
+ print "So I'm going to create a $OH/libclntsh.$so symlink to $libclntsh_v\n";
+ symlink($libclntsh_v, "$OH/libclntsh.$so")
+ or warn "Can't create symlink $OH/libclntsh.$so to $libclntsh_v: $!\n";
+ } unless -e "$OH/libclntsh.$so";
+
+ check_ldlibpthname($OH);
+
+ my $syslibs = read_sysliblist();
+ print "Oracle sysliblist: $syslibs\n";
+
$opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" };
- my $inc = join " ", map { "-I$OH/$_" } @h_dirs;
+
+ my $lib = "clntsh";
+ $linkwith_msg = "-l$lib.";
+ $opts{LIBS} = [ "-L$OH -l$lib $syslibs" ];
+
+ my $inc = join " ", map { "-I$_" } find_headers();
$opts{INC} = "$inc -I$dbi_arch_dir";
}
-else { # --- trawl the guts of Oracle's make files looking the how it wants to link
- my @ora_libs = <$OH/lib/lib*>;
+elsif ($mkfile = find_mkfile() and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE
+
+ print "Looks like Oracle XE ($mkfile)\n";
+
+ fetch_oci_macros($mkfile);
+ $MK{CCINCLUDES} = '-I$(ICINCHOME)'; # undo odd refinition in demo_xe.mk
+
+ # From linux Oracle XE (10.2.0):
+ # ICINCHOME=$(ORACLE_HOME)/rdbms/public/
+ # ICLIBHOME=$(ORACLE_HOME)/lib/
+ # ICLIBPATH=-L$(ICLIBHOME)
+ # THREADLIBS=-lpthread [initially -lthread then redefined]
+ # CCLIB=$(ICLIBPATH) -lclntsh $(THREADLIBS)
+ # CCINCLUDES = -I$(ICINCHOME) [see above]
+ # CCFLAGS=$(CCINCLUDES) -DLINUX -D_GNU_SOURCE -D_REENTRANT -g [initially without -DLINUX -D_GNU_SOURCE]
+ my $cclib = expand_mkvars($MK{CCLIB}, 0, 1);
+ my $ccflags = expand_mkvars($MK{CCFLAGS}, 0, 1);
+
+ $linkwith_msg = "$cclib";
+ $opts{LIBS} = [ $cclib ];
+ $opts{INC} = "-I$dbi_arch_dir $ccflags";
+ $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" };
+ check_ldlibpthname();
+}
+
+else { # --- trawl the guts of Oracle's make files looking the how it wants to link
+ #Lincoln: pick the right library path
+ check_ldlibpthname();
+ my $libdir = ora_libdir();
+ my @ora_libs = <$OH/$libdir/lib*>;
if (@ora_libs < 6) { # just a helpful hint
warn "\nYou don't seem to have many Oracle libraries installed. If the"
."\nbuild fails you probably need to install more Oracle software.\n\n";
@@ -321,24 +484,27 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
if !defined $ENV{ORA_CLIENT_LIB}
&& ($opts{LINKTYPE}||'') ne 'static' && @shared && !$::opt_c;
- my $mkfile = find_mkfile();
my $linkvia = fetch_oci_macros($mkfile) if -f $mkfile;
my $libhome = expand_mkvars($MK{LIBHOME}, 0, 1) || "$OH/lib";
$linkwith = expand_mkvars($linkvia, 0, 1);
- #Lincoln: if hpux, pick the right library path
- if ( $os eq 'hpux' and $osvers >= 11 ) {
- my $libdir = hpux_libdir();
- $linkwith =~ s!/lib\b!/$libdir!g;
- $libhome =~ s!/lib\b!/$libdir!g;
- #print "linkwith=$linkwith\n";
- }
+ #now use logic based of oracle version
+ $linkwith =~ s!/lib\b!/$libdir!g;
+ $libhome =~ s!/lib\b!/$libdir!g;
+ #print "linkwith=$linkwith\n";
- if ($mk_target_rules{build} && $::opt_b) {
+ my @build_rules = grep { $mk_target_rules{$_} } qw(build build64 build32);
+ my $build_target = "build";
+ if (@build_rules && $::opt_b) {
print "\n";
- print "Attempting to discover Oracle OCI build rules\n";
+
+ $build_target = "build32" if $mk_target_rules{build32};
+ $build_target = "build64" if $mk_target_rules{build64} && perl_is_64bit();
+ $build_target = $::opt_r if $::opt_r;
+
+ print "Attempting to discover Oracle OCI $build_target rules\n";
# create dummy C file to keep 'make $mkfile' happy
my $DBD_ORA_OBJ = 'DBD_ORA_OBJ';
@@ -349,75 +515,62 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
sleep 2; #
system("make $DBD_ORA_OBJ.o CC='$Config{cc}'"); # make a valid .o file.
- my $make = "$Config{make} -f $mkfile build"
- ." ECHODO=echo ECHO=echo GENCLNTSH='echo genclntsh' CC=echo"
+ my $make = "$Config{make} -f $mkfile $build_target"
+ ." ECHODO=echo ECHO=echo GENCLNTSH='echo genclntsh' CC=true"
." OPTIMIZE= CCFLAGS="
." EXE=DBD_ORA_EXE OBJS=$DBD_ORA_OBJ.o";
- print "by executing: ($make)\n";
+ print "by executing: [$make]\n";
my @cmds = `$make 2>&1`;
- print "returned:\n[".join("\n[",@cmds)."]\n" if $::opt_v;
- warn "Warning: Oracle build rule discovery failed ($?)\n" if $?;
- warn "Add path to $Config{make} command into your PATH env var.\n"
- if $? && "@cmds" =~ /make: not found/; # hint
+ chomp @cmds;
+ print "returned:\n[".join("]\n[",@cmds)."]\n" if $::opt_v;
+ warn "WARNING: Oracle build rule discovery failed ($?)\n" if $?;
+ warn "Add path to $Config{make} command into your PATH environment variable.\n"
+ if $? && "@cmds" =~ /make.*not found/; # hint
my @filtered_cmds;
while (my $line = shift @cmds) {
# join lines split with \'s
while ($line =~ s/\\$/ /) { $line .= shift @cmds; }
# remove any echo's as the following line should be the result of the echo
- if ($line =~ /^\s*echo\s+/) {
- $line = shift @cmds; # replace line with the next one
- $line =~ s/^echo\s+//; # handle " echo echo ..." case
- }
+ next if $line =~ /^\s*\S*echo\s+/;
+ next if $line =~ /^\s*\S*make\s+/; # remove recursive calls to make
+ next if $line =~ /^\s*\S*make(\[\d\])?:/; # remove message rom "make:" or "make[x]:"
+
next if $line =~ /^\s*$/; # remove any blank lines
push @filtered_cmds, $line;
}
+ print "reduced to:\n[".join("]\n[",@filtered_cmds)."]\n"
+ if $::opt_v && "@filtered_cmds" ne "@cmds";
@cmds = @filtered_cmds;
- print "reduced to:\n[".join("\n[",@cmds)."]\n" if $::opt_v;
-
- # expand any shell-escapes that remain
- #@cmds = map { s/`(.*?[^\\])`/expand_shellescape("$1", 1)/esg; $_ } @cmds;
-
my @prolog; push @prolog, shift @cmds while @cmds && $cmds[0] !~ /DBD_ORA_EXE/;
- print "Oracle oci build prolog:\n\t+ ", join("\n\t+ ", @prolog), "\n" if @prolog;
- print "Oracle oci build command:\n\t+ ", join("\n\t+ ", @cmds), "\n";
- if (@cmds == 2) {
- # Newer Oracle (>8.0.5, it seems) seem to disregard ECHODO, in
- # which case the make output probably looked like this:
- # echo foo `bar` baz
- # foo shell-expanded-bar baz
- # So let's check for that, and fix things up if so
- if (my($foo) = ($cmds[0] =~ /^echo\s+([^`]+)`/)) {
- if ($cmds[1] =~ /^$foo/) {
- # The second line looks like the expanded
- # version of the first; let's fix it up like
- # we're expecting it to look and use it
- @cmds = ("true echo $cmds[1]");
- }
- }
- }
- if (@cmds == 1) {
- my $build = $cmds[0];
- #$build =~ s/^\s*(true\s+)?(\S+)\s*//; # remove 'true' and compiler/linker
- $build =~ s/$DBD_ORA_OBJ.o//; # remove dummy object file
+ print "Oracle oci build prolog:\n \t[", join("]\n\t[", @prolog), "]\n" if @prolog;
+ print "Oracle oci build command:\n\t[", join("]\n\t[", @cmds ), "]\n";
+ if (@cmds == 1 && (my $build = shift @cmds) =~ /DBD_ORA_EXE/) {
+ $build =~ s/\s*true\s+//; # remove dummy compiler
+ $build =~ s/$DBD_ORA_OBJ.o//; # remove dummy object file
$build =~ s/\S+\s+DBD_ORA_EXE//; # remove dummy exe file and preceding flag
+ $build =~ s/-o build\S*//; # remove -o target that confuses gcc at least on Sun
$linkwith = $build;
# delete problematic crt?.o on solaris
- $linkwith = del_crtobj($linkwith, 1) if $os eq 'solaris';
+ $linkwith = del_crtobj($linkwith, 1) if $^O eq 'solaris';
}
else {
- print "Unable to interpret Oracle build commands from $mkfile. Using fallback approach.\n";
+ print "WARNING: Unable to interpret Oracle build commands from $mkfile.\a\n";
+ print "(Will continue by using fallback approach.)\n";
+ print "Please report this to dbi-users\@perl.org. See README for what to include.\n";
+ sleep 2;
$::opt_b = 0;
}
- unlink "$DBD_ORA_OBJ.c", "$DBD_ORA_OBJ.o" unless $os eq 'darwin';
+ unlink "$DBD_ORA_OBJ.c", "$DBD_ORA_OBJ.o"
+ unless $^O eq 'darwin'; # why?
print "\n";
}
else {
- print "Warning: Oracle $mkfile doesn't define a 'build' rule.\n" if $::opt_b;
+ print "WARNING: Oracle $mkfile doesn't define a 'build' rule.\n" if $::opt_b;
$::opt_b = 0;
print "\n";
- print "Warning: I will now try to guess how to build and link DBD::Oracle for you.$BELL\n";
+ print "WARNING: I will now try to guess how to build and link DBD::Oracle for you.$BELL\n";
print " This kind of guess work is very error prone and Oracle-version sensitive.\n";
print " It is possible that it won't be supported in future versions of DBD::Oracle.\n";
print " *PLEASE* notify dbi-users about exactly _why_ you had to build it this way.\n";
@@ -426,53 +579,64 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
}
$linkwith =~ s/-Y P,/-YP,/g if $Config{gccversion};
- $linkwith =~ s:-R /:-R/:g if $os eq 'solaris';
+ $linkwith =~ s:-R /:-R/:g if $^O eq 'solaris';
- # modifications (mostly) by lbaxter@fleetcc.com
- if ( ($os eq 'hpux') && ($osvers > 10) && ($Config{'cc'} eq 'cc') )
+ # modifications (mostly) by Lincoln Baxter
+ if ( ($^O eq 'hpux') && ($osvers > 10) && (
+ $Config{'cc'} eq 'cc' or $Config{'gccversion'}) )
{
# these get dragged in from demo_rdbms.mk where Oracle uses them
# the linker bitches about them not being valid options
# in this context
- $linkwith =~ s/-Wl,\+[sn]//g;
+
+ # (on my system, using gcc, the flags can't be removed entirely;
+ # instead, they have to be converted to the ld-compatible equivs.
+ # -- Sweth (<svc@sweth.net>)
+ if ( $Config{'cc'} eq 'cc' ) {
+ $linkwith =~ s/-Wl,\+[sn]//g;
+ } elsif ( $Config{'gccversion'} ) {
+ $linkwith =~ s/-Wl,(\+[sn])/$1/g;
+ };
# Oracle 8.0.5 drags in these which also cause link errors:
# this produces a good link with the 32bit version of oracle
# (64bit version of 8.0.5 fails to link
# someone else will have to hack that one out)
$linkwith =~ s/\+D[AS]2\.0[W]* / /g;
- #Lincoln: if hpux, pick the right library path
- if ( $os eq 'hpux' and $osvers >= 11 ) {
- my $libdir = hpux_libdir();
- $linkwith =~ s!/lib\b!/$libdir!g;
- #print "linkwith=$linkwith\n";
- }
+
+ #Lincoln: pick the right library path
+ my $libdir = ora_libdir();
+ $linkwith =~ s!/lib\b!/$libdir!g;
# A number of folks have had to add this library to resolve
- # undefined symbol errors reported at runtime by ld.sl (the
+ # undefined symbol errors reported at runtime by ld.sl (the
# library loader) libqsmashr defines LhrStringInsert()...
# other libraries may have to be added (Lincoln Baxter <lbaxter@fleetcc.com>)
# we check for the library's existence first... (8.0.5 does not have it)
- if ( -r "$OH/lib/libqsmashr.sl" ) {
+ if ( -r "$OH/$libdir/libqsmashr.sl" ) {
$linkwith =~ s/$/ -lqsmashr/ if ( $linkwith !~ m/-lqsmshr/ );
}
- if ( $osvers >= 11 and
- $inspdver{RDBMS} =~ /^7.3/ and
- $linkwith =~ m/-lcl\b/ && $linkwith =~ m/-l:libcl.a/
- ) { # from h.m.brand@hccnet.nl
- print "Warning: Stripping -lcl from the link flags, because it\n",
+ if ( ($Config{'libswanted'} !~ m/\bcl\b/) or $Config{'libswanted'} !~ m/\bpthread\b/ ) {
+ print "WARNING: Oracle is built with multi-threading libraries\n"
+ . " You will most likely need to rebuild perl from sources\n"
+ . " with the following libraries: -lcl -lpthread\n" ;
+ }
+
+ if ( $osvers >= 11 and
+ $linkwith =~ m/-lcl\b/ && $linkwith =~ m/-l:libcl.a/
+ ) { # from h.m.brand@hccnet.nl
+ print "WARNING: Stripping -lcl from the link flags, because it\n",
" seems to conflict with -l:libcl.a\n" ;
$linkwith =~ s/\s*-lcl\b//g;
}
-
# Lincoln: Jay Strauss's Oracle 8.1.6 fix... I did this manually
# when I still had 8.1.6 to deal with (its in the README):
#
# Jay: 8.1.6 gets Unresolved symbols on LhtStrInsert
# $linkwith =~ s/$/ -lclntsh/ if ( $linkwith !~ = m/-lclntsh/ );
# Tim - Not to be disobedient but at this point of the code
- # $inspdver{RDBMS} = 0, so I can't do Oracle version 8.1.6 logic
+ # $client_version_full = 0, so I can't do Oracle version 8.1.6 logic
# So it seems easier to modify if I do it like below rather than above
# obviously its your choice
#
@@ -485,7 +649,7 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
#
# Jay: Add Librarys where one gets Unresolved symbols
#
- if ( ( $osvers >= 11 and $inspdver{RDBMS} =~ /^8.1.6/ )
+ if ( ( $osvers >= 11 and $client_version_full =~ /^8\.1\.6/ )
or ( $osvers >= 11 and $OH =~ m,/8\.1\.6, ) ) {
my @extraLib = qw[libqsmashr.sl libclntsh.sl];
foreach my $extraLib (@extraLib) {
@@ -497,28 +661,41 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
}
if ($osvers >= 11 and $linkwith =~ m/-l:libcl.a/) {
- print "Warning: stripping -l:libcl.a from liblist (conflict with ld looking for shared libs)\n";
+ print "WARNING: stripping -l:libcl.a from liblist (conflict with ld looking for shared libs)\n";
$linkwith =~ s/\s*-l:libcl.a\b//g;
}
- if (($linkwith !~ m/-lcl/) || ($linkwith !~ m/-lpthread/)) {
- print "Warning: Oracle is built with multi-threading libraries\n"
- . " You will most likely need to rebuild perl from sources\n"
- . " with the following libraries: -lcl -lpthread\n" ;
+ #lincoln: this is bringing back everything we thought we removed... (like libcl.a)
+ # I wonder if this should targetted less specifically than only HPUX 11
+ # For now this should be relatively safe...
+ if ( $osvers >= 11 and
+ $linkwith =~ s/(`cat[^`]+sysliblist`)//g
+ ) {
+ print "WARNING: Stripped $1 \n",
+ " from link command, because it contains libraries not \n",
+ " compiled with +z or +Z (PIC) causing link to fail.\n",
+ " Furthermore, we should have already grabbed these libraries\n";;
}
my $ccf = join " ", map { $_ || '' } @Config{qw(ccflags ccldflags cccdlflags)};
- unless ($ccf =~ m/\+[zZ]/) {
- print "Warning: perl was not built with +z or +Z in compiler flags.\n",
+ if ($Config{cc} =~ /gcc/i) {
+ print "WARNING: perl was not built with -fpic or -fPIC in compiler flags.\n",
+ " You may need to rebuild perl from sources.\n",
+ " See instructions in README.hpux.txt\n"
+ unless $ccf =~ m/-fpic\b/i;
+ }
+ else {
+ print "WARNING: perl was not built with +z or +Z in compiler flags.\n",
" You may need to rebuild perl from sources.\n",
- " See instructions in README.hpux\n";
+ " See instructions in README.hpux.txt\n"
+ unless $ccf =~ m/\+[zZ]/;
}
}
if ($::opt_b) { # The simple approach
$opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g $linkwith" };
- $linkwith_msg = "OTHERLDFLAGS = $linkwith [from 'build' rule]";
+ $linkwith_msg = "OTHERLDFLAGS = $linkwith [from '$build_target' rule]";
}
else { # the not-so-simple approach!
# get a cut down $linkwith to pass to MakeMaker liblist
@@ -532,15 +709,15 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
# Platform specific fix-ups:
# delete problematic crt?.o on solaris
- $linkwith_s = del_crtobj($linkwith_s) if $os eq 'solaris';
+ $linkwith_s = del_crtobj($linkwith_s) if $^O eq 'solaris';
$linkwith_s =~ s/-l:lib(\w+)\.sl\b/-l$1/g; # for hp-ux
# this kind of stuff should be in a ./hints/* file:
$linkwith_s .= " -lc" if $Config{osname} eq 'dynixptx'
or $Config{archname} =~ /-pc-sco3\.2v5/;
- if ($os eq 'solaris' and $linkwith_s =~ /-lthread/
+ if ($^O eq 'solaris' and $linkwith_s =~ /-lthread/
and $osvers >= 2.3 and $osvers <= 2.6
) {
- print "Warning: Solaris 2.5 bug #1224467 may cause '_rmutex_unlock' error.\n";
+ print "WARNING: Solaris 2.5 bug #1224467 may cause '_rmutex_unlock' error.\n";
print "Deleting -lthread from link list as a possible workround ($osvers).\n";
$linkwith_s =~ s/\s*-lthread\b/ /g;
}
@@ -557,75 +734,104 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l
}
my $OCIINCLUDE = expand_mkvars($MK{INCLUDE} || '', 0, 0);
- $OCIINCLUDE .= " -I$OH/rdbms/demo";
- my $inc = join " ", map { "-I$OH/$_" } @h_dirs;
- $opts{INC} = "$OCIINCLUDE $inc -I$dbi_arch_dir";
+ my @h_dirs = find_headers();
+ my $inc = join " ", map { "-I$_" } @h_dirs;
+ $opts{INC} = "$inc $OCIINCLUDE -I$dbi_arch_dir";
}
# --- Handle special cases ---
-if ($::opt_g && $os eq "MSWin32" && $Config::Config{cc} eq "cl") {
+if ($::opt_g && $^O eq "MSWin32" && $Config::Config{cc} eq "cl") {
$opts{LDDLFLAGS} = $Config::Config{lddlflags} . ' -debug'
}
-$opts{DEFINE} .= ' -Wall -Wno-comment' if $Config{gccversion} eq 'gcc';
+$opts{DEFINE} .= ' -Wall -Wno-comment' if $Config{gccversion};
$opts{DEFINE} .= ' -Xa' if $Config{cc} eq 'clcc'; # CenterLine CC
-if ($::opt_8) {
- $opts{DEFINE} .= ' -DNO_OCI8';
- print "\n******************************************************\n";
- print "OCI7 will not be supported in future releases of DBD::Oracle$BELL\n";
- print "******************************************************\n";
- sleep 10;
-}
+
+
+
+
+
$opts{DEFINE} .= ' -DUTF8_SUPPORT' if ($] >= 5.006);
+# Use OCIEnvNlsCreate if available for best unicode behaviour
+#$opts{DEFINE} .= ' -DNEW_OCI_INIT' if $client_version >= 9.2;
+$opts{DEFINE} .= ($^O ne 'VMS')
+ ? " -DORA_OCI_VERSION=\\\"$client_version_full\\\""
+ : " -DORA_OCI_VERSION=\"$client_version_full\"";
+# force additional special behavior for oci 8. For now, this means
+# emulating OciLobWriteAppend
+# use this if, for some reason the default handling for this function
+# doesn't work or you are building a binary release for distribution
+# to machines with older client libraries.
+
+
+print "\nclient_version=$client_version\n\n";
+
+$opts{DEFINE} .= " -DORA_OCI_102" if ($::opt_V && $client_version == 10.2)
+ or ( $client_version >= 10.2);
+
+$opts{DEFINE} .= " -DORA_OCI_112" if ($::opt_V && $client_version == 11.2)
+ or ( $client_version >= 11.2);
+
+print "\nDEFINE=$opts{DEFINE}\n\n";
+# OCIStmntFetch2() is a feature of OCI 9.0.0
+$opts{DEFINE} .= " -DUSE_ORA_OCI_STMNT_FETCH " if ( $client_version < 9.0 );
+
+
# Set some private WriteMakefile options if this is 'me' :-)
-if ($is_me){ # a reasonable guess
- $BELL = "<BELL>";
- # -Wconversion is over-noisy for us
- $opts{DEFINE} .= ' -Wall -Wcast-align -Wpointer-arith'
- . ' -Wbad-function-cast -Wcast-qual' if $Config{gccversion};
+if ($is_developer){ # a reasonable guess
+ $BELL = "<BELL>" if ($ENV{LOGNAME}||'') eq 'timbo';
$::opt_g = '-g';
- $opts{dynamic_lib}->{OTHERLDFLAGS} = "$::opt_g ".($opts{dynamic_lib}->{OTHERLDFLAGS}||'');
+ if ($Config{gccversion}) {
+ $opts{DEFINE} .= ' -Wall -Wcast-align -Wpointer-arith';
+ $opts{DEFINE} .= ' -Wbad-function-cast -Wcast-qual';
+ #$opts{DEFINE} .= ' -Wconversion'; # very noisy so remove to see what people say
+ $opts{DEFINE} .= ' -Wimplicit -Wimplicit-int -Wimplicit-function-declaration -Werror-implicit-function-declaration -Wimport -Winline -Wlong-long -Wmissing-braces -Wmissing-format-attribute -Wmissing-noreturn -Wmultichar -Wpacked -Wparentheses -Wpointer-arith -Wreturn-type -Wsequence-point -Wsign-compare -Wswitch -Wtrigraphs -Wundef -Wuninitialized -Wunreachable-code -Wunused -Wunused-function -Wunused-label -Wunused-parameter -Wunused-value -Wunused-variable -Wwrite-strings -Wbad-function-cast -Wmissing-declarations -Wnested-externs'
+ if $::opt_w;
+ }
+ $opts{dynamic_lib}->{OTHERLDFLAGS} .= " $::opt_g";
}
# 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') {
- print "***$BELL\n";
+if ($^O eq 'hpux') {
if ($osvers < 10) {
- print "*** Warning: Forced to build static not dynamic on $os $osvers.$BELL\n";
+ print "WARNING: Forced to build static not dynamic on $^O $osvers.$BELL\n";
$opts{LINKTYPE} = 'static';
}
else {
- print "*** Warning: If you have trouble, see README.hpux...\n"
- ." you may have to build your own perl, or go hunting for libraries\n";
+ print "WARNING: If you have trouble, see README.hpux.txt...\n"
+ ." you may have to build your own perl, or go hunting for libraries\n";
}
- print "***$BELL\n";
- sleep 3;
- $opts{DEFINE} .= ' $(HP64DEFINES)' if ($Config{archname} =~ /-thread\b/i and hpux_lib64());
+ print "WARNING: If you have trouble, try perl Makefile.PL -l\n" unless $::opt_l;
+ sleep 5;
+ $opts{DEFINE} .= ' $(HP64DEFINES)' if ($Config{archname} =~ /-thread\b/i and perl_is_64bit());
+ # linker doesn't understand +DD64 flag Weiguo Sun <wesun@cisco.com>
+ $opts{dynamic_lib}->{OTHERLDFLAGS} =~ s/\+DD64\b// if $opts{dynamic_lib}->{OTHERLDFLAGS};
# see also const_cccmd for -Aa to -Ae flag change
}
-# --- check for Test::Harness bug
+# --- check for Test::Harness bug
-eval { package WAIT; require 'wait.ph' };
-if (!$@ && !defined(&WAIT::WCOREDUMP)) {
- print "\n";
+print "\nChecking for functioning wait.ph\n";
+eval { package WAIT; local $^W = 0; require 'wait.ph' };
+if (!$@ && !defined(&WAIT::WCOREDUMP)) {
print "You have a wait.ph file generated by perl h2ph utility.\n";
+ print "(I found it at $INC{'wait.ph'})\n";
print "It does not define a WCOREDUMP function. That's probably an error.\n";
print "If a DBD::Oracle test fails then you will probably see a message\n";
print "from Test::Harness about WCOREDUMP being undefined. You can either ignore\n";
- print "it or try to fix your wait.ph file. The message does not reflect the\n";
+ print "it or try to fix your wait.ph file. The message DOES NOT reflect the\n";
print "cause of the test failure, it's just a problem interpreting the failure.\n";
- print "\n";
-}
+}
+print "\n";
# --- display summary information
@@ -634,51 +840,52 @@ if (!$@ && !defined(&WAIT::WCOREDUMP)) {
print "\n";
print "System: perl$] @Config{qw(myuname)}\n";
print "Compiler: @Config{qw(cc optimize ccflags)}\n";
-print "Linker: ". (find_bin('ld')||"not found") ."\n" unless $os eq 'VMS';
+print "Linker: ". (find_bin('ld')||"not found") ."\n" unless $^O eq 'VMS';
print "Sysliblist: ".read_sysliblist()."\n";
print "Oracle makefiles would have used these definitions but we override them:\n"
if $MK{CFLAGS} || $MK{LDFLAGS} || $MK{LDSTRING};
-print " CC: $MK{CC}\n\n" if $MK{CC};
+print " CC: $MK{CC}\n" if $MK{CC};
print " CFLAGS: $MK{CFLAGS}\n" if $MK{CFLAGS};
-print " [".mkvar('CFLAGS',0,1,0). "]\n\n" if $MK{CFLAGS};
+print " [".mkvar('CFLAGS',0,1,0). "]\n" if $MK{CFLAGS};
print " CLIBS: $MK{CLIBS}\n" if $MK{CLIBS};
-print " [".mkvar('CLIBS',0,1,0). "]\n\n" if $MK{CLIBS};
+print " [".mkvar('CLIBS',0,1,0). "]\n" if $MK{CLIBS};
if ($mk_target_rules{build} && !$::opt_b) {
my $rules = join "\n", '', @{ $mk_target_rules{build} };
$rules = expand_mkvars($rules, 0, 0, 1, 1) if $rules =~ /^\s*\$\(\w+\)\s*$/;
print " build: $rules\n";
-print " [".expand_mkvars($rules,0,1,0). "]\n\n";
+print " [".expand_mkvars($rules,0,1,0). "]\n";
}
print " LDFLAGS: $MK{LDFLAGS}\n" if $MK{LDFLAGS};
-print " [".mkvar('LDFLAGS',0,1,0). "]\n\n" if $MK{LDFLAGS};
+print " [".mkvar('LDFLAGS',0,1,0). "]\n" if $MK{LDFLAGS};
print " LDSTRING: $MK{LDSTRING}\n" if $MK{LDSTRING};
-print " [".mkvar('LDSTRING',0,1,0)."]\n\n" if $MK{LDSTRING};
-print "\nLinking with $linkwith_msg\n" if $linkwith_msg;
+print " [".mkvar('LDSTRING',0,1,0)."]\n" if $MK{LDSTRING};
+print "Linking with $linkwith_msg\n" if $linkwith_msg;
print "\n";
# --- display extra notes and warnings
-if ($os eq 'aix' and $osvers >= 4 and $Config{cc} ne 'xlc_r') {
- print "\n\n";
- print "Warning: You will may need to rebuild perl using the xlc_r compiler.$BELL\n";
- print " You may also need do: ORACCENV='cc=xlc_r'; export ORACCENV\n";
- print " Also see the README about the -p option\n";
+if ($^O eq 'aix' and $osvers >= 4 and $Config{cc} ne 'xlc_r') {
+ print "\n";
+ print "WARNING: You will may need to rebuild perl using the xlc_r compiler.\a\n";
+ print " The important thing is that perl and DBD::Oracle be built with the same compiler.\n";
+ print " You may also need to: ORACCENV='cc=xlc_r'; export ORACCENV\n";
+ print " Also see README.aix for gcc instructions and read about the -p option.\n";
sleep 5;
}
-if ($inspdver{rdbms_ver} >= 8.106 && $Config{archname} !~ /-thread\b/i) {
+if ($Config{archname} !~ /-thread\b/i) {
print "\n";
- print "Warning: If you have problems you may need to rebuild perl with threading enabled.$BELL\n";
+ print "WARNING: If you have problems you may need to rebuild perl with threading enabled.$BELL\n";
sleep 5;
}
if ($Config{usemymalloc} eq 'y') {
print "\n";
- print "Warning: If you have problems you may need to rebuild perl with -Uusemymalloc.$BELL\n";
+ print "WARNING: If you have problems you may need to rebuild perl with -Uusemymalloc.$BELL\n";
sleep 5;
}
-print "Warning: Your GNU C compiler is very old. Please upgrade.\n"
+print "WARNING: Your GNU C compiler is very old. Please upgrade.\n"
if ($Config{gccversion} and $Config{gccversion} =~ m/^(1|2\.[1-5])/);
if ($opts{LINKTYPE} && $opts{LINKTYPE} eq 'static') {
@@ -692,20 +899,87 @@ if ($opts{LINKTYPE} && $opts{LINKTYPE} eq 'static') {
# create this before WriteMakefile so MakeMaker knows it's here
open(MK_PM, ">mk.pm") or die "Unable to create mk.pm: $!";
-print "\n";
WriteMakefile( dbd_edit_mm_attribs(\%opts) );
-check_security() unless $os eq 'VMS' or $os eq 'MSWin32' or $os =~ /cygwin/i;
+check_security() unless $^O eq 'VMS' or $^O eq 'MSWin32' or $^O =~ /cygwin/i;
print "\n";
print "*** If you have problems...\n";
-print " read all the log printed above, and the README and README.help files.\n";
+print " read all the log printed above, and the README and README.help.txt files.\n";
print " (Of course, you have read README by now anyway, haven't you?)\n\n";
+vms_logical_names_sanity_check();
+
exit 0;
+# === utility functions ================================
-# =====================================================================
+sub vms_logical_names_sanity_check {
+ return unless $^O eq 'VMS';
+
+ unless ( $ENV{PERL_ENV_TABLES} ) { # perl_env_tables not set report
+ print <<'END_TXT';
+
+ The logical PERL_ENV_TABLES is not set.
+
+ This means that any logical names set when testing the package
+ will be set in the first logical name table that occurs in the
+ LNM$FILE_DEV list.
+
+ Please read the Readme.VMS file for further information.
+
+END_TXT
+
+ return;
+ }
+
+ return if grep { $ENV{$_} eq 'LNM$JOB' }
+ grep { /^PERL_ENV_TABLES;\d+$/ }
+ keys %ENV;
+
+# perl_env_tables set but the element we want is missing
+ print <<'END_TXT';
+
+ The logical PERL_ENV_TABLES is set, but without LNM$JOB.
+
+ Testing the package can fail because of inability to correctly
+ translate SYS$SCRATCH for temporary storage, as SYS$SCRATCH is
+ set at the JOB level.
+
+ To ensure that testing the package correctly translates SYS$SCRATCH,
+ please ensure that LNM$JOB is part of PERL_ENV_TABLES like this:
+
+ $ DEFINE PERL_ENV_TABLES LNM$PROCESS, LNM$JOB , CRTL_ENV
+END_TXT
+
+}
+
+
+
+sub find_oracle_home {
+ print "Trying to find an ORACLE_HOME\n";
+
+ my @path = split /\Q$Config{path_sep}/, $ENV{PATH};
+ print "using PATH @path\n" if $::opt_v;
+ # instant client has libclntsh in same dir as sqlplus
+ my @oh = grep { (glob("$_/libclntsh.$so*"))[0] } @path;
+
+ if (!@oh) { # failing that, try LD_LIBRARY_PATH or equiv
+ my (undef, undef, @ldlibpth) = ldlibpth_info(1);
+ print "using ldlib @ldlibpth\n" if $::opt_v;
+ @oh = grep { (glob("$_/libclntsh.$so*"))[0] } @ldlibpth;
+ # for instant client @oh may be actual ORACLE_HOME
+ # but for non-IC ORACLE_HOME may be dir above a /lib*
+ s:/lib\w*/?$:: for @oh; # remove possible trailing lib dir
+ }
+ if (!@oh) { # else try the traditional kind of install
+ # this should work for non-instant-client installs ($OH/bin & $OH/lib*)
+ @oh = grep { (glob("$_/../lib*/libclntsh.$so*"))[0] } @path;
+ s:/[^/]/?$:: for @oh;
+ }
+ print "Found @oh\n" if @oh;
+ return $oh[0];
+}
sub win32_oracle_home {
@@ -720,14 +994,14 @@ sub win32_oracle_home {
eval {
require Win32::TieRegistry;
$Win32::TieRegistry::Registry->Delimiter("/");
- $req_ok = 1;
- $hkey = $Win32::TieRegistry::Registry->{"LMachine/SOFTWARE/Oracle/"};
+ $hkey = $Win32::TieRegistry::Registry->{"LMachine/SOFTWARE/Oracle/"}
+ and $req_ok = 1;
};
eval { # older name of Win32::TieRegistry
require Tie::Registry;
$Tie::Registry::Registry->Delimiter("/");
- $req_ok = 1;
- $hkey = $Tie::Registry::Registry->{"LMachine/SOFTWARE/Oracle/"};
+ $hkey = $Tie::Registry::Registry->{"LMachine/SOFTWARE/Oracle/"}
+ and $req_ok = 1;
} unless $req_ok;
eval {
$default_home = $hkey->{ORACLE_HOME} || '';
@@ -824,13 +1098,14 @@ sub win32_oracle_home {
}
+
sub read_sysliblist {
my $syslibs = (-f "$OH/lib/sysliblist")
? read_file("$OH/lib/sysliblist")
: (-f "$OH/rdbms/lib/sysliblist") ? read_file("$OH/rdbms/lib/sysliblist") : '';
- #$syslibs =~ s/-l:lib(\w+).(sl|a)\b/-l$1/g if $os eq 'hpux';
- if ($os eq "hpux") {
+ if ($^O eq "hpux") {
$syslibs =~ s/-l:lib(\w+).(sl|a)\b/-l$1/g;
+ $syslibs =~ s/\s*-ldld\b//g;
$linkwith =~ m/-lcl\b/ or
$syslibs =~ s/\s*-lcl\b//g;
}
@@ -838,21 +1113,21 @@ sub read_sysliblist {
}
-sub hpux_lib64 {
- return ( $Config{ccflags} =~ /\+D(D64|A2\.0w)\b/ );
+sub perl_is_64bit {
+ return defined $Config{use64bitall} ;
}
-sub hpux_libdir {
+sub ora_libdir {
my $libdir = 'lib' ;
- if ( $inspdver{rdbms_ver} >= 9 ) {
- $libdir = 'lib32' if !hpux_lib64();
+ if ( $client_version >= 9 ) {
+ $libdir = 'lib32' if ! perl_is_64bit() and -d "$OH/lib32";
}
- elsif ( $inspdver{rdbms_ver} >= 8 ) {
- $libdir = 'lib64' if hpux_lib64();
+ else {
+ $libdir = 'lib64' if perl_is_64bit() and -d "$OH/lib64";
}
+
return $libdir;
}
-
sub del_crtobj {
my $orig = shift;
my $verbose = shift || $::opt_v;
@@ -872,58 +1147,63 @@ sub del_crtobj {
sub find_mkfile {
- my @mkfiles;
- my @mk_proc = (
- 'precomp/demo/proc/proc.mk',
- 'precomp/demo/proc/demo_proc.mk',
- 'proc/lib/proc.mk',
- 'proc16/lib/proc16.mk',
+ my @mk_oci32 = (
+ 'rdbms/demo/demo_xe.mk',
+ 'rdbms/demo/demo_rdbms32.mk',
+ 'rdbms/demo/demo_rdbms.mk',
+ 'rdbms/lib/ins_rdbms.mk' #Oracle 11 full client
);
- my @mk_oci = (
+ my @mk_oci64 = (
+ 'rdbms/demo/demo_xe.mk',
'rdbms/lib/oracle.mk',
'rdbms/demo/oracle.mk',
'rdbms/demo/demo_rdbms.mk',
- 'otrace/demo/atmoci.mk',
+ 'rdbms/demo/demo_rdbms64.mk',
+ 'rdbms/lib/ins_rdbms.mk' #Oracle 11 full client
+
);
- my @mkplaces = ($::opt_p) ? (@mk_proc,@mk_oci) : (@mk_oci,@mk_proc);
+ my @mk_oci = perl_is_64bit() ? @mk_oci64 : @mk_oci32;
+
+ # Add build.mk from /usr/share/oracle based on the oracle home location if
+ # oracle home is under /usr/lib/oracle (Linux RPM install).
+ # The 11g instant client only contains build.mk located in
+ # /usr/share/oracle/
+ push @mk_oci, "/usr/share/oracle/$1/demo.mk" if ($OH =~ m|^/usr/lib/oracle/(.*)|);
+
+ my @mkplaces = ($::opt_p) ? (@mk_oci) : (@mk_oci);
if ($::opt_m) {
$::opt_m = cwd()."/$::opt_m" unless $::opt_m =~ m:^/:;
die "-m $::opt_m: not found" unless -f $::opt_m;
unshift @mkplaces, $::opt_m;
}
- my ($mkfile, $place);
- foreach $place (@mkplaces) {
+ my $mkfile;
+ foreach my $place (@mkplaces) {
$place = "$OH/$place"
unless $place =~ m:^[/\.]:; # abs or relative path
next unless -f $place;
- push @mkfiles, $place;
+ $mkfile ||= $place; # use first one found
print "Found $place\n";
}
- $mkfile = $mkfiles[0]; # use first one found
die qq{
- Unable to locate an oracle.mk, proc.mk or other suitable *.mk
+ Unable to locate an oracle.mk or other suitable *.mk
file in your Oracle installation. (I looked in
- @mkplaces)
+ @mkplaces under $OH)
The oracle.mk (or demo_rdbms.mk) file is part of the Oracle
- RDBMS product. The proc.mk (or demo_proc.mk) file is part of
- the Oracle Pro*C product. You need to build DBD::Oracle on a
+ RDBMS product. You need to build DBD::Oracle on a
system which has one of these Oracle components installed.
(Other *.mk files such as the env_*.mk files will not work.)
+ Alternatively you can use Oracle Instant Client.
In the unlikely event that a suitable *.mk file is installed
somewhere non-standard you can specify where it is using the -m option:
perl Makefile.PL -m /path/to/your.mk
- See README.clients for more information and some alternatives.
+ See the appropriate README file for your OS for more information and some alternatives.
- } unless ($os eq 'MSWin32') || ($os eq 'VMS') || ($mkfile && -f $mkfile) || $::opt_F;
+ } unless ($^O eq 'MSWin32') || ($^O eq 'VMS') || ($mkfile && -f $mkfile) || $::opt_F;
print "Using $mkfile\n";
-
- warn "Note: Attempting to use makefile from otrace component. This may not work.\n"
- if ($mkfile =~ /atmoci.mk/);
-
return $mkfile;
}
@@ -947,12 +1227,13 @@ sub fetch_oci_macros {
" because it is not already set in the environment\n",
" and it can cause ORA-01019 errors.\n";
$_ = '';
- } unless $ENV{ORA_NLS} || $ENV{ORA_NLS33} || $ENV{ORA_NLS32};
+ } unless $ENV{ORA_NLS} || $ENV{ORA_NLS33} || $ENV{ORA_NLS32}
+ || 1; # Old problem? Let's try without it for a while
$edit{COMPOBJS} = q{
# Firstly a Solaris specific edit:
- $_ = del_crtobj($_) if $os eq 'solaris';
-
+ $_ = del_crtobj($_) if $^O eq 'solaris';
+
# Delete any object files in COMPOBJS that don't actually exist
my $of;
foreach $of (split(/=|\s+/)) {
@@ -961,12 +1242,15 @@ sub fetch_oci_macros {
next if -e $obj;
print "Deleting $of from COMPOBJS because $obj doesn't exist.\n";
s:\Q$of::;
- }
+ }
};
# deal with (some subversions) of Oracle8.0.3's incompatible use of OBJ_EXT
my $incompat_ext = ($MK{OBJ_EXT} && $MK{OBJ_EXT} !~ /^\./);
warn "OBJ_EXT correction enabled ($MK{OBJ_EXT})\n" if $incompat_ext;
+ # Don't include compiler options for these compilers
+ my @ignore_def = qw( BUILD_CCC296 BUILD_ICC );
+ my %ignore_def; @ignore_def{@ignore_def} = ('1') x @ignore_def;
my $mkver = 0;
my $lastline = '';
@@ -982,6 +1266,14 @@ sub fetch_oci_macros {
s/\.(\$\(OBJ_EXT\))/$1/g;
s/\.(\$\(LIB_EXT\))/$1/g;
}
+ # skip compiler options for undesirable compilers
+ m/^ifdef (\w+)/ and do {
+ if ($ignore_def{$1}) {
+ $_ = shift @lines until m/^endif/;
+ next;
+ }
+ };
+
if (m!^([-\w/+.\$()\s]+)\s*:+\s*([^=]*)!) { # skip targets
my @tgts = split(/ /, $1); # multiple target names in Oracle9i's demo_rdbms.mk
@@ -996,7 +1288,7 @@ sub fetch_oci_macros {
}
push @rules, $tmp_line;
#print "target @tgts => $mk_target_deps{$tgt} => @{$mk_target_rules{$tgt}}\n";
- }
+ }
for (@tgts) { push @{ $mk_target_rules{$_} ||= [] }, @rules }
next;
}
@@ -1068,7 +1360,7 @@ sub fetch_oci_macros {
else {
$linkvia .= '$(SSDBED) ' if $MK{SSDBED};
$linkvia .= '$(DEF_OPT) ' if $MK{DEF_OPT};
- if ($inspdver{RDBMS} =~ /^8\.0\./ and $os eq 'dec_osf' and $osvers >= 4.0) {
+ if ($client_version_full =~ /^8\.0\./ and $^O eq 'dec_osf' and $osvers >= 4.0) {
$linkvia .= '$(SCOREPT) $(NAETAB) $(NAEDHS) $(LLIBRDBMS_CLT) $(LLIBMM) ';
$linkvia .= '$(NETLIBS) $(CORELIBS) $(LLIBCOMMON) $(LLIBEPC) ';
$need_ldlp_env = "LD_LIBRARY_PATH";
@@ -1096,10 +1388,13 @@ sub fetch_oci_macros {
if ($MK{LLIBOCIC}) {
$linkvia = '$(LLIBOCIC) $(TTLIBS)';
} else {
- print "Warning: Guessing what to link with.\n";
+ print "WARNING: Guessing what to link with.\n";
$linkvia = '-locic $(TTLIBS)'; # XXX GUESS HACK
}
}
+ elsif (!$linkvia && $MK{CCLIB}) { # Oracle XE
+ $linkvia = '$(CCLIB)';
+ }
unless ($linkvia){
die "ERROR parsing $file: Unable to determine what to link with.\n"
."Please send me copies of these files (one per mail message):\n@mkfiles\n";
@@ -1137,7 +1432,7 @@ sub read_inc_file {
my %expand_shellescape;
-sub expand_shellescape {
+sub expand_shellescape {
my($orig, $level) = @_;
my $cmd = $orig;
my $debug = $::opt_d || $::opt_v;
@@ -1154,8 +1449,11 @@ sub expand_shellescape {
$result;
}
-sub expand_mkvars {
+sub expand_mkvars {
my ($string, $strip, $backtick, $level, $maxlevel) = @_;
+
+ return if(!defined $string);
+
$level ||= 1;
local($_) = $string;
print "$level Expanding $_\n" if $::opt_d;
@@ -1175,7 +1473,7 @@ sub expand_mkvars {
}
-sub mkvar {
+sub mkvar {
my($var, $strip, $backtick, $level, $maxlevel) = @_;
my $default = $strip ? '' : "\$($var)";
print "$level Variable: $var\n" if $::opt_d;
@@ -1214,31 +1512,79 @@ sub read_file {
sub find_bin{
my $bin = shift;
my $path_sep = $Config{path_sep};
- foreach (split(/$path_sep/, $ENV{PATH})){
- return "$_/$bin" if -x "$_/$bin";
+ foreach (split(/\Q$path_sep/, $ENV{PATH})){
+ return "$_/$bin" if -x "$_/$bin";
+ {
+ # let's try harder
+ # see rt#84530 for why we don't go straight for it
+ use filetest 'access';
+ return "$_/$bin" if -x "$_/$bin";
+ }
}
- return "<$bin not found>";
+ return undef;
}
sub find_headers {
- my (%h_dir, %h_file, @h_dir);
- find( sub {
- return unless /^o(ci.{3,4}|ratypes)\.h$/i;
- my $dir = $File::Find::dir;
- $dir =~ s:^\Q$OH/::;
- $h_dir{$dir} = $_;
- $h_file{$_} = $dir;
- print "Found $dir/$_\n" if $::opt_d;
- }, "$OH/rdbms" );
- @h_dir = keys %h_dir;
+
+ # compensate for case where final .0 isn't in the install directory name
+ (my $client_version_trim = $client_version_full) =~ s/\.0$//;
+
+ my @try = grep { -d $_ } ( # search the ORACLE_HOME we're using first
+ # --- Traditional full-install locations
+ "$OH/rdbms/public", # prefer public over others
+ "$OH/rdbms",
+ "$OH/plsql", # oratypes.h sometimes here (eg HPUX 11.23 Itanium Oracle 9.2.0),
+ # --- Oracle SDK Instant Client locations
+ "$OH/sdk/include",
+ # --- Oracle RPM Instant Client locations
+ map { ( $_, $_."64" ) }
+ map { ( $_, "/usr$_" ) }
+ map { "/include/oracle/$_/client" }
+ $client_version,
+ $client_version_trim,
+ $client_version_full,
+
+ #"/include/oracle/$client_version_full/client", # Instant Client for RedHat FC3
+ #"/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC3
+ #"/usr/include/oracle/$client_version/client64", # Instant Client 11.1 and up
+ #"/usr/include/oracle/$client_version/client", # Instant Client 11.1 and up
+ #"/usr/include/oracle/$client_version_full/client64", # Instant Client 64
+ #"/usr/include/oracle/$client_version_full/client", # Instant Client for RedHat FC4
+ #"/usr/include/oracle/$client_version_trim/client64", # Instant Client 64
+ #"/usr/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC4
+ );
+
+ # Add /usr/include/oracle based on the oracle home location if oracle home is under
+ # /usr/lib/oracle ( Linux RPM install ). The 11g instant client reports
+ # client_version as 11.1.0.6 from sqlplus, but installs under 11.1.0.1.
+ push @try, "/usr/include/oracle/$1" if ($OH =~ m|^/usr/lib/oracle/(.*)|);
+
+ unshift @try, $::opt_h if $::opt_h;
+ @try = grep { -d $_ } @try;
+
+ my %h_file;
+ if (@try) {
+ find( sub {
+ return unless /^o(ci.{3,4}|ratypes)\.h$/i;
+ my $dir = $File::Find::dir;
+ $h_file{$_} ||= $dir; # record first one found
+ print "Found $dir/$_\n" if $::opt_d;
+ }, @try);
+ }
+
+ my %h_dir = reverse %h_file; # distinct first found dirs
+ my @h_dir = keys %h_dir;
+
print "Found header files in @h_dir.\n" if @h_dir;
+
if (!$h_file{'oratypes.h'} || !$h_file{'ocidfn.h'}) {
print "\n\n*********************************************************\n";
print "I can't find the header files I need in your Oracle installation.\n";
print "You probably need to install some more Oracle components.\n";
+ print "For Instant Client that means the SDK package.\n";
print "I'll keep going, but the compile will probably fail.\n";
- print "See README.clients for more information.$BELL\n";
+ print "See the appropriate README file for your OS for more information.$BELL\n";
print "*********************************************************\n\n";
sleep 5;
}
@@ -1246,6 +1592,132 @@ sub find_headers {
}
+sub get_client_version {
+ my ($force_version) = @_;
+
+ my $client_version_full = '';
+
+ my $sqlplus_exe = ($^O eq 'Win32' || $^O eq 'MSWin32' || $^O eq 'cygwin') ? "sqlplus.exe" : "sqlplus";
+
+ # When building under Cygwin, ORACLE_HOME must be a native Windows
+ # path so Oracle itself can use it, but it needs to be translated
+ # to a Cygwin path so it can be joined into the PATH.
+ # Otherwise, the colon in the drive specification (e.g. "c:") is
+ # treated as a separator.
+ my $OH_path = $OH;
+ chomp($OH_path = `/usr/bin/cygpath -u $OH_path`) if $^O eq 'cygwin' && $OH;
+
+ # if we have an ORACLE_HOME then prepend it to the PATH
+ local $ENV{PATH} = join $Config{path_sep}, "$OH_path/bin", $OH_path, $ENV{PATH} if $OH;
+ print "PATH=$ENV{PATH}\n" if $::opt_v;
+
+ if (find_bin($sqlplus_exe)) {
+ local $ENV{SQLPATH} = ""; # avoid $SQLPATH/login.sql causing sqlplus to hang
+ # Try to use the _SQLPLUS_RELEASE predefined variable from sqlplus
+ # Documented in the SQL*Plus reference guide:
+ # http://download-west.oracle.com/docs/cd/B12037_01/server.101/b12170/ch13.htm#i2675128
+ # Output is in the following format:
+ # DEFINE _SQLPLUS_RELEASE = "902000400" (CHAR) Representing 9.2.0.4.0
+ # DEFINE _SQLPLUS_RELEASE = "1001000200" (CHAR) Representing 10.1.0.2.0
+ open FH, ">define.sql" or warn "Can't create define.sql: $!";
+ print FH "DEFINE _SQLPLUS_RELEASE\nQUIT\n";
+ close FH;
+ my $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`;
+ if ($sqlplus_release =~ /(SP2-0750)|(SP2-0642)/) {
+
+
+ my $x = $ENV{ORACLE_HOME};
+ delete $ENV{ORACLE_HOME};
+ $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`;
+ $ENV{ORACLE_HOME} = $x;
+ }
+ unlink "define.sql";
+ print $sqlplus_release; # the _SQLPLUS_RELEASE may not be on first line:
+ if ($sqlplus_release =~ /DEFINE _SQLPLUS_RELEASE = "(\d?\d)(\d\d)(\d\d)(\d\d)(\d\d)"/) {
+ $client_version_full = sprintf("%d.%d.%d.%d", $1, $2, $3, $4);
+ }
+ else {
+ my $ldlib_note = ($Config{ldlibpthname})
+ ? "Specifically, your $Config{ldlibpthname} environment variable"
+ : "Many systems need an environment variable (such as LD_LIBRARY_PATH, DYLD_LIBRARY_PATH)";
+ warn qq{
+ If sqlplus failed due to a linker/symbol/relocation/library error or similar problem
+ then it's likely that you've not configured your environment correctly.
+ $ldlib_note
+ set to include the directory containing the Oracle libraries.
+ \a\n};
+ sleep 5;
+ }
+ }
+ else {
+ warn "Can't find sqlplus. Pity, it would have helped.\n";
+ }
+
+ if (!$client_version_full && $OH && open INST, "<$OH/install/unix.rgs") {
+ local $/ = undef;
+ <INST> =~ m/^(rdbms|sql\*plus)\s+([\d.]+)/m;
+ $client_version_full = $2 if $2;
+ close INST;
+ }
+
+ if (!$client_version_full && $OH && -x "$OH/orainst/inspdver" ) {
+ open INST, "$OH/orainst/inspdver |"; # client only install does not have this
+ my @inspdver = <INST>;
+ close INST;
+ foreach (@inspdver) {
+ $client_version_full = $1 if m/^(\d+\.\d+\.\d+)\S*\s+.*RDBMS/;
+ next unless $::opt_v
+ or m/RDBMS/i or m/PL.SQL/i
+ or m/Precomp/i or m/Pro\*C/i;
+ print $_;
+ }
+ }
+ if (!$client_version_full) {
+ print "I'm having trouble finding your Oracle version number... trying harder\n"
+ unless $force_version;
+ if ( $OH =~ m\.\d+\.\d+(\.\d+)?)! ) { #decode it from $OH if possible
+ $client_version_full = $1;
+ }
+ elsif ( "$OH/" =~ m!\D(8|9|10)(\d)(\d?)\D!) { # scary but handy
+ $client_version_full = join ".", $1, $2, ($3||'0');
+ }
+ elsif ( "$OH/" =~ m!/10g!) { # scary but handy
+ $client_version_full = "10.0.0.0";
+ }
+ }
+
+ if ($force_version && $force_version ne $client_version_full) {
+ print "Forcing Oracle version to be treated as $force_version\n";
+ $client_version_full = $force_version;
+ }
+
+ if ($client_version_full && $client_version_full !~ m/^(7|8|9|1\d)\.\d+/
+ ) {
+ print "Oracle version seems to be $client_version_full but that looks wrong so I'll ignore it.\n";
+ $client_version_full = "";
+ }
+
+ if (!$client_version_full) {
+ $client_version_full = "8.0.0.0";
+ print qq{
+WARNING: I could not determine Oracle client version so I\'ll just
+default to version $client_version_full. Some features of DBD::Oracle may not work.
+Oracle version based logic in Makefile.PL may produce erroneous results.
+You can use "perl Makefile.PL -V X.Y.Z" to specify a your client version.\n
+};
+ sleep 5;
+ }
+
+ # hack up a simple floating point form of the version: 8.1.6.2 => 8.1
+ ($client_version = $client_version_full) =~ s/^(\d+\.\d+).*/$1/;
+
+ print "Oracle version $client_version_full ($client_version)\n";
+
+ return $client_version unless wantarray;
+ return ($client_version, $client_version_full);
+}
+
+
sub symbol_search {
$::opt_s ||= $::opt_S;
print "Searching for symbol '$::opt_s' in $OH ...\n";
@@ -1276,26 +1748,20 @@ sub symbol_search {
use strict;
use Config;
+ sub libscan {
+ my($self, $path) = @_;
+ return '' if $path =~ m/\.pl$/;
+ $path;
+ }
+
sub post_initialize {
my $self = shift;
- if (-f "$Config{installprivlib}/DBD/Oraperl.pm"){ # very old now
- print "
-Please note: the Oraperl.pm installation location has changed.
-It was: $Config{installprivlib}/DBD/Oraperl.pm
-Is now: $Config{installprivlib}/Oraperl.pm
-You have an old copy which you should delete when installing this one.\n";
- }
-
print "\nNote: \$ORACLE_HOME/lib must be added to your $need_ldlp_env environment variable\n",
"before running \"make test\" and whenever DBD::Oracle is used.\n\n"
if $need_ldlp_env && ($ENV{$need_ldlp_env}||'') !~ m:\Q$OH/lib\b:;
- # Ensure Oraperl.pm and oraperl.ph are installed into top lib dir
- $self->{PM}->{'Oraperl.pm'} = '$(INST_LIB)/Oraperl.pm';
- $self->{PM}->{'oraperl.ph'} = '$(INST_LIB)/oraperl.ph';
-
eval { # This chunk is for Oracle::OCI
require Data::Dumper;
print main::MK_PM Data::Dumper->Purity(1)->Terse(0)->Indent(1)->Useqq(1)
@@ -1326,24 +1792,29 @@ You have an old copy which you should delete when installing this one.\n";
sub const_loadlibs {
my $self = shift;
- local($_) = $self->SUPER::const_loadlibs(@_);
+
+ # ExtUtils::MM_Unix v1.50 (invoked by ExtUtils::MakeMaker)
+ # requires that $self->{LD_RUN_PATH} be defined and not be
+ # an empty string for Makefile to specify its use during the
+ # build. This is required by both SUPER::const_loadlibs
+ # and SUPER::dynamic_lib. hence it is best if we define
+ # or modify $self->{LD_RUN_PATH} here *before* calling
+ # SUPER::const_loadlibs.
+
+
# edit LD_RUN_PATH ...
- my ($ldrp) = m/^LD_RUN_PATH\s*=\s*(.*)/m;
+ my ($ldrp) = $self->{LD_RUN_PATH};
# remove redundant /lib or /usr/lib as it can cause problems
- $ldrp =~ s!:(/usr)?/lib$!!;
- # if it's empty then set it manually
- $ldrp ||= "$OH/lib:$OH/rdbms/lib";
- #Lincoln: if hpux, pick the right library path
- if ( $os eq 'hpux' and $osvers >= 11 ) {
- my $libdir = hpux_libdir();
- $ldrp =~ s!/lib\b!/$libdir!g;
- #print "ldrp=$ldrp\n";
- }
+ $ldrp =~ s!:(/usr)?/lib$!! if $ldrp;
+ # if it's empty then set it manually
+ #Lincoln: if pick the right library path
+ my $libdir = main::ora_libdir();
+ $ldrp ||= "$OH/$libdir:$OH/rdbms/$libdir";
+ $self->{LD_RUN_PATH} = $ldrp;
+
+ local($_) = $self->SUPER::const_loadlibs(@_);
- # stitch it back in
- s/^LD_RUN_PATH\s*=\s*(.*)/LD_RUN_PATH=$ldrp/m;
- my $env = $ENV{LD_RUN_PATH};
- print "Ignoring LD_RUN_PATH='$env' in environment\n" if $env;
+ print "Ignoring LD_RUN_PATH='$ENV{LD_RUN_PATH}' in environment\n" if $ENV{LD_RUN_PATH};
print "LD_RUN_PATH=$ldrp\n";
return $_;
}
@@ -1376,7 +1847,7 @@ ORACLE_HOME = '.$OH.'
local($_) = $self->SUPER::const_cccmd(@_);
# If perl Makefile.PL *-g* then switch on debugging
if ($::opt_g) {
- if ($os eq "MSWin32" and $Config::Config{cc} eq 'cl') {
+ if ($^O eq "MSWin32" and $Config::Config{cc} eq 'cl') {
s/\s-/ -Zi -/;
s/-O1//;
} else {
@@ -1385,7 +1856,7 @@ ORACLE_HOME = '.$OH.'
}
}
# are we using the non-bundled hpux compiler?
- if ($os eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) {
+ if ($^O eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) {
print "Changing -Aa to -Ae for HP-UX in ccmd.\n"
if s/-Aa\b/-Ae/g; # allow "long long" in oratypes.h
}
@@ -1398,17 +1869,17 @@ ORACLE_HOME = '.$OH.'
local($_) = $self->SUPER::cflags(@_);
# If perl Makefile.PL *-g* then switch on debugging
if ($::opt_g) {
- if ($os eq "MSWin32" and $Config::Config{cc} eq 'cl') {
+ if ($^O eq "MSWin32" and $Config::Config{cc} eq 'cl') {
s/\s-/ -Zi -/;
s/-O1//;
-
+
} else {
s/\s-O\d?\b//; # delete optimise option
s/\s-/ -g -/; # add -g option
}
}
# are we using the non-bundled hpux compiler?
- if ($os eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) {
+ if ($^O eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) {
print "Changing -Aa to -Ae for HP-UX in cflags.\n"
if s/-Aa\b/-Ae/g; # allow "long long" in oratypes.h
}
@@ -1418,12 +1889,15 @@ ORACLE_HOME = '.$OH.'
sub dynamic_lib {
my($self) = shift;
- unless ($os eq 'VMS') {
- my $m;
- $m = $self->SUPER::dynamic_lib(@_);
- if ($os eq 'darwin') {
- $m = "NMEDIT = nmedit\n" . $m .
- "\t\$(NMEDIT) -R ./hints/macos_bundle.syms \$(INST_DYNAMIC)\n";
+ unless ($^O eq 'VMS') {
+ my $m = $self->SUPER::dynamic_lib(@_);
+ if ($^O eq 'darwin') {
+ $m = "NMEDIT = nmedit\n" . $m .
+ "\t\$(NMEDIT) -R ./hints/macos_bundle.syms \$(INST_DYNAMIC) || true\n";
+ }
+ elsif (($^O eq 'hpux') and ($osvers <11)) {
+ $m =~ s/LD_RUN_PATH=(\S+)\s+(\S+)/$2 -Wl,+b $1/;
+
}
return ($m);
}
@@ -1453,7 +1927,7 @@ $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)
$(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config::Config{'dlext'},'
Lnproc $(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option i
';
-
+
}
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
join('',@m);
@@ -1462,12 +1936,63 @@ $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)
}
+sub ldlibpth_info {
+ my $verbose = shift;
+
+ my ($ldlibpthname, $val);
+
+ if ($^O eq "hpux") { # hpux is odd again: can use two env vars
+ my @envs = grep { $ENV{$_} } qw( LD_LIBRARY_PATH SHLIB_PATH );
+ $ldlibpthname = join "/", @envs;
+ $val = join $Config{path_sep}, @ENV{@envs}
+ }
+ else {
+ $ldlibpthname = $Config{ldlibpthname} or return;
+ $val = $ENV{$ldlibpthname} || '';
+ }
+
+ print "Your $ldlibpthname env var is set to '$val'\n" if $verbose;
+
+ return ( $ldlibpthname, $val, split /\Q$Config{path_sep}/, $val );
+}
+
+
+sub check_ldlibpthname {
+ my $libdir = shift || join '/', $OH, ora_libdir();
+
+ $libdir =~ s:[\\/]$::; # cut final / or \
+
+ my ($ldlibpthname, $val, @dirs) = ldlibpth_info(1);
+
+ my $warn_name = $ldlibpthname;
+
+ return 1 if grep { s:[\\/]$::; $_ eq $libdir } @dirs;
+
+ # on solaris, it can be under LD_LIBRARY_PATH_(32|64)
+ if ( $^O eq 'solaris' ) {
+ my $ld_library_path_name = 'LD_LIBRARY_PATH_'
+ . ( perl_is_64bit() ? '64' : '32' );
+
+ $warn_name .= " or $ld_library_path_name";
+
+ my @dirs = split quotemeta($Config{path_sep}),
+ $ENV{$ld_library_path_name};
+
+ s#[\\/]$## for @dirs; # cut potential final / or \
+
+ return if grep { $_ eq $libdir } @dirs;
+ }
+
+ warn "WARNING: Your $warn_name env var doesn't include '$libdir' but probably needs to.\n";
+}
+
+
sub check_security {
# check for the SUID/SGID bits on ORACLE_HOME/bin/oratclsh
# if set, this allows a user to fork a root shell!
# Get the octal portion of perms that indicates
# SUID and SGID, and warn if either is set
-
+
my @files = map { ($_,$_.'0') } qw(
oratclsh lsnrctl oemevent onrsd osslogin tnslsnr
tnsping trcasst trcroute cmctl cmadmin cmgw names namesctl otrccref
@@ -1486,9 +2011,34 @@ sub check_security {
print "\n";
warn "*** WARNING - YOUR ORACLE INSTALLATION HAS A SECURITY PROBLEM.$BELL\n";
- warn " Read the README.sec file for more information and patch details.$BELL\n";
+ warn " Read the README.sec.txt file for more information and patch details.$BELL\n";
warn " This is just a warning. It does not affect DBD::Oracle in any way.\n\n";
sleep 6;
}
+sub check_macos_symbol_table {
+ # Check for symbol table problem in libclntsh.dylib.9.0 on MacOS X
+ return unless $^O eq 'darwin';
+ my $oracle_lib = "$OH/lib/libclntsh.dylib";
+
+ return unless -f $oracle_lib;
+
+ open my $nm_fh, '-|', "nm $oracle_lib"
+ or die "couldn't run 'nm $oracle_lib': $!";
+
+ while ( <$nm_fh> ) {
+ return if /^\s+U _(dlsym|dlclose)/;
+ }
+
+ warn <<"END_WARNING";
+WARNING: symbol table may need modification in Oracle library:
+ $oracle_lib
+If the build fails in the linking stage, manual modification is
+required - see README.macosx.txt
+END_WARNING
+
+ return;
+}
+
__END__
+
@@ -1,36 +0,0 @@
-This directory contains a few sample DBI/DBD::Oracle scripts. Some are
-genuinely useful while others are just demonstrations of different things.
-They are adapted from the Oraperl example scripts in ../Oraperl.ex/ to
-show how to do the same things in Perl 5 and DBI.
-
-$dbh->{RaiseError} is set to 1 in all scripts for automatic error checking.
-
-bind.pl Demonstrates how execute() and fetchrow_array() may be
- combined to make a simple table lookup program with placeholders.
-
-commit.pl Demonstrates the use of commit() and rollback().
-
-ex.pl Reads data from a table and prints it using a format.
- Also illustrates how to recognise NULL fields and bind_columns
- with known column names.
-
-japh Just another Perl hacker, written for DBI.
- This is no one-liner, but it demonstrates a few things.
-
-mktable.pl Creates a table, puts some data into it, drops it.
- Demonstrates do(), placeholders, inserting and reading NULL values,
- and bind_columns() with known columns.
-
-oradump.pl Dumps an Oracle table as a set of INSERT statements.
- Demonstrates the use of $sth->{TYPE}, $dbh->quote(),
- and bind_columns() with unknown column names.
-
-proc.pl Demonstrates how to get values into and out of stored procedures
- and how to receive result sets.
-
-sql Demonstrates the use of $sth->{NUM_OF_FIELDS}, $sth->{NAME},
- $sth->{PRECISION}, and bind_columns() with unknown column names.
-
-tabinfo.pl Displays the structure of the specified table.
- Demonstrates the use of $sth->{NAME}, $sth->{PRECISION},
- $sth->{TYPE}, and type_info_all().
@@ -1,45 +0,0 @@
-#!/usr/bin/perl -w
-#
-# bind.pl
-#
-# This shows how a placeholder may be used to implement a simple lookup.
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-# Prepare the SELECT statement using a placeholder
-my $sth = $dbh->prepare( 'SELECT created FROM all_users WHERE username = ?' );
-
-my ( $created );
-$| = 1;
-print "Enter an empty line to finish\n";
-print "Userid? ";
-while ( <STDIN> ) {
- chomp;
- last if ! $_;
- $sth->execute( uc( $_ ) );
-
- # Note that the variable is in parenthesis to give an array context
- if ( ( $created ) = $sth->fetchrow_array ) {
- print "$created\n";
- }
- else {
- print "unknown\n";
- }
- print "Userid? ";
-}
-
-$sth->finish;
-$dbh->disconnect;
@@ -1,72 +0,0 @@
-#!/usr/bin/perl -w
-#
-# commit.pl
-#
-# Simple example of using commit and rollback.
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-# Create the table to hold prime numbers
-print "Creating table\n";
-eval { $dbh->do( 'CREATE TABLE primes ( prime NUMBER )' ); };
-warn $@ if $@;
-
-print "Loading table";
-my $sth = $dbh->prepare( 'INSERT INTO primes VALUES ( ? )' );
-while ( <DATA> ) {
- chomp;
- print " $_";
- $sth->execute( $_ );
- print " commit (", $dbh->commit, ")" if 11 == $_;
-}
-print "\n";
-
-my $prime;
-print "Reading table for the first time\n";
-$sth = $dbh->prepare( 'SELECT prime FROM primes ORDER BY prime' );
-$sth->execute;
-$sth->bind_columns( {}, \$prime );
-while ( $sth->fetch ) {
- print " $prime";
-}
-$sth->finish;
-print "\n";
-
-print "rollback (", $dbh->rollback, ")\n";
-
-print "Reading table for the second time.\n";
-$sth->execute;
-$sth->bind_columns( {}, \$prime );
-while ( $sth->fetch ) {
- print " $prime";
-}
-$sth->finish;
-print "\n";
-
-$dbh->do( 'DROP TABLE primes' );
-print "Table Dropped\n";
-$dbh->disconnect;
-__END__
-2
-3
-5
-7
-11
-13
-17
-19
-23
-29
@@ -1,93 +0,0 @@
-#!/usr/bin/perl
-#
-# curref.pl - by Geoffrey Young
-#
-# for this example, we create a package that contains
-# two procedures:
-# emp_cursor - returns a specific cursor reference
-# ref_cursor_close - closes any cursor reference
-#
-# to actually run this example as is, you will need the
-# oracle demo tables. otherwise, it's just sample code...
-
-use DBI;
-use DBD::Oracle qw(:ora_types);
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-my $sql = qq(
- CREATE OR REPLACE PACKAGE curref_test
- IS
- TYPE cursor_ref IS REF CURSOR;
- PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref);
- PROCEDURE ref_cursor_close (curref IN cursor_ref);
- END;
-);
-my $rv = $dbh->do($sql);
-print "The package has been created...\n";
-
-$sql = qq(
- CREATE OR REPLACE PACKAGE BODY curref_test
- IS
- PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref)
- IS
- BEGIN
- OPEN curref FOR select ename, job from emp where job = job_in;
- END;
-
- PROCEDURE ref_cursor_close (curref IN cursor_ref)
- IS
- BEGIN
- close curref;
- END;
- END;
-);
-$rv = $dbh->do($sql);
-print "The package body has been created...\n";
-
-print "These are the results from the ref cursor:\n";
-$sql = qq(
- BEGIN
- curref_test.emp_cursor(:job_in, :curref);
- END;
-);
-my $curref;
-my $sth = $dbh->prepare($sql);
-$sth->bind_param(":job_in", "CLERK");
-$sth->bind_param_inout(":curref", \$curref, 0, {ora_type => ORA_RSET});
-$sth->execute;
-$curref->dump_results;
-open_cursors();
-
-$sql = qq(
- BEGIN
- curref_test.ref_cursor_close(:curref);
- END;
-);
-$sth = $dbh->prepare($sql);
-$sth->bind_param(":curref", $curref, {ora_type => ORA_RSET});
-$sth->execute;
-
-print "The cursor is now closed\n";
-print "just to prove it...\n";
-open_cursors();
-
-$dbh->disconnect;
-
-sub open_cursors {
- print "Here are the open cursors:\n";
- $sth = $dbh->prepare('select user, sql_text from V$OPEN_CURSOR');
- $sth->execute;
- $sth->dump_results;
-}
\ No newline at end of file
@@ -1,47 +0,0 @@
-#!/usr/bin/perl -w
-# Short example using bind_columns() to list a table's values
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass [max]" if 3 > @ARGV;
-my ( $inst, $user, $pass, $max ) = @ARGV;
-$max = 20 if ! $max || 0 > $max;
-
-my ( $name, $id, $created );
-format STDOUT_TOP =
- Name ID Created
- ============================== ========= =========
-.
-
-format STDOUT =
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @<<<<<<<<
- $name, $id, $created
-.
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-my $sth = $dbh->prepare(
- "SELECT username, user_id, created FROM all_users ORDER BY username" );
-$sth->execute;
-
-my $nfields = $sth->{NUM_OF_FIELDS};
-print "Query will return $nfields fields\n\n";
-
-$sth->bind_columns( {}, \( $name, $id, $created ) );
-while ( $sth->fetch ) {
- last if ! --$max;
- # mark any NULL fields found
- foreach ( $name, $id, $created ) { $_ = 'NULL' if ! defined; }
- write;
-}
-
-$sth->finish;
-$dbh->disconnect;
@@ -1,52 +0,0 @@
-#!/usr/bin/perl -w
-# This is an example of how we could code a JAPH using DBI and DBD::Oracle.
-#
-# Original oraperl script by Kevin Stock
-# Date: 1st December 1992
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-# Create the sample table
-$dbh->do( "CREATE TABLE japh ( word CHAR(7), posn NUMBER(1) )" );
-
-# Loop to insert data into the table
-my $sth = $dbh->prepare( "INSERT INTO japh VALUES ( ?, ? )" );
-while ( <DATA> ) {
- chomp;
- $sth->execute( split ':', $_ );
-}
-
-# Now retrieve the data, printing it word by word
-$sth = $dbh->prepare( "SELECT word FROM japh ORDER BY posn" );
-$sth->execute;
-my $word;
-$sth->bind_columns( {}, \$word );
-$sth->{ChopBlanks} = 1; # Wouldn't you rather use VARCHAR2 instead of CHAR?
-while ( $sth->fetch ) {
- print " $word";
-}
-$sth->finish;
-print "\n";
-
-# delete the table
-$dbh->do( 'DROP TABLE japh' );
-$dbh->disconnect;
-
-__END__
-DBI:3
-another:2
-hacker:4
-just:1
@@ -1,102 +0,0 @@
-#!/usr/bin/perl -w
-# Sample DBI program to create a new table and load data into it.
-#
-# Author: Kevin Stock (original oraperl script)
-# Date: 5th August 1991
-# Date: 25th September 1992
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-# set these as strings to make the code more readable
-my $CREATE = "CREATE TABLE tryit ( name VARCHAR2(10), ext NUMBER(3) )";
-my $INSERT = "INSERT INTO tryit VALUES ( ?, ? )";
-my $LIST = "SELECT * FROM tryit ORDER BY name";
-my $DELETE = "DELETE FROM tryit WHERE name = ?";
-my $DELETE_NULL = "DELETE FROM tryit WHERE name IS NULL";
-my $DROP = "DROP TABLE tryit";
-
-# Can use dynamic variables in write as long as they are visible at format time
-my ( $msg, $name, $ext );
-
-# Prepare formats for output
-format STDOUT_TOP =
-
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- $msg
-
- Name Ext
- ==== ===
-.
-
-format STDOUT =
- @<<<<<<<<< @>>
- $name, $ext
-.
-
-# function to list the table
-sub list {
- $msg = join "\n", @_;
- $- = 0;
- my $sth = $dbh->prepare( $LIST );
- $sth->execute;
- $sth->bind_columns( {}, \( $name, $ext ) );
- while ( $sth->fetch ) {
- $name = '<NULL>' unless defined $name;
- $ext = '<N>' unless defined $ext;
- write;
- }
- $sth->finish;
-}
-
-# create the database
-$dbh->do( $CREATE );
-
-# put some data into it
-my $sth = $dbh->prepare( $INSERT );
-while ( <DATA> ) {
- chomp;
- $sth->execute( map { 'NULL' eq $_ ? undef : $_ } split /:/, $_, 2 );
-}
-$dbh->commit;
-list( 'Initial Data' );
-
-# remove a few rows
-$sth = $dbh->prepare( $DELETE );
-foreach $name ( 'catherine', 'angela', 'arnold', 'julia' ) {
- $sth->execute( $name );
-}
-$dbh->commit;
-list( 'After removing selected people' );
-
-# Remove some rows with NULLs
-$dbh->do( $DELETE_NULL );
-list( 'After removing NULL names' );
-
-# remove the table and disconnect
-$dbh->do( $DROP );
-$dbh->disconnect;
-
-# This is the data which will go into the table
-__END__
-julia:292
-angela:208
-NULL:999
-larry:424
-catherine:201
-nonumber:NULL
-randal:306
-arnold:305
-NULL:NULL
@@ -1,42 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Dump the contents of an Oracle table into a set of insert statements.
-# Quoting is controlled by the datatypes of each column. (new with DBI)
-#
-# Usage: oradump <database> <user> <pass> <table>
-#
-# Author: Kevin Stock (original oraperl script)
-# Date: 28th February 1992
-#
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 base user pass table\n" if 4 > @ARGV;
-my ( $base, $user, $pass, $table ) = @ARGV;
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-my $sth = $dbh->prepare( "SELECT * FROM $table");
-$sth->execute;
-my @name = @{$sth->{NAME}};
-my @type = @{$sth->{TYPE}};
-my $lead = "INSERT INTO $table ( " . join( ', ', @name ) . " ) VALUES ( ";
-my ( @data, $i );
-$sth->bind_columns( {}, \( @data[0 .. $#name] ) );
-while ( $sth->fetch ) {
- $i = 0;
- print $lead . join( ", ", map { $dbh->quote( $_, $type[$i++] ) } @data ) .
- # print $lead . join( ", ", map { $dbh->quote( $_ ) } @data ) . # for old DBI
- " );\n";
-}
-
-$sth->finish;
-$dbh->disconnect;
@@ -1,148 +0,0 @@
-#!/usr/bin/perl -w
-# Short examples of procedure calls from Oracle.pm
-# These PL/SQL examples come from: Eric Bartley <bartley@cc.purdue.edu>.
-
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
-my ( $inst, $user, $pass ) = @ARGV;
-
-# So we don't have to check every DBI call we set RaiseError.
-# See the DBI docs if you're not familiar with RaiseError.
-# AutoCommit is currently encouraged and may be required later.
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die "Unable to connect: $DBI::errstr";
-
-# Create the package for the examples
-$dbh->do( <<END_PLSQL_EXAMPLE );
-CREATE OR REPLACE PACKAGE plsql_example IS
- PROCEDURE proc_np;
- PROCEDURE proc_in( err_code IN NUMBER );
- PROCEDURE proc_in_inout( test_num IN NUMBER, is_odd IN OUT NUMBER );
- FUNCTION func_np RETURN VARCHAR2;
-END plsql_example;
-END_PLSQL_EXAMPLE
-
-$dbh->do( <<END_PLSQL_EXAMPLE );
-CREATE OR REPLACE PACKAGE BODY plsql_example IS
- PROCEDURE proc_np IS
- whoami VARCHAR2(20) := NULL;
- BEGIN
- SELECT user INTO whoami FROM DUAL;
- END;
-
- PROCEDURE proc_in( err_code IN NUMBER ) IS
- BEGIN
- RAISE_APPLICATION_ERROR( err_code, 'This is a test.' );
- END;
-
- PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ) IS
- BEGIN
- is_odd := MOD( test_num, 2 );
- END;
-
- FUNCTION func_np RETURN VARCHAR2 IS
- ret_val VARCHAR2(20);
- BEGIN
- SELECT user INTO ret_val FROM DUAL;
- RETURN ret_val;
- END;
-END plsql_example;
-END_PLSQL_EXAMPLE
-
-my $sth;
-
-print "\nExample 1\n";
-# Calling a PLSQL procedure that takes no parameters. This shows you the
-# basic's of what you need to execute a PLSQL procedure. Just wrap your
-# procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
-#
-# p.s. If you've used SQL*Plus's exec command all it does is wrap the
-# command in a BEGIN END; block for you.
-
-$sth = $dbh->prepare( q{
-BEGIN
- plsql_example.proc_np;
-END;
-} );
-$sth->execute;
-
-
-print "\nExample 2\n";
-# Now we call a procedure that has 1 IN parameter. Here we use bind_param
-# to bind out parameter to the prepared statement just like you might
-# do for an INSERT, UPDATE, DELETE, or SELECT statement.
-#
-# I could have used positional placeholders (e.g. :1, :2, etc.) or
-# ODBC style placeholders (e.g. ?), but I prefer Oracle's named
-# placeholders (but few DBI drivers support them so they're not portable).
-#
-# proc_in() will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
-# Because we set RaiseError, the DBI will die() so we catch that with eval {}.
-
-my $err_code = -20001;
-
-$sth = $dbh->prepare( q{
-BEGIN
- plsql_example.proc_in( :err_code );
-END;
-} );
-$sth->bind_param( ":err_code", $err_code );
-eval { $sth->execute; };
-print 'After proc_in: $@ = ', "'$@', errstr = '$DBI::errstr'\n";
-
-
-print "\nExample 3\n";
-# Building on the last example, I've added 1 IN OUT parameter. We still
-# use a placeholders in the call to prepare, the difference is that
-# we now call bind_param_inout to bind the value to the place holder.
-#
-# Note that the third parameter to bind_param_inout is the maximum size
-# of the variable. You normally make this slightly larger than necessary.
-# But note that the perl variable will have that much memory assigned to
-# it even if the actual value returned is shorter.
-
-my $test_num = 5;
-my $is_odd;
-
-$sth = $dbh->prepare( q{
-BEGIN
- plsql_example.proc_in_inout( :test_num, :is_odd );
-END;
-} );
-
-# The value of $test_num is _copied_ here
-$sth->bind_param( ":test_num", $test_num );
-$sth->bind_param_inout( ":is_odd", \$is_odd, 1 );
-
-# The execute will automagically update the value of $is_odd
-$sth->execute;
-print "$test_num is ", $is_odd ? "odd - ok" : "even - error!", "\n";
-
-
-print "\nExample 4\n";
-# What about the return value of a PL/SQL function? Well treat it the same
-# as you would a call to a function from SQL*Plus. We add a placeholder
-# for the return value and bind it with a call to bind_param_inout so
-# we can access it's value after execute.
-
-my $whoami = "";
-
-$sth = $dbh->prepare( q{
-BEGIN
- :whoami := plsql_example.func_np;
-END;
-} );
-$sth->bind_param_inout( ":whoami", \$whoami, 30 );
-$sth->execute;
-print "Your database user name is $whoami\n";
-
-# Get rid of the example package
-$dbh->do( 'DROP PACKAGE plsql_example' );
-$dbh->disconnect;
@@ -1,235 +0,0 @@
-#!/usr/bin/perl -w
-'di';
-'ig00';
-# See usage() for syntax
-
-use Getopt::Long;
-
-use DBI;
-
-use strict;
-
-# Default values for options
-my ( $trace, $inst, $cache, $delim, $format, $headers, $page_len, $null_str ) =
- ( 0, $ENV{TWO_TASK} || $ENV{ORACLE_SID} || '', '', "\t", 0, 0, 60, '' );
-
-# Syntax description
-sub usage {
- my ( $sOpt, $sVal, @sMsg ) = @_;
-
- my $sHelpText = <<END_HELP_END;
-Execute a SQL statement
-syntax: $0 [options] name pass [stmt]
-Options:
- -h Write this help to STDOUT
- -t trace trace control string
- -b base database to use (default $inst)
- -c cache SQL fetch cache size in rows
- -d delim specifies the field delimiter (default TAB)
- -F format output, similar to sqlplus
- -H add headers, not allowed if formatting
- -l page_len lines per page, only used by -f (default $page_len)
- -n string replace NULL fields by string
-Arguments:
- name Oracle username
- pass Password
- stmt Oracle statement to be executed
- it is read from STDIN if not given on command line
-END_HELP_END
-# Balance quotes in here document # ' # "
-
- my $nRet = 'help' eq $sOpt ? 0 : 0 + $sVal;
- my $fh = $nRet ? *STDERR : *STDOUT;
- foreach ( @sMsg, $sHelpText ) { s/\s+$//; print $fh "$_\n"; }
- exit $nRet;
-}
-
-# Get options and arguments
-Getopt::Long::config( qw( no_ignore_case no_auto_abbrev require_order ) );
-GetOptions(
- 'help|h' => \&usage,
- 'trace|t=i' => \$trace,
- 'base|b=s' => \$inst,
- 'cache|c=i' => \$cache,
- 'delim|d=s' => \$delim,
- 'Format!' => \$format, 'F!' => \$format,
- 'Headers!' => \$headers, 'H!' => \$headers,
- 'len|len=i' => \$page_len,
- 'null|n=s' => \$null_str,
- ) or usage( 'die', 1 );
-usage( 'die', 1, "Only one of -F and -H may be specified\n" )
- if $format && $headers;
-
-usage( 'die', 1, 'Username and password are required' ) if 2 > @ARGV;
-my ( $user, $pass, @stmt ) = @ARGV;
-if ( ! @stmt ) {
- print "Enter the statement to execute (^D to end):\n";
- @stmt = <STDIN>;
-}
-usage( 'die', 1, "A statement is required" ) if ! @stmt;
-
-$\ = "\n"; # each record terminated with newline
-$, = $delim; # set column delimiter
-$= = $page_len; # set page length
-
-# Set trace level
-DBI->trace( $trace );
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-$dbh->{RowCacheSize} = $cache if $cache; # set fetch cache
-
-# Start statement
-my $sth = $dbh->prepare( join "\n", @stmt );
-$sth->execute;
-my $nfields = $sth->{NUM_OF_FIELDS};
-
-# print out any information which comes back
-if ( $nfields ) {
- # the statement has output columns
- my ( @col, $col );
- my @name = @{$sth->{NAME}};
- if ( $format ) {
- # build format statements for the data
- my @size = @{$sth->{PRECISION}};
-
- # First, the header - a list of field names, formatted
- # in columns of the appropriate width
- my $fmt = join '|', map { "%-${_}.${_}s" } @size;
- $fmt = sprintf $fmt, @name;
- $format = "format STDOUT_TOP =\n" . $fmt . "\n";
-
- # Then underlines for the field names
- $fmt =~ tr/|/-/c;
- $fmt =~ tr/|/+/;
- $format .= $fmt . "\n.\n";
-
- # Then for the data format, a @<<... field per column
- $fmt =~ tr/-+/<|/;
- $fmt =~ s/(^|\|)</$1@/g;
- $format .= "format STDOUT =\n" . $fmt . "\n";
-
- # Finally the variable associated with each column
- # Why doesn't Perl let us specify an array here?
- $format .= join ', ', map { "\$col[$_]" } 0 .. $#name;
- $format .= "\n.\n";
-
- eval($format);
- }
- elsif ( $headers ) {
- # Simple headers with underlines
- print map { s/\s+$//; $_ } @name;
- print map { tr//-/c; $_ } @name;
- }
-
- # Associate @col with output columns and fetch the rows
- $sth->bind_columns( {}, \( @col[0 .. $#name] ) );
- while ( $sth->fetch ) {
- foreach $col ( @col ) { $col = $null_str if ! defined $col; }
- $format ? write : print @col;
- }
-}
-
-# finish off neatly
-$sth->finish;
-$dbh->disconnect;
-
-__END__ # no need for perl even to scan the rest
-
-##############################################################################
-
- # These next few lines are legal in both Perl and nroff.
-
-.00; # finish .ig
-
-'di \" finish diversion--previous line must be blank
-.nr nl 0-1 \" fake up transition to first page again
-.nr % 0 \" start at page 1
-';<<'.ex'; ############## From here on it's a standard manual page ############
-.TH SQL L "5th July 1999"
-.ad
-.nh
-.SH NAME
-sql \- execute an Oracle SQL statement from the command line
-.SH SYNOPSIS
-\fBsql\fP
-[\fB\-b\fP\fIbase\fP]
-[\fB\-c\fP\fIcache\fP]
-[\fB\-d\fP\fIdelim\fP]
-[\fB\-F\fP|\fB\-H\fP]
-[\fB\-l\fP\fIpage_len\fP]
-[\fB\-n\fP\fIstring\fP]
-\fIname\fP \fIpassword\fP
-\fIstatement\fP
-.SH DESCRIPTION
-.I Sql
-connects to an Oracle database
-using the \fIname\fP and \fIpassword\fP supplied
-and executes the given SQL \fIstatement\fP
-displaying the result
-on its standard output.
-
-The \fB\-b\fP\fIbase\fP flag may be supplied to specify the database to be used.
-If it is not given, the database specified by the environment variable
-\fBTWO_TASK\fP or \fBORACLE_SID\fP is used.
-
-The \fB\-c\fP\fIcache\fP flag may be supplied to set the size of fetch cache
-to be used. If it is not given, the default is used.
-
-If the \fB\-n\fP\fIstring\fP flag is supplied,
-\fBNULL\fP fields (in the \fIOracle\fP sense)
-will replaced in the output by \fIstring\fP.
-Normally, they are left blank.
-
-The \fB\-F\fP and \fB\-H\fP flags may be used to modify the form of the output.
-Without either flag, no field headers are printed
-and fields are not padded.
-With the \fB\-H\fP flag,
-field headers are added to the top of the output,
-but the format is otherwise unchanged.
-With the \fB\-F\fP flag,
-the output is formatted in a tabular form similar to that used by \fIsqlplus\fP,
-except that all fields are left\-justified, regardless of their data type.
-Column headers are printed at the top of each page;
-a page is assumed to be 60 lines long,
-but this may be overridden with the \fB\-l\fP\fIpage_len\fP flag.
-
-Without the \fB\-F\fP flag, fields are separated with tabs;
-this may be changed to any desired string (\fIdelim\fP)
-using the \fB\-d\fP flag.
-.SH ENVIRONMENT
-The environment variable \fBTWO_TASK\fP or \fBORACLE_SID\fP
-determines the Oracle database to be used
-if the \fB\-b\fP\fIbase\fP flag is not supplied.
-.SH DIAGNOSTICS
-.in +5
-.ti -5
-\fBonly one of \-F and \-H may be specified\fP
-.br
-the \fB\-F\fP and \fB\-H\fP options are mutually exclusive,
-but both were specified
-
-.in -5
-The only other diagnostics generated by \fIsql\fP are usage messages,
-which should be self\-explanatory.
-However, you may also encounter
-error messages from DBI (unlikely) or from Oracle (more common).
-See the \fIOracle Error Messages and Codes Manual\fP for details.
-.SH NOTES
-This program is only intended for use from the command line.
-If you use it within a shell script
-then you should consider rewriting your script in DBI
-to use Perl's text manipulation and formatting commands.
-.SH "SEE ALSO"
-\fISQL Language Reference Manual\fP
-.br
-perl(1),
-oraperl(1)
-.SH AUTHOR
-Kevin Stock,
-.if t .ft C
-<kstock@encore.com>
-.if t .ft P
-.ex
@@ -1,68 +0,0 @@
-#!/usr/bin/perl -w
-#
-# tabinfo
-#
-# Usage: tabinfo base user password table
-#
-# Displays the structure of the specified table.
-# Note that the field names are restricted to the length of the field.
-# This is mainly to show the use of &ora_lengths, &ora_titles and &ora_types.
-#
-use DBI;
-
-use strict;
-
-# Set trace level if '-# trace_level' option is given
-DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
-
-# read the compulsory arguments
-die "syntax: $0 base user password table ...\n" if 4 > @ARGV;
-my ( $base, $user, $pass, @table ) = @ARGV;
-
-my ( $table, @name, @length, @type, %type_name, $i );
-format STDOUT_TOP =
-Structure of @<<<<<<<<<<<<<<<<<<<<<<<
-$table
-
-Field name | Length | Type | Type Name
-----------------------------------------------+--------+------+-----------------
-.
-
-format STDOUT =
-@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>>>> | @>>> | @<<<<<<<<<<<<<<<
-$name[$i], $length[$i], $type[$i], $type_name{$type[$i]}
-.
-
-# Connect to database
-my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass,
- { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
- or die $DBI::errstr;
-
-# Associate type names to types
-{
- my $type_info_all = $dbh->type_info_all;
- my $iname = $type_info_all->[0]{TYPE_NAME};
- my $itype = $type_info_all->[0]{DATA_TYPE};
- my $rtype;
- shift @$type_info_all;
- foreach $rtype ( @$type_info_all ) {
- $type_name{$$rtype[$itype]} = $$rtype[$iname]
- if ! exists $type_name{$$rtype[$itype]};
- }
-}
-
-my $sth;
-foreach $table ( @table ) {
- $sth = $dbh->prepare( "SELECT * FROM $table WHERE 1 = 2");
- @name = @{$sth->{NAME}};
- @length = @{$sth->{PRECISION}};
- @type = @{$sth->{TYPE}};
-
- foreach $i ( 0 .. $#name ) {
- write;
- }
- $- = 0;
- $sth->finish;
-}
-
-$dbh->disconnect;
@@ -1,38 +1,73 @@
/*
- $Id: Oracle.h,v 1.18 2003/03/12 20:33:02 timbo Exp $
+ Copyright (c) 1994-2006 Tim Bunce
- Copyright (c) 1994,1995 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,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
+ See the COPYRIGHT section in the Oracle.pm file for terms.
*/
+/* ====== Include Oracle Header Files ====== */
+
+#ifndef CAN_PROTOTYPE
+#define signed /* Oracle headers use signed */
+#endif
+
+/* The following define avoids a problem with Oracle >=7.3 where
+ * ociapr.h has the line:
+ * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ...
+ * In some compilers that clashes with perls 'opcode' enum definition.
+ */
+#define opcode opcode_redefined
+
+/* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */
+#if defined(__osf__) && defined(__alpha)
+#ifndef A_OSF
+#define A_OSF
+#endif
+#endif
+
+/* egcs-1.1.2 does not have _int64 */
+#if defined(__MINGW32__) || defined(__CYGWIN32__)
+#define _int64 long long
+#endif
+
+
+/* ori.h uses 'dirty' as an arg name in prototypes so we use this */
+/* hack to prevent ori.h being read (since we don't need it) */
+/*#define ORI_ORACLE*/
+#include <oci.h>
+#include <oratypes.h>
+#include <ocidfn.h>
+#include <orid.h>
+#include <ori.h>
+
+/* ------ end of Oracle include files ------ */
+
#define NEED_DBIXS_VERSION 93
-#define PERL_POLLUTE
+#define PERL_NO_GET_CONTEXT /*for Threaded Perl */
#include <DBIXS.h> /* installed by the DBI module */
#include "dbdimp.h"
+#include "dbivport.h"
+
#include <dbd_xsh.h> /* installed by the DBI module */
-#ifdef yxyxyxyx
-/* These prototypes are for dbdimp.c funcs used in the XS file */
-/* These names are #defined to driver specific names in dbdimp.h */
+/* These prototypes are for dbdimp.c funcs used in the XS file */
+/* These names are #defined to driver specific names in dbdimp.h */
void dbd_init _((dbistate_t *dbistate));
+void dbd_init_oci_drh _((imp_drh_t * imp_drh));
int dbd_db_login _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd));
int dbd_db_do _((SV *sv, char *statement));
int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh));
int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh));
+int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs);
int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh));
-void dbd_db_destroy _((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));
@@ -44,19 +79,58 @@ int dbd_st_cancel _((SV *sth, imp_sth_t *imp_sth));
AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth));
int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth));
-void dbd_st_destroy _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_blob_read _((SV *sth, imp_sth_t *imp_sth,
+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));
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
int dbd_db_login6 _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd, SV *attr));
-int dbd_describe _((SV *sth, imp_sth_t *imp_sth));
-ub4 ora_blob_read_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv,
- long offset, long len, long destoffset));
-ub4 ora_blob_read_mb_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, long len, long destoffset));
+int dbd_describe _((SV *sth, imp_sth_t *imp_sth));
+ub4 ora_blob_read_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv,
+ long offset, UV len, long destoffset));
+ub4 ora_blob_read_mb_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv,
+ long offset, ub4 len, long destoffset));
+
+/* Oracle types */
+#define ORA_VARCHAR2 1
+#define ORA_STRING 5
+#define ORA_NUMBER 2
+#define ORA_LONG 8
+#define ORA_ROWID 11
+#define ORA_DATE 12
+#define ORA_RAW 23
+#define ORA_LONGRAW 24
+#define ORA_CHAR 96
+#define ORA_CHARZ 97
+#define ORA_MLSLABEL 105
+#define ORA_CLOB 112
+#define ORA_BLOB 113
+#define ORA_BFILE 114
+#define ORA_RSET 116
+#define ORA_VARCHAR2_TABLE 201
+#define ORA_NUMBER_TABLE 202
+#define ORA_XMLTYPE 108
+
+
+
+
+/* other Oracle not in noraml API defines
+
+most of these are largly undocumented XML functions that are in the API but not defined
+not noramlly found in the defines the prototypes of OCI functions in most clients
+Normally can be found in ociap.h (Oracle Call Interface - Ansi Prototypes
+) and ocikp.h (functions in K&R style)
+
+They will be added when needed
+
+*/
+
+sword OCIXMLTypeCreateFromSrc( OCISvcCtx *svchp, OCIError *errhp,
+ OCIDuration dur, ub1 src_type, dvoid *src_ptr,
+ sb4 ind, OCIXMLType **retInstance );
+
/* end of Oracle.h */
@@ -1,1849 +0,0 @@
-
-# Oracle.pm,v 1.1 2002/07/05 06:34:47 richter Exp
-#
-# Copyright (c) 1994,1995,1996,1997,1998,1999 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,
-# with the exception that it cannot be placed on a CD-ROM or similar media
-# for commercial distribution without the prior approval of the author.
-
-require 5.003;
-
-$DBD::Oracle::VERSION = '1.14';
-
-my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
-
-{
- package DBD::Oracle;
-
- use DBI ();
- use DynaLoader ();
- use Exporter ();
- @ISA = qw(DynaLoader Exporter);
- %EXPORT_TAGS = (
- ora_types => [ qw(
- ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
- ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_NTY
- ORA_CLOB ORA_BLOB ORA_RSET
- ) ],
- ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ) ],
- );
- @EXPORT_OK = ('ORA_OCI');
- Exporter::export_ok_tags(qw(ora_types ora_session_modes));
-
- my $Revision = substr(q$Revision: 1.96 $, 10);
-
- require_version DBI 1.20;
-
- bootstrap DBD::Oracle $VERSION;
-
- $drh = undef; # holds driver handle once initialised
-
- sub CLONE {
- $drh = undef ;
- }
-
- sub driver{
- return $drh if $drh;
- my($class, $attr) = @_;
- my $oci = DBD::Oracle::ORA_OCI();
-
- $class .= "::dr";
-
- # not a 'my' since we use it above to prevent multiple drivers
-
- $drh = DBI::_new_drh($class, {
- 'Name' => 'Oracle',
- 'Version' => $VERSION,
- 'Err' => \my $err,
- 'Errstr' => \my $errstr,
- 'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce",
- });
- DBD::Oracle::dr::init_oci($drh) ;
- $drh->STORE('ShowErrorStatement', 1);
-
- $drh;
- }
-
-
- END {
- # Used to silence 'Bad free() ...' warnings caused by bugs in Oracle's code
- # being detected by Perl's malloc.
- $ENV{PERL_BADFREE} = 0;
- undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry;
- }
-
- sub AUTOLOAD {
- (my $constname = $AUTOLOAD) =~ s/.*:://;
- my $val = constant($constname);
- *$AUTOLOAD = sub { $val };
- goto &$AUTOLOAD;
- }
-
-}
-
-
-{ package DBD::Oracle::dr; # ====== DRIVER ======
- use strict;
-
- my %dbnames = (); # holds list of known databases (oratab + tnsnames)
-
- sub load_dbnames {
- my ($drh) = @_;
- my $debug = $drh->debug;
- my $oracle_home = $ENV{$ORACLE_ENV} || '';
- local *FH;
- my $d;
-
- if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) {
- # XXX experimental, will probably change
- $drh->trace_msg("Trying to fetch ORACLE_HOME and ORACLE_SID from the registry.\n")
- if $debug;
- my($hkey, $sid, $home);
- eval q{
- require Win32::TieRegistry;
- $Win32::TieRegistry::Registry->Delimiter("/");
- $hkey= $Win32::TieRegistry::Registry->{"LMachine/Software/Oracle/"};
- };
- eval q{
- require Tie::Registry;
- $Tie::Registry::Registry->Delimiter("/");
- $hkey= $Tie::Registry::Registry->{"LMachine/Software/Oracle/"};
- } unless $hkey;
- if ($hkey) {
- $sid = $hkey->{ORACLE_SID};
- $home= $hkey->{ORACLE_HOME};
- } else {
- eval q{
- my $reg_key;
- require Win32::Registry;
- $main::HKEY_LOCAL_MACHINE->Open('SOFTWARE\ORACLE', $reg_key);
- $reg_key->GetValues( $hkey );
- $sid = $hkey->{ORACLE_SID}[2];
- $home= $hkey->{ORACLE_HOME}[2];
- };
- };
- $home= $ENV{$ORACLE_ENV} unless $home;
- $dbnames{$sid} = $home if $sid and $home;
- $drh->trace_msg("Found $sid \@ $home.\n") if $debug;
- $oracle_home =$home unless $oracle_home;
- };
-
- # get list of 'local' database SIDs from oratab
- foreach $d (qw(/etc /var/opt/oracle), $ENV{TNS_ADMIN}) {
- next unless defined $d;
- next unless open(FH, "<$d/oratab");
- $drh->trace_msg("Loading $d/oratab\n") if $debug;
- my $ot;
- while (defined($ot = <FH>)) {
- next unless $ot =~ m/^\s*(\w+)\s*:\s*(.*?)\s*:/;
- $dbnames{$1} = $2; # store ORACLE_HOME value
- $drh->trace_msg("Found $1 \@ $2.\n") if $debug;
- }
- close FH;
- last;
- }
-
- # get list of 'remote' database connection identifiers
- foreach $d ( $ENV{TNS_ADMIN},
- ".", # current directory
- "$oracle_home/network/admin", # OCI 7 and 8.1
- "$oracle_home/net80/admin", # OCI 8.0
- "/var/opt/oracle"
- ) {
- next unless $d && open(FH, "<$d/tnsnames.ora");
- $drh->trace_msg("Loading $d/tnsnames.ora\n") if $debug;
- while (<FH>) {
- next unless m/^\s*([-\w\.]+)\s*=/;
- my $name = $1;
- $drh->trace_msg("Found $name. ".($dbnames{$name} ? "(oratab entry overridden)" : "")."\n")
- if $debug;
- $dbnames{$name} = 0; # exists but false (to distinguish from oratab)
- }
- close FH;
- last;
- }
-
- $dbnames{0} = 1; # mark as loaded (even if empty)
- }
-
- sub data_sources {
- my $drh = shift;
- load_dbnames($drh) unless %dbnames;
- my @names = sort keys %dbnames;
- my @sources = map { $_ ? ("dbi:Oracle:$_") : () } @names;
- return @sources;
- }
-
-
- sub connect {
- my ($drh, $dbname, $user, $auth, $attr)= @_;
-
- if ($dbname =~ /;/) {
- my ($n,$v);
- $dbname =~ s/^\s+//;
- $dbname =~ s/\s+$//;
- my @dbname = map {
- ($n,$v) = split /\s*=\s*/, $_; (uc($n), $v)
- } split /\s*;\s*/, $dbname;
- my %dbname = ( PROTOCOL => 'tcp', @dbname );
- my $sid = delete $dbname{SID};
- return $drh->DBI::set_err(-1,
- "Can't connect using this syntax without specifying a HOST and a SID")
- unless $sid and $dbname{HOST};
- my @addrs;
- push @addrs, "$n=$v" while ( ($n,$v) = each %dbname );
- my $addrs = "(" . join(")(", @addrs) . ")";
- if ($dbname{PORT}) {
- $addrs = "(ADDRESS=$addrs)";
- }
- else {
- $addrs = "(ADDRESS_LIST=(ADDRESS=$addrs(PORT=1526))" # Oracle8
- . "(ADDRESS=$addrs(PORT=1521)))"; # Oracle7
- }
- $dbname = "(DESCRIPTION=$addrs(CONNECT_DATA=(SID=$sid)))";
- $drh->trace_msg("connect using '$dbname'");
- }
-
- # If the application is asking for specific database
- # then we may have to mung the dbname
-
- if (DBD::Oracle::ORA_OCI() >= 8) {
- $dbname = $1 if !$dbname && $user && $user =~ s/\@(.*)//s;
- }
- elsif ($dbname) { # OCI 7 handling below
-
- # We can use the 'user/passwd@machine' form of user.
- # $TWO_TASK and $ORACLE_SID will be ignored in that case.
- if ($dbname =~ /^@/){ # Implies an Sql*NET connection
- $user = "$user/$auth$dbname";
- $auth = "";
- }
- elsif ($dbname =~ /^\w?:/){ # Implies an Sql*NET connection
- $user = "$user/$auth".'@'.$dbname;
- $auth = "";
- }
- else {
- # Is this a NON-Sql*NET connection (ORACLE_SID)?
- # Or is it an alias for an Sql*NET connection (TWO_TASK)?
- # Sadly the 'user/passwd@machine' form only works
- # for Sql*NET connections.
- load_dbnames($drh) unless %dbnames;
- if (exists $dbnames{$dbname}) { # known name
- my $dbhome = $dbnames{$dbname}; # local=>ORACLE_HOME, remote=>0
- if ($dbhome) {
- $ENV{ORACLE_SID} = $dbname;
- delete $ENV{TWO_TASK};
- if ($attr && $attr->{ora_oratab_orahome}) {
- $drh->trace_msg("Changing $ORACLE_ENV for $dbname to $dbhome (to match oratab entry)")
- if ($ENV{$ORACLE_ENV} and $dbhome ne $ENV{$ORACLE_ENV});
- $ENV{$ORACLE_ENV} = $dbhome;
- }
- }
- else {
- $user .= '@'.$dbname; # it's a known TNS alias
- }
- }
- else {
- $user .= '@'.$dbname; # assume it's a TNS alias
- }
- }
- }
-
- warn "$ORACLE_ENV environment variable not set!\n"
- if !$ENV{$ORACLE_ENV} and $^O ne "MSWin32";
-
- # create a 'blank' dbh
-
- (my $user_only = $user) =~ s:/.*::;
- my $dbh = DBI::_new_dbh($drh, {
- 'Name' => $dbname,
- 'USER' => uc $user_only, 'CURRENT_USER' => uc $user_only,
- });
-
- # Call Oracle OCI logon func in Oracle.xs file
- # and populate internal handle data.
- DBD::Oracle::db::_login($dbh, $dbname, $user, $auth, $attr)
- or return undef;
-
- if ($attr && $attr->{ora_module_name}) {
- eval {
- $dbh->do(q{BEGIN DBMS_APPLICATION_INFO.SET_MODULE(:1,NULL); END;},
- undef, $attr->{ora_module_name});
- };
- }
-
- $dbh;
- }
-
-}
-
-
-{ package DBD::Oracle::db; # ====== DATABASE ======
- use strict;
-
- sub prepare {
- my($dbh, $statement, @attribs)= @_;
-
- # create a 'blank' sth
-
- my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- });
-
- # Call Oracle OCI parse func in Oracle.xs file.
- # and populate internal handle data.
-
- DBD::Oracle::st::_prepare($sth, $statement, @attribs)
- or return undef;
-
- $sth;
- }
-
-
- sub ping {
- my($dbh) = @_;
- my $ok = 0;
- eval {
- local $SIG{__DIE__};
- local $SIG{__WARN__};
- # we know that Oracle 7 prepare does a describe so this will
- # actually talk to the server and is this a valid and cheap test.
- my $sth = $dbh->prepare("select SYSDATE from DUAL /* ping */");
- # But Oracle 8 doesn't talk to server unless we describe the query
- $ok = $sth && $sth->FETCH('NUM_OF_FIELDS');
- };
- return ($@) ? 0 : $ok;
- }
-
-
- sub get_info {
- my($dbh, $info_type) = @_;
- require DBD::Oracle::GetInfo;
- my $v = $DBD::Oracle::GetInfo::info{int($info_type)};
- $v = $v->($dbh) if ref $v eq 'CODE';
- return $v;
- }
-
-
- sub table_info {
- my($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
- # XXX add knowledge of temp tables, etc
- # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
- if (ref $CatVal eq 'HASH') {
- ($CatVal, $SchVal, $TblVal, $TypVal) =
- @$CatVal{'TABLE_CAT','TABLE_SCHEM','TABLE_NAME','TABLE_TYPE'};
- }
- 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
- FROM DUAL
-SQL
- }
- elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , s TABLE_SCHEM
- , NULL TABLE_NAME
- , NULL TABLE_TYPE
- , NULL REMARKS
- FROM
-(
- SELECT USERNAME s FROM ALL_USERS
- UNION
- SELECT 'PUBLIC' s FROM DUAL
-)
- ORDER BY TABLE_SCHEM
-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 FROM DUAL
- UNION
- SELECT 'VIEW' tt FROM DUAL
- UNION
- SELECT 'SYNONYM' tt FROM DUAL
- UNION
- SELECT 'SEQUENCE' tt FROM DUAL
-) t
- ORDER BY TABLE_TYPE
-SQL
- }
- else {
- $Sql = <<'SQL';
-SELECT *
- FROM
-(
- SELECT NULL TABLE_CAT
- , t.OWNER TABLE_SCHEM
- , t.TABLE_NAME TABLE_NAME
- , decode(t.OWNER
- , 'SYS' , 'SYSTEM '
- , 'SYSTEM' , 'SYSTEM '
- , '' ) || t.TABLE_TYPE TABLE_TYPE
- , c.COMMENTS REMARKS
- FROM ALL_TAB_COMMENTS c
- , ALL_CATALOG t
- WHERE c.OWNER (+) = t.OWNER
- AND c.TABLE_NAME (+) = t.TABLE_NAME
- AND c.TABLE_TYPE (+) = t.TABLE_TYPE
-)
-SQL
- if ( defined $SchVal ) {
- push @Where, "TABLE_SCHEM LIKE '$SchVal' ESCAPE '\\'";
- }
- if ( defined $TblVal ) {
- push @Where, "TABLE_NAME LIKE '$TblVal' ESCAPE '\\'";
- }
- 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 ($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) = @_;
- if (ref $catalog eq 'HASH') {
- ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'};
- $catalog = undef;
- }
- my $Sql = <<'SQL';
-SELECT *
- FROM
-(
- SELECT NULL TABLE_CAT
- , c.OWNER TABLE_SCHEM
- , c.TABLE_NAME TABLE_NAME
- , c.COLUMN_NAME COLUMN_NAME
- , c.POSITION KEY_SEQ
- , c.CONSTRAINT_NAME PK_NAME
- FROM ALL_CONSTRAINTS p
- , ALL_CONS_COLUMNS c
- WHERE p.OWNER = c.OWNER
- AND p.TABLE_NAME = c.TABLE_NAME
- AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME
- AND p.CONSTRAINT_TYPE = 'P'
-)
- WHERE TABLE_SCHEM = ?
- AND TABLE_NAME = ?
- ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ
-SQL
-#warn "@_\n$Sql ($schema, $table)";
- my $sth = $dbh->prepare($Sql) or return undef;
- $sth->execute($schema, $table) or return undef;
- $sth;
-}
-
- sub foreign_key_info {
- my $dbh = shift;
- my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
- 'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2]
- ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] };
- my $Sql = <<'SQL'; # XXX: DEFERABILITY
-SELECT *
- FROM
-(
- SELECT to_char( NULL ) UK_TABLE_CAT
- , uk.OWNER UK_TABLE_SCHEM
- , uk.TABLE_NAME UK_TABLE_NAME
- , uc.COLUMN_NAME UK_COLUMN_NAME
- , to_char( NULL ) FK_TABLE_CAT
- , fk.OWNER FK_TABLE_SCHEM
- , fk.TABLE_NAME FK_TABLE_NAME
- , fc.COLUMN_NAME FK_COLUMN_NAME
- , uc.POSITION ORDINAL_POSITION
- , 3 UPDATE_RULE
- , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 )
- DELETE_RULE
- , fk.CONSTRAINT_NAME FK_NAME
- , uk.CONSTRAINT_NAME UK_NAME
- , to_char( NULL ) DEFERABILITY
- , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE')
- UNIQUE_OR_PRIMARY
- FROM ALL_CONSTRAINTS uk
- , ALL_CONS_COLUMNS uc
- , ALL_CONSTRAINTS fk
- , ALL_CONS_COLUMNS fc
- WHERE uk.OWNER = uc.OWNER
- AND uk.CONSTRAINT_NAME = uc.CONSTRAINT_NAME
- AND fk.OWNER = fc.OWNER
- AND fk.CONSTRAINT_NAME = fc.CONSTRAINT_NAME
- AND uk.CONSTRAINT_TYPE IN ('P','U')
- AND fk.CONSTRAINT_TYPE = 'R'
- AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME
- AND uk.OWNER = fk.R_OWNER
- AND uc.POSITION = fc.POSITION
-)
- WHERE 1 = 1
-SQL
- my @BindVals = ();
- while ( my ( $k, $v ) = each %$attr ) {
- if ( $v ) {
- $Sql .= " AND $k = ?\n";
- push @BindVals, $v;
- }
- }
- $Sql .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n";
- my $sth = $dbh->prepare( $Sql ) or return undef;
- $sth->execute( @BindVals ) or return undef;
- $sth;
- }
-
-
- sub column_info {
- my $dbh = shift;
- my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
- 'TABLE_SCHEM' => $_[1],'TABLE_NAME' => $_[2],'COLUMN_NAME' => $_[3] };
- my $Sql = <<'SQL';
-SELECT *
- FROM
-(
- SELECT to_char( NULL ) TABLE_CAT
- , tc.OWNER TABLE_SCHEM
- , tc.TABLE_NAME TABLE_NAME
- , tc.COLUMN_NAME COLUMN_NAME
- , decode( tc.DATA_TYPE
- , 'MLSLABEL' , -9106
- , 'ROWID' , -9104
- , 'UROWID' , -9104
- , 'BFILE' , -4 -- 31?
- , 'LONG RAW' , -4
- , 'RAW' , -3
- , 'LONG' , -1
- , 'UNDEFINED', 0
- , 'CHAR' , 1
- , 'NCHAR' , 1
- , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
- , 'FLOAT' , 8
- , 'VARCHAR2' , 12
- , 'NVARCHAR2', 12
- , 'BLOB' , 30
- , 'CLOB' , 40
- , 'NCLOB' , 40
- , 'DATE' , 93
- , NULL
- ) DATA_TYPE -- ...
- , tc.DATA_TYPE TYPE_NAME -- std.?
- , decode( tc.DATA_TYPE
- , 'LONG RAW' , 2147483647
- , 'LONG' , 2147483647
- , 'CLOB' , 2147483647
- , 'NCLOB' , 2147483647
- , 'BLOB' , 2147483647
- , 'BFILE' , 2147483647
- , 'NUMBER' , decode( tc.DATA_SCALE
- , NULL, 126
- , nvl( tc.DATA_PRECISION, 38 )
- )
- , 'FLOAT' , tc.DATA_PRECISION
- , 'DATE' , 19
- , tc.DATA_LENGTH
- ) COLUMN_SIZE
- , decode( tc.DATA_TYPE
- , 'LONG RAW' , 2147483647
- , 'LONG' , 2147483647
- , 'CLOB' , 2147483647
- , 'NCLOB' , 2147483647
- , 'BLOB' , 2147483647
- , 'BFILE' , 2147483647
- , 'NUMBER' , nvl( tc.DATA_PRECISION, 38 ) + 2
- , 'FLOAT' , 8 -- ?
- , 'DATE' , 16
- , tc.DATA_LENGTH
- ) BUFFER_LENGTH
- , decode( tc.DATA_TYPE
- , 'DATE' , 0
- , tc.DATA_SCALE
- ) DECIMAL_DIGITS -- ...
- , decode( tc.DATA_TYPE
- , 'FLOAT' , 2
- , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 2, 10 )
- , NULL
- ) NUM_PREC_RADIX
- , decode( tc.NULLABLE
- , 'Y' , 1
- , 'N' , 0
- , NULL
- ) NULLABLE
- , cc.COMMENTS REMARKS
- , tc.DATA_DEFAULT COLUMN_DEF -- Column is LONG!
- , decode( tc.DATA_TYPE
- , 'MLSLABEL' , -9106
- , 'ROWID' , -9104
- , 'UROWID' , -9104
- , 'BFILE' , -4 -- 31?
- , 'LONG RAW' , -4
- , 'RAW' , -3
- , 'LONG' , -1
- , 'UNDEFINED', 0
- , 'CHAR' , 1
- , 'NCHAR' , 1
- , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
- , 'FLOAT' , 8
- , 'VARCHAR2' , 12
- , 'NVARCHAR2', 12
- , 'BLOB' , 30
- , 'CLOB' , 40
- , 'NCLOB' , 40
- , 'DATE' , 9 -- not 93!
- , NULL
- ) SQL_DATA_TYPE -- ...
- , decode( tc.DATA_TYPE
- , 'DATE' , 3
- , NULL
- ) SQL_DATETIME_SUB -- ...
- , to_number( NULL ) CHAR_OCTET_LENGTH -- TODO
- , tc.COLUMN_ID ORDINAL_POSITION
- , decode( tc.NULLABLE
- , 'Y' , 'YES'
- , 'N' , 'NO'
- , NULL
- ) IS_NULLABLE
- FROM ALL_TAB_COLUMNS tc
- , ALL_COL_COMMENTS cc
- WHERE tc.OWNER = cc.OWNER
- AND tc.TABLE_NAME = cc.TABLE_NAME
- AND tc.COLUMN_NAME = cc.COLUMN_NAME
-)
- WHERE 1 = 1
-SQL
- my @BindVals = ();
- while ( my ( $k, $v ) = each %$attr ) {
- if ( $v ) {
- $Sql .= " AND $k LIKE ? ESCAPE '\\'\n";
- push @BindVals, $v;
- }
- }
- $Sql .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n";
- my $sth = $dbh->prepare( $Sql ) or return undef;
- $sth->execute( @BindVals ) or return undef;
- $sth;
- }
-
- sub type_info_all {
- my ($dbh) = @_;
- 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,
- [ 'LONG RAW', -4, '2147483647', '\'', '\'', undef, 1, '0', '0',
- undef, '0', undef, undef, undef, undef, -4, undef, undef
- ],
- [ 'RAW', -3, 2000, '\'', '\'', 'max length', 1, '0', 3,
- undef, '0', undef, undef, undef, undef, -3, undef, undef
- ],
- [ 'LONG', -1, '2147483647', '\'', '\'', undef, 1, 1, '0',
- undef, '0', undef, undef, undef, undef, -1, undef, undef
- ],
- [ 'CHAR', 1, 2000, '\'', '\'', '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
- ]
- ];
- my $version = ( ora_server_version($dbh)->[0] < DBD::Oracle::ORA_OCI() )
- ? ora_server_version($dbh)->[0] : DBD::Oracle::ORA_OCI();
- if ( $version < 8 ) {
- push @$ti,
- [ 'VARCHAR2', 12, 2000, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 12, undef, undef
- ];
- }
- else {
- push @$ti,
- [ 'VARCHAR2', 12, 4000, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 12, undef, undef
- ],
- [ 'BLOB', 30, 2147483647, '\'', '\'', undef, 1, 1, 0,
- undef, 0, undef, undef, undef, undef, 30, undef, undef
- ],
- [ 'CLOB', 40, 2147483647, '\'', '\'', undef, 1, 1, 0,
- undef, 0, undef, undef, undef, undef, 40, undef, undef
- ];
-# whole bunch more need adding...
-# [ 'TIMESTAMP WITH TIME ZONE', 11, 34, '\'', '\'', undef, 1, '0', 3,
-# undef, '0', '0', undef, '0', '9', 11, undef, undef
-# ],
-
- }
- push @$ti,
- [ 'DATE', 93, 19, '\'', '\'', undef, 1, 0, 3,
- undef, 0, 0, undef, 0, 0, 9, 3, undef
- ];
- return $ti;
- }
-
- sub plsql_errstr {
- # original version thanks to Bob Menteer
- my $sth = shift->prepare_cached(q{
- SELECT name, type, line, position, text
- FROM user_errors ORDER BY name, type, sequence
- }) or return undef;
- $sth->execute or return undef;
- my ( @msg, $oname, $otype, $name, $type, $line, $pos, $text );
- $oname = $otype = 0;
- while ( ( $name, $type, $line, $pos, $text ) = $sth->fetchrow_array ) {
- if ( $oname ne $name || $otype ne $type ) {
- push @msg, "Errors for $type $name:";
- $oname = $name;
- $otype = $type;
- }
- push @msg, "$line.$pos: $text";
- }
- return join( "\n", @msg );
- }
-
- #
- # note, dbms_output must be enabled prior to usage
- #
- sub dbms_output_enable {
- my ($dbh, $buffersize) = @_;
- $buffersize ||= 20000; # use oracle 7.x default
- $dbh->do("begin dbms_output.enable(:1); end;", undef, $buffersize);
- }
-
- sub dbms_output_get {
- my $dbh = shift;
- my $sth = $dbh->prepare_cached("begin dbms_output.get_line(:l, :s); end;")
- or return;
- my ($line, $status, @lines);
- # line can be greater that 255 (e.g. 7 byte date is expanded on output)
- $sth->bind_param_inout(':l', \$line, 400, { ora_type => 1 });
- $sth->bind_param_inout(':s', \$status, 20, { ora_type => 1 });
- if (!wantarray) {
- $sth->execute or return undef;
- return $line if $status eq '0';
- return undef;
- }
- push @lines, $line while($sth->execute && $status eq '0');
- return @lines;
- }
-
- sub dbms_output_put {
- my $dbh = shift;
- my $sth = $dbh->prepare_cached("begin dbms_output.put_line(:1); end;")
- or return;
- my $line;
- foreach $line (@_) {
- $sth->execute($line) or return;
- }
- return 1;
- }
-
-
- sub dbms_msgpipe_get {
- my $dbh = shift;
- my $sth = $dbh->prepare_cached(q{
- begin dbms_msgpipe.get_request(:returnpipe, :proc, :param); end;
- }) or return;
- my $msg = ['','',''];
- $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
- $sth->bind_param_inout(":proc", \$msg->[1], 30);
- $sth->bind_param_inout(":param", \$msg->[2], 4000);
- $sth->execute or return undef;
- return $msg;
- }
-
- sub dbms_msgpipe_ack {
- my $dbh = shift;
- my $msg = shift;
- my $sth = $dbh->prepare_cached(q{
- begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;
- }) or return;
- $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
- $sth->bind_param_inout(":proc", \$msg->[1], 30);
- $sth->bind_param_inout(":param", \$msg->[2], 4000);
- $sth->execute or return undef;
- return 1;
- }
-
- sub ora_server_version {
- my $dbh = shift;
- return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
- $dbh->{ora_server_version} =
- [ split /\./, $dbh->selectrow_array(<<'SQL', undef, 'Oracle%') .''];
-SELECT version
- FROM product_component_version
- WHERE product LIKE ?
-SQL
- }
-
-} # end of package DBD::Oracle::db
-
-
-{ package DBD::Oracle::st; # ====== STATEMENT ======
-
- # all done in XS
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Oracle - Oracle database driver for the DBI module
-
-=head1 SYNOPSIS
-
- use DBI;
-
- $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd);
-
- $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd);
-
- # See the DBI module documentation for full details
-
- # for some advanced uses you may need Oracle type values:
- use DBD::Oracle qw(:ora_types);
-
-
-=head1 DESCRIPTION
-
-DBD::Oracle is a Perl module which works with the DBI module to provide
-access to Oracle databases (both version 7 and 8).
-
-=head1 CONNECTING TO ORACLE
-
-This is a topic which often causes problems. Mainly due to Oracle's many
-and sometimes complex ways of specifying and connecting to databases.
-(James Taylor and Lane Sharman have contributed much of the text in
-this section.)
-
-=head2 Connecting without environment variables or tnsname.ora file
-
-If you use the C<host=$host;sid=$sid> style syntax, for example:
-
- $dbh = DBI->connect("dbi:Oracle:host=myhost.com;sid=ORCL", $user, $passwd);
-
-then DBD::Oracle will construct a full connection descriptor string
-for you and Oracle will not need to consult the tnsname.ora file.
-
-If a C<port> number is not specified then the descriptor will try both
-1526 and 1521 in that order (e.g., new then old). You can check which
-port(s) are in use by typing "$ORACLE_HOME/bin/lsnrctl stat" on the server.
-
-
-=head2 Oracle environment variables
-
-Oracle typically uses two environment variables to specify default
-connections: ORACLE_SID and TWO_TASK.
-
-ORACLE_SID is really unnecessary to set since TWO_TASK provides the
-same functionality in addition to allowing remote connections.
-
- % setenv TWO_TASK T:hostname:ORACLE_SID # for csh shell
- $ TWO_TASK=T:hostname:ORACLE_SID export TWO_TASK # for sh shell
-
- % sqlplus username/password
-
-Note that if you have *both* local and remote databases, and you
-have ORACLE_SID *and* TWO_TASK set, and you don't specify a fully
-qualified connect string on the command line, TWO_TASK takes precedence
-over ORACLE_SID (i.e. you get connected to remote system).
-
- TWO_TASK=P:sid
-
-will use the pipe driver for local connections using SQL*Net v1.
-
- TWO_TASK=T:machine:sid
-
-will use TCP/IP (or D for DECNET, etc.) for remote SQL*Net v1 connection.
-
- TWO_TASK=dbname
-
-will use the info stored in the SQL*Net v2 F<tnsnames.ora>
-configuration file for local or remote connections.
-
-The ORACLE_HOME environment variable should be set correctly.
-In general, the value used should match the version of Oracle that
-was used to build DBD::Oracle. If using dynamic linking then
-ORACLE_HOME should match the version of Oracle that will be used
-to load in the Oracle client libraries (via LD_LIBRARY_PATH, ldconfig,
-or similar on Unix).
-
-ORACLE_HOME can be left unset if you aren't using any of Oracle's
-executables, but it is not recommended and error messages may not display.
-
-Discouraging the use of ORACLE_SID makes it easier on the users to see
-what is going on. (It's unfortunate that TWO_TASK couldn't be renamed,
-since it makes no sense to the end user, and doesn't have the ORACLE
-prefix).
-
-=head2 Connection Examples Using DBD::Oracle
-
-Below are various ways of connecting to an oracle database using
-SQL*Net 1.x and SQL*Net 2.x. "Machine" is the computer the database is
-running on, "SID" is the SID of the database, "DB" is the SQL*Net 2.x
-connection descriptor for the database.
-
-B<Note:> Some of these formats may not work with Oracle 8.
-
- BEGIN {
- $ENV{ORACLE_HOME} = '/home/oracle/product/7.x.x';
- $ENV{TWO_TASK} = 'DB';
- }
- $dbh = DBI->connect('dbi:Oracle:','scott', 'tiger');
- # - or -
- $dbh = DBI->connect('dbi:Oracle:','scott/tiger');
-
-works for SQL*Net 2.x, so does
-
- $ENV{TWO_TASK} = 'T:Machine:SID';
-
-for SQL*Net 1.x connections. For local connections you can use the
-pipe driver:
-
- $ENV{TWO_TASK} = 'P:SID';
-
-Here are some variations (not setting TWO_TASK)
-
- $dbh = DBI->connect('dbi:Oracle:T:Machine:SID','username','password')
-
- $dbh = DBI->connect('dbi:Oracle:','username@T:Machine:SID','password')
-
- $dbh = DBI->connect('dbi:Oracle:','username@DB','password')
-
- $dbh = DBI->connect('dbi:Oracle:DB','username','password')
-
- $dbh = DBI->connect('dbi:Oracle:DB','username/password','')
-
- $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521', 'scott/tiger', '')
-
- $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION=
- (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521))
- (CONNECT_DATA=(SID=ORCL)))}, "")
-
-If you are having problems with login taking a long time (>10 secs say)
-then you might have tripped up on an Oracle bug. You can try using one
-of the ...@DB variants as a workaround. E.g.,
-
- $dbh = DBI->connect('','username/password@DB','');
-
-On the other hand, that may cause you to trip up on another Oracle bug
-that causes alternating connection attempts to fail! (In reality only
-a small proportion of people experience these problems.)
-
-
-=head2 Optimizing Oracle's listner
-
-[By Lane Sharman <lane@bienlogic.com>] I spent a LOT of time optimizing
-listener.ora and I am including it here for anyone to benefit from. My
-connections over tnslistener on the same humble Netra 1 take an average
-of 10-20 milli seconds according to tnsping. If anyone knows how to
-make it better, please let me know!
-
- LISTENER =
- (ADDRESS_LIST =
- (ADDRESS =
- (PROTOCOL = TCP)
- (Host = aa.bbb.cc.d)
- (Port = 1521)
- (QUEUESIZE=10)
- )
- )
-
- STARTUP_WAIT_TIME_LISTENER = 0
- CONNECT_TIMEOUT_LISTENER = 10
- TRACE_LEVEL_LISTENER = OFF
- SID_LIST_LISTENER =
- (SID_LIST =
- (SID_DESC =
- (SID_NAME = xxxx)
- (ORACLE_HOME = /xxx/local/oracle7-3)
- (PRESPAWN_MAX = 40)
- (PRESPAWN_LIST=
- (PRESPAWN_DESC=(PROTOCOL=tcp) (POOL_SIZE=40) (TIMEOUT=120))
- )
- )
- )
-
-1) When the application is co-located on the host AND there is no need for
-outside SQLNet connectivity, stop the listener. You do not need it. Get
-your application/cgi/whatever working using pipes and shared memory. I am
-convinced that this is one of the connection bugs (sockets over the same
-machine). Note the $ENV{ORAPIPES} env var. The essential code to do
-this at the end of this section.
-
-2) Be careful in how you implement the multi-threaded server. Currently I
-am not using it in the initxxxx.ora file but will be doing some more testing.
-
-3) Be sure to create user rollback segments and use them; do not use the
-system rollback segments; however, you must also create a small rollback
-space for the system as well.
-
-5) Use large tuning settings and get lots of RAM. Check out all the
-parameters you can set in v$parameters because there are quite a few not
-documented you may to set in your initxxx.ora file.
-
-6) Use svrmgrl to control oracle from the command line. Write lots of small
-SQL scripts to get at V$ info.
-
- use DBI;
- # Environmental variables used by Oracle
- $ENV{ORACLE_SID} = "xxx";
- $ENV{ORACLE_HOME} = "/opt/oracle7";
- $ENV{EPC_DISABLED} = "TRUE";
- $ENV{ORAPIPES} = "V2";
- my $dbname = "xxx";
- my $dbuser = "xxx";
- my $dbpass = "xxx";
- my $dbh = DBI->connect("dbi:Oracle:$dbname", $dbuser, $dbpass)
- || die "Unale to connect to $dbname: $DBI::errstr\n";
-
-=head2 Oracle utilities
-
-If you are still having problems connecting then the Oracle adapters
-utility may offer some help. Run these two commands:
-
- $ORACLE_HOME/bin/adapters
- $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/sqlplus
-
-and check the output. The "Protocol Adapters" section should be the
-same. It should include at least "IPC Protocol Adapter" and "TCP/IP
-Protocol Adapter".
-
-If it generates any errors which look relevant then please talk to yor
-Oracle technical support (and not the dbi-users mailing list). Thanks.
-Thanks to Mark Dedlow for this information.
-
-
-=head2 Connect Attributes
-
-=over 4
-
-=item ora_session_mode
-
-The ora_session_mode attribute can be used to connect with SYSDBA
-authorization and SYSOPER authorization.
-The ORA_SYSDBA and ORA_SYSOPER constants can be imported using
-
- use DBD::Oracle qw(:ora_session_modes);
-
-Example:
-
- $dbh = DBI->connect($dsn, $usr, $pwd, { ora_session_mode => ORA_SYSDBA });
-
-=item ora_oratab_orahome
-
-Passing a true value for the ora_oratab_orahome attribute will make
-DBD::Oracle change $ENV{ORACLE_HOME} to make the Oracle home directory
-specified in the C</etc/oratab> file I<if> the database to connect to
-is specified as a SID that exists in the oratab file, and DBD::Oracle was
-built to use the Oracle 7 OCI API (not Oracle 8).
-
-=item ora_module_name
-
-After connecting to the database the value of this attribute is passed
-to the SET_MODULE() function in the C<DBMS_APPLICATION_INFO> PL/SQL
-package. This can be used to identify the application to the DBA for
-monitoring and performance tuning purposes. For example:
-
- DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 });
-
-=item ora_dbh_share
-
-Needs at least Perl 5.8.0 compiled with ithreads. Allows to share database
-connections between threads. The first connect will make the connection,
-all following calls to connect with the same ora_dbh_share attribute
-will use the same database connection. The value must be a reference
-to a already shared scalar which is initialized to an empty string.
-
- our $orashr : shared = '' ;
-
- $dbh = DBI -> connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ;
-
-=back
-
-=head2 Database Handle Attributes
-
-=over 4
-
-=item C<ora_ph_type>
-
-The default placeholder data type for the database session.
-The C<TYPE> or L</ora_type> attributes to L<DBI/bind_param> and
-L<DBI/bind_param_inout> override the data type for individual placeholders.
-The most frequent reason for using this attribute is to permit trailing spaces
-in values passed by placeholders.
-
-Constants for the values allowed for this attribute can be imported using
-
- use DBD::Oracle qw(:ora_types);
-
-Only the following values are permitted for this attribute.
-
-=over 4
-
-=item ORA_VARCHAR2
-
-Strip trailing spaces and allow embedded \0 bytes.
-This is the normal default placeholder type.
-
-=item ORA_STRING
-
-Don't strip trailing spaces and end the string at the first \0.
-
-=item ORA_CHAR
-
-Don't strip trailing spaces and allow embedded \0.
-Force 'blank-padded comparison semantics'.
-
-=back
-
-=back
-
-=head2 Prepare Attributes
-
-These attributes may be used in the C<\%attr> parameter of the
-L<DBI/prepare> database handle method.
-
-=over 4
-
-=item ora_parse_lang
-
-Tells the connected database how to interpret the SQL statement.
-If 1 (default), the native SQL version for the database is used.
-Other recognized values are 0 (old V6, treated as V7 in OCI8),
-2 (old V7), 7 (V7), and 8 (V8).
-All other values have the same effect as 1.
-
-=item ora_auto_lob
-
-If 1 (default), fetching retreives the contents of the CLOB or BLOB column.
-If 0, fetching retreives the LOB Locator of the CLOB or BLOB column.
-(OCI8 and later only)
-
-See the LOB tests in 05dbi.t of Oracle::OCI for examples
-of how to use LOB Locators. See L</Handling LOBs> for more details.
-
-=item ora_check_sql
-
-If 1 (default), force SELECT statements to be described in prepare().
-If 0, allow SELECT statements to defer describe until execute().
-(OCI8 and later only)
-
-See L</Prepare postponed till execute> for more information.
-
-=back
-
-=head2 Placeholder Binding Attributes
-
-These attributes may be used in the C<\%attr> parameter of the
-L<DBI/bind_param> or L<DBI/bind_param_inout> statement handle methods.
-
-=over 4
-
-=item ora_type
-
-Specify the placeholder's data type using an Oracle data type.
-A fatal error is raised if C<ora_type> and the DBI C<TYPE> attribute
-are used for the same placeholder.
-Some of these types are not supported by the current version of
-DBD::Oracle and will cause a fatal error if used.
-Constants for the Oracle datatypes may be imported using
-
- use DBD::Oracle qw(:ora_types);
-
-Potentially useful values when DBD::Oracle was built using OCI 7 and later:
-
- ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW,
- ORA_CHAR, ORA_MLSLABEL, ORA_RSET
-
-Additional values when DBD::Oracle was built using OCI 8 and later:
-
- ORA_CLOB, ORA_BLOB, ORA_NTY
-
-See L</Binding Cursors> for the correct way to use ORA_RSET.
-
-See L</Handling LOBs> for the correct way to use ORA_CLOB and ORA_BLOB.
-
-See also L<DBI/Placeholders and Bind Values> for more information.
-
-=back
-
-=head1 Metadata
-
-=head2 C<get_info()>
-
-DBD::Oracle supports C<get_info()>, but (currently) only a few info types.
-
-=head2 C<table_info()>
-
-DBD::Oracle supports attributes for C<table_info()>.
-
-In Oracle, the concept of I<user> and I<schema> is (currently) the
-same. Because database objects are owned by an user, the owner names
-in the data dictionary views correspond to schema names.
-Oracle does not support catalogs so TABLE_CAT is ignored as
-selection criterion.
-
-Search patterns are supported for TABLE_SCHEM and TABLE_NAME.
-
-TABLE_TYPE may contain a comma-separated list of table types.
-The following table types are supported:
-
- TABLE
- VIEW
- SYNONYM
- SEQUENCE
-
-The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME.
-
-The special enumerations of catalogs, schemas and table types are
-supported. However, TABLE_CAT is always NULL.
-
-An identifier is passed I<as is>, i.e. as the user provides or
-Oracle returns it.
-C<table_info()> performs a case-sensitive search. So, a selection
-criterion should respect upper and lower case.
-Normally, an identifier is case-insensitive. Oracle stores and
-returns it in upper case. Sometimes, database objects are created
-with quoted identifiers (for reserved words, mixed case, special
-characters, ...). Such an identifier is case-sensitive (if not all
-upper case). Oracle stores and returns it as given.
-C<table_info()> has no special quote handling, neither adds nor
-removes quotes.
-
-=head2 C<primary_key_info()>
-
-Oracle does not support catalogs so TABLE_CAT is ignored as
-selection criterion.
-The TABLE_CAT field of a fetched row is always NULL (undef).
-See L</table_info()> for more detailed information.
-
-If the primary key constraint was created without an identifier,
-PK_NAME contains a system generated name with the form SYS_Cn.
-
-The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ.
-
-An identifier is passed I<as is>, i.e. as the user provides or
-Oracle returns it.
-See L</table_info()> for more detailed information.
-
-=head2 C<foreign_key_info()>
-
-This method (currently) supports the extended behavior of SQL/CLI, i.e. the
-result set contains foreign keys that refer to primary B<and> alternate keys.
-The field UNIQUE_OR_PRIMARY distinguishes these keys.
-
-Oracle does not support catalogs, so C<$pk_catalog> and C<$fk_catalog> are
-ignored as selection criteria (in the new style interface).
-The UK_TABLE_CAT and FK_TABLE_CAT fields of a fetched row are always
-NULL (undef).
-See L</table_info()> for more detailed information.
-
-If the primary or foreign key constraints were created without an identifier,
-UK_NAME or FK_NAME contains a system generated name with the form SYS_Cn.
-
-The UPDATE_RULE field is always 3 ('NO ACTION'), because Oracle (currently)
-does not support other actions.
-
-The DELETE_RULE field may contain wrong values. This is a known Bug (#1271663)
-in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and
-'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other
-actions (incl. 'SET NULL') appear as 'NO ACTION'.
-
-The DEFERABILITY field is always NULL, because this columns is
-not present in the ALL_CONSTRAINTS view of older Oracle releases.
-
-The result set is ordered by UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM,
-FK_TABLE_NAME, ORDINAL_POSITION.
-
-An identifier is passed I<as is>, i.e. as the user provides or
-Oracle returns it.
-See L</table_info()> for more detailed information.
-
-=head2 C<column_info()>
-
-Oracle does not support catalogs so TABLE_CAT is ignored as
-selection criterion.
-The TABLE_CAT field of a fetched row is always NULL (undef).
-See L</table_info()> for more detailed information.
-
-The CHAR_OCTET_LENGTH field is (currently) always NULL (undef).
-
-Don't rely on the values of the BUFFER_LENGTH field!
-Especially the length of FLOATs may be wrong.
-
-Datatype codes for non-standard types are subject to change.
-
-Attention! The DATA_DEFAULT (COLUMN_DEF) column is of type LONG.
-
-The result set is ordered by TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION.
-
-An identifier is passed I<as is>, i.e. as the user provides or
-Oracle returns it.
-See L</table_info()> for more detailed information.
-
-
-=head1 International NLS / 8-bit text issues
-
-If 8-bit text is returned as '?' characters or can't be inserted
-make sure the following environment vaiables are set correctly:
- NLS_LANG, ORA_NLS, ORA_NLS32, ORA_NLS33
-Thanks to Robin Langdon <robin@igis.se> for this information.
-Example:
- $ENV{NLS_LANG} = "american_america.we8iso8859p1";
- $ENV{ORA_NLS} = "$ENV{ORACLE_HOME}/ocommon/nls/admin/data";
-
-Also From: Yngvi Thor Sigurjonsson <yngvi@hagkaup.is>
-If you are using 8-bit characters and "export" for backups make sure
-that you have NLS_LANG set when export is run. Otherwise you might get
-unusable backups with ? replacing all your beloved characters. We were
-lucky once when we noticed that our exports were damaged before
-disaster struck.
-
-Remember that the database has to be created with an 8-bit character set.
-
-Also note that the NLS files $ORACLE_HOME/ocommon/nls/admin/data
-changed extension (from .d to .nlb) between 7.2.3 and 7.3.2.
-
-
-=head1 PL/SQL Examples
-
-These PL/SQL examples come from: Eric Bartley <bartley@cc.purdue.edu>.
-
- # we assume this package already exists
- my $plsql = q{
-
- CREATE OR REPLACE PACKAGE plsql_example
- IS
- PROCEDURE proc_np;
-
- PROCEDURE proc_in (
- err_code IN NUMBER
- );
-
- PROCEDURE proc_in_inout (
- test_num IN NUMBER,
- is_odd IN OUT NUMBER
- );
-
- FUNCTION func_np
- RETURN VARCHAR2;
-
- END plsql_example;
-
- CREATE OR REPLACE PACKAGE BODY plsql_example
- IS
- PROCEDURE proc_np
- IS
- whoami VARCHAR2(20) := NULL;
- BEGIN
- SELECT USER INTO whoami FROM DUAL;
- END;
-
- PROCEDURE proc_in (
- err_code IN NUMBER
- )
- IS
- BEGIN
- RAISE_APPLICATION_ERROR(err_code, 'This is a test.');
- END;
-
- PROCEDURE proc_in_inout (
- test_num IN NUMBER,
- is_odd IN OUT NUMBER
- )
- IS
- BEGIN
- is_odd := MOD(test_num, 2);
- END;
-
- FUNCTION func_np
- RETURN VARCHAR2
- IS
- ret_val VARCHAR2(20);
- BEGIN
- SELECT USER INTO ret_val FROM DUAL;
- RETURN ret_val;
- END;
-
- END plsql_example;
- };
-
- use DBI;
-
- my($db, $csr, $ret_val);
-
- $db = DBI->connect('dbi:Oracle:database','user','password')
- or die "Unable to connect: $DBI::errstr";
-
- # So we don't have to check every DBI call we set RaiseError.
- # See the DBI docs now if you're not familiar with RaiseError.
- $db->{RaiseError} = 1;
-
- # Example 1
- #
- # Calling a PLSQL procedure that takes no parameters. This shows you the
- # basic's of what you need to execute a PLSQL procedure. Just wrap your
- # procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
- #
- # p.s. If you've used SQL*Plus's exec command all it does is wrap the
- # command in a BEGIN END; block for you.
-
- $csr = $db->prepare(q{
- BEGIN
- PLSQL_EXAMPLE.PROC_NP;
- END;
- });
- $csr->execute;
-
-
- # Example 2
- #
- # Now we call a procedure that has 1 IN parameter. Here we use bind_param
- # to bind out parameter to the prepared statement just like you might
- # do for an INSERT, UPDATE, DELETE, or SELECT statement.
- #
- # I could have used positional placeholders (e.g. :1, :2, etc.) or
- # ODBC style placeholders (e.g. ?), but I prefer Oracle's named
- # placeholders (but few DBI drivers support them so they're not portable).
-
- my $err_code = -20001;
-
- $csr = $db->prepare(q{
- BEGIN
- PLSQL_EXAMPLE.PROC_IN(:err_code);
- END;
- });
-
- $csr->bind_param(":err_code", $err_code);
-
- # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
- # Because we set RaiseError, the DBI will croak (die) so we catch that with eval.
- eval {
- $csr->execute;
- };
- print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n";
-
-
- # Example 3
- #
- # Building on the last example, I've added 1 IN OUT parameter. We still
- # use a placeholders in the call to prepare, the difference is that
- # we now call bind_param_inout to bind the value to the place holder.
- #
- # Note that the third parameter to bind_param_inout is the maximum size
- # of the variable. You normally make this slightly larger than necessary.
- # But note that the perl variable will have that much memory assigned to
- # it even if the actual value returned is shorter.
-
- my $test_num = 5;
- my $is_odd;
-
- $csr = $db->prepare(q{
- BEGIN
- PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd);
- END;
- });
-
- # The value of $test_num is _copied_ here
- $csr->bind_param(":test_num", $test_num);
-
- $csr->bind_param_inout(":is_odd", \$is_odd, 1);
-
- # The execute will automagically update the value of $is_odd
- $csr->execute;
-
- print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n";
-
-
- # Example 4
- #
- # What about the return value of a PLSQL function? Well treat it the same
- # as you would a call to a function from SQL*Plus. We add a placeholder
- # for the return value and bind it with a call to bind_param_inout so
- # we can access it's value after execute.
-
- my $whoami = "";
-
- $csr = $db->prepare(q{
- BEGIN
- :whoami := PLSQL_EXAMPLE.FUNC_NP;
- END;
- });
-
- $csr->bind_param_inout(":whoami", \$whoami, 20);
- $csr->execute;
- print "Your database user name is $whoami\n";
-
- $db->disconnect;
-
-You can find more examples in the t/plsql.t file in the DBD::Oracle
-source directory.
-
-
-=head1 Private database handle functions
-
-These functions are called through the method func()
-which is described in the DBI documentation.
-
-=head2 plsql_errstr
-
-This function returns a string which describes the errors
-from the most recent PL/SQL function, procedure, package,
-or package body compile in a format similar to the output
-of the SQL*Plus command 'show errors'.
-
-The function returns undef if the error string could not
-be retrieved due to a database error.
-Look in $dbh->errstr for the cause of the failure.
-
-If there are no compile errors, an empty string is returned.
-
-Example:
-
- # Show the errors if CREATE PROCEDURE fails
- $dbh->{RaiseError} = 0;
- if ( $dbh->do( q{
- CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as
- BEGIN
- PROCEDURE filltab( stuff OUT TAB ); asdf
- END; } ) ) {} # Statement succeeded
- }
- elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure
- else {
- my $msg = $dbh->func( 'plsql_errstr' );
- die $dbh->errstr if ! defined $msg;
- die $msg if $msg;
- }
-
-=head2 dbms_output_enable / dbms_output_put / dbms_output_get
-
-These functions use the PL/SQL DBMS_OUTPUT package to store and
-retrieve text using the DBMS_OUTPUT buffer. Text stored in this buffer
-by dbms_output_put or any PL/SQL block can be retrieved by
-dbms_output_get or any PL/SQL block connected to the same database
-session.
-
-Stored text is not available until after dbms_output_put or the PL/SQL
-block that saved it completes its execution. This means you B<CAN NOT>
-use these functions to monitor long running PL/SQL procedures.
-
-Example 1:
-
- # Enable DBMS_OUTPUT and set the buffer size
- $dbh->{RaiseError} = 1;
- $dbh->func( 1000000, 'dbms_output_enable' );
-
- # Put text in the buffer . . .
- $dbh->func( @text, 'dbms_output_put' );
-
- # . . . and retreive it later
- @text = $dbh->func( 'dbms_output_get' );
-
-Example 2:
-
- $dbh->{RaiseError} = 1;
- $sth = $dbh->prepare(q{
- DECLARE tmp VARCHAR2(50);
- BEGIN
- SELECT SYSDATE INTO tmp FROM DUAL;
- dbms_output.put_line('The date is '||tmp);
- END;
- });
- $sth->execute;
-
- # retreive the string
- $date_string = $dbh->func( 'dbms_output_get' );
-
-
-=over 4
-
-=item dbms_output_enable ( [ buffer_size ] )
-
-This function calls DBMS_OUTPUT.ENABLE to enable calls to package
-DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to
-these procedures are ignored unless DBMS_OUTPUT.ENABLE is called
-first.
-
-The buffer_size is the maximum amount of text that can be saved in the
-buffer and must be between 2000 and 1,000,000. If buffer_size is not
-given, the default is 20,000 bytes.
-
-=item dbms_output_put ( [ @lines ] )
-
-This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer.
-
-If all lines were saved successfully the function returns 1. Depending
-on the context, an empty list or undef is returned for failure.
-
-If any line causes buffer_size to be exceeded, a buffer overflow error
-is raised and the function call fails. Some of the text might be in
-the buffer.
-
-=item dbms_output_get
-
-This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from
-the buffer.
-
-In an array context, all complete lines are removed from the buffer and
-returned as a list. If there are no complete lines, an empty list is
-returned.
-
-In a scalar context, the first complete line is removed from the buffer
-and returned. If there are no complete lines, undef is returned.
-
-Any text in the buffer after a call to DBMS_OUTPUT.GET_LINE or
-DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE,
-DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE.
-
-=back
-
-
-=head1 Using DBD::Oracle with Oracle 8 - Features and Issues
-
-DBD::Oracle version 0.55 onwards can be built to use either the Oracle 7
-or Oracle 8 OCI (Oracle Call Interface) API functions. The new Oracle 8
-API is used by default and offers several advantages, including support
-for LOB types and cursor binding. Here's a quote from the Oracle OCI
-documentation:
-
- The Oracle8 OCI has several enhancements to improve application
- performance and scalability. Application performance has been improved
- by reducing the number of client to server round trips required and
- scalability improvements have been facilitated by reducing the amount
- of state information that needs to be retained on the server side.
-
-=head2 Prepare postponed till execute
-
-With OCI8, the DBD::Oracle module can avoid an explicit 'describe' operation
-prior to the execution of the statement unless the application requests
-information about the results (such as $sth->{NAME}). This reduces
-communication with the server and increases performance. However, it also
-means that SQL errors are not detected until C<execute()> is called
-(instead of C<prepare()> as with OCI7).
-
-Set L</ora_check_sql> to 0 in prepare() to enable this behaviour.
-
-=head2 Handling LOBs
-
-When fetching LOBs, they are treated just like LONGs and are subject to
-$sth->{LongReadLen} and $sth->{LongTruncOk}. Note that with OCI 7
-DBD::Oracle pre-allocates the whole buffer (LongReadLen) before
-constructing the returned column. With OCI 8 it grows the buffer to
-the amount needed for the largest LOB to be fetched so far.
-
-When inserting or updating LOBs some I<major> magic has to be performed
-behind the scenes to make it transparent. Basically the driver has to
-refetch the newly inserted 'LOB Locators' before being able to write to
-them. However, it works, and I've made it as fast as possible, just
-one extra server-round-trip per insert or update after the first.
-For the time being, only single-row LOB updates are supported. Also
-passing LOBS to PL/SQL blocks doesn't work.
-
-To insert or update a large LOB, DBD::Oracle has to know in advance
-that it is a LOB type. So you need to say:
-
- $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB });
-
-The ORA_CLOB and ORA_BLOB constants can be imported using
-
- use DBD::Oracle qw(:ora_types);
-
-or just use the corresponding integer values (112 and 113).
-
-To make scripts work with both Oracle7 and Oracle8, the Oracle7
-DBD::Oracle will treat the LOB ora_types as LONGs without error.
-So in any code you may have now that looks like
-
- $sth->bind_param($idx, $value, { ora_type => 8 });
-
-you could change the 8 (LONG type) to ORA_CLOB or ORA_BLOB
-(112 or 113).
-
-One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has
-to be able to tell which parameters relate to which table fields.
-In all cases where it can possibly work it out for itself, it does,
-however, if there are multiple LOB fields of the same type in the table
-then you need to tell it which field each LOB param relates to:
-
- $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' });
-
-There's curently no direct way to write a LOB in chunks using DBD::Oracle.
-However, it is possible (though inefficient), using DBMS_LOB.WRITEAPPEND in PL/SQL.
-
-To INSERT a LOB, you need UPDATE privilege.
-
-If L</ora_auto_lob> is 0 in prepare(), you can fetch the LOB Locators and
-do all the work yourself using Oracle::OCI.
-
-=head2 Binding Cursors
-
-Cursors can now be returned from PL/SQL blocks. Either from stored
-procedure OUT parameters or from direct C<OPEN> statements, as show below:
-
- use DBI;
- use DBD::Oracle qw(:ora_types);
- $dbh = DBI->connect(...);
- $sth1 = $dbh->prepare(q{
- BEGIN OPEN :cursor FOR
- SELECT table_name, tablespace_name
- FROM user_tables WHERE tablespace_name = :space;
- END;
- });
- $sth1->bind_param(":space", "USERS");
- my $sth2;
- $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
- $sth1->execute;
- # $sth2 is now a valid DBI statement handle for the cursor
- while ( @row = $sth2->fetchrow_array ) { ... }
-
-The only special requirement is the use of C<bind_param_inout()> with an
-attribute hash parameter that specifies C<ora_type> as C<ORA_RSET>.
-If you don't do that you'll get an error from the C<execute()> like:
-"ORA-06550: line X, column Y: PLS-00306: wrong number or types of
-arguments in call to ...".
-
-Here's an alternative form using a function that returns a cursor:
-
- $sth1 = $dbh->prepare(q{
- CREATE OR REPLACE FUNCTION sp_ListEmp RETURN types.cursorType
- AS l_cursor types.cursorType;
- BEGIN
- OPEN l_cursor FOR select ename, empno from emp order by ename;
- RETURN l_cursor;
- END;
- });
- $sth2 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
-
-To close the cursor you (currently) need to do this:
-
- $sth3 = $dbh->prepare("BEGIN CLOSE :cursor END");
- $sth3->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
- $sth3->execute;
-
-See the C<curref.pl> script in the Oracle.ex directory in the DBD::Oracle
-source distribution for a complete working example.
-
-=head1 Timezones
-
-If TWO_TASK isn't set, Oracle uses the TZ variable from the local environment.
-
-If TWO_TASK IS set, Oracle uses the TZ variable of the listener process
-running on the server.
-
-You could have multiple listeners, each with their own TZ, and assign
-users to the appropriate listener by setting TNS_ADMIN to a directory
-that contains a tnsnames.ora file that points to the port that their
-listener is on.
-
-[Brad Howerter, who supplied this info said: I've done this to simulate
-running a perl script at the end of the previous month even though it
-was the 6th of the new month. I had the dba start up a listener with
-TZ=X+144. (144 hours = 6 days)]
-
-
-=head1 Oracle Related Links
-
-=head2 Oracle on Linux
-
- http://www.datamgmt.com/maillist.html
- http://www.eGroups.com/list/oracle-on-linux
- http://www.wmd.de/wmd/staff/pauck/misc/oracle_on_linux.html
- ftp://oracle-ftp.oracle.com/server/patch_sets/LINUX
- http://www.ixora.com.au/
-
-=head2 Free Oracle Tools and Links
-
- ora_explain supplied and installed with DBD::Oracle.
-
- http://www.orafaq.com/
-
- http://vonnieda.org/oracletool/
-
-=head2 Commercial Oracle Tools and Links
-
-Assorted tools and references for general information.
-No recommendation implied.
-
- http://www.platinum.com/products/oracle.htm
- http://www.SoftTreeTech.com
- http://www.databasegroup.com
-
-Also PL/Vision from RevealNet and Steven Feuerstein, and
-"Q" from Savant Corporation.
-
-
-=head1 SEE ALSO
-
-L<DBI>
-
-http://search.cpan.org/author/TIMB/DBD-Oracle/MANIFEST for all files in
-the DBD::Oracle source distribution including the examples in Oracle.ex/.
-
-=head1 AUTHOR
-
-DBD::Oracle by Tim Bunce. DBI by Tim Bunce.
-
-=head1 COPYRIGHT
-
-The DBD::Oracle module is Copyright (c) 1995,1996,1997,1998,1999 Tim Bunce. England.
-The DBD::Oracle module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself with the exception that it
-cannot be placed on a CD-ROM or similar media for commercial distribution
-without the prior approval of the author unless the CD-ROM is primarily a
-copy of the majority of the CPAN archive.
-
-=head1 ACKNOWLEDGEMENTS
-
-A great many people have helped me over the years. Far too many to
-name, but I thank them all.
-
-See also L<DBI/ACKNOWLEDGEMENTS>.
-
-=cut
@@ -1,126 +1,717 @@
#include "Oracle.h"
-DBISTATE_DECLARE;
+#define BIND_PARAM_INOUT_ALLOW_ARRAY
-#ifdef OCI_V8_SYNTAX
-# define DBD_ORA_OCI 8
-#else
-# define DBD_ORA_OCI 7
-#endif
+DBISTATE_DECLARE;
-MODULE = DBD::Oracle PACKAGE = DBD::Oracle
+MODULE = DBD::Oracle PACKAGE = DBD::Oracle
I32
constant(name=Nullch)
- char *name
- ALIAS:
- ORA_VARCHAR2 = 1
- ORA_NUMBER = 2
- ORA_STRING = 5
- ORA_LONG = 8
- ORA_ROWID = 11
- ORA_DATE = 12
- ORA_RAW = 23
- ORA_LONGRAW = 24
- ORA_CHAR = 96
- ORA_CHARZ = 97
- ORA_MLSLABEL = 105
- ORA_NTY = 108
- ORA_CLOB = 112
- ORA_BLOB = 113
- ORA_RSET = 116
- ORA_OCI = DBD_ORA_OCI
- ORA_SYSDBA = 0x0002
- ORA_SYSOPER = 0x0004
- CODE:
- if (!ix) {
+ char *name
+ ALIAS:
+ ORA_VARCHAR2 = ORA_VARCHAR2
+ ORA_NUMBER = ORA_NUMBER
+ ORA_STRING = ORA_STRING
+ ORA_LONG = ORA_LONG
+ ORA_ROWID = ORA_ROWID
+ ORA_DATE = ORA_DATE
+ ORA_RAW = ORA_RAW
+ ORA_LONGRAW = ORA_LONGRAW
+ ORA_CHAR = ORA_CHAR
+ ORA_CHARZ = ORA_CHARZ
+ ORA_MLSLABEL = 105
+ ORA_XMLTYPE = ORA_XMLTYPE
+ ORA_CLOB = ORA_CLOB
+ ORA_BLOB = ORA_BLOB
+ ORA_RSET = ORA_RSET
+ ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE
+ ORA_NUMBER_TABLE = ORA_NUMBER_TABLE
+ ORA_SYSDBA = 0x0002
+ ORA_SYSOPER = 0x0004
+ ORA_SYSASM = 0x8000
+ ORA_SYSBACKUP = 0x00020000
+ ORA_SYSDG = 0x00040000
+ ORA_SYSKM = 0x00080000
+ SQLCS_IMPLICIT = SQLCS_IMPLICIT
+ SQLCS_NCHAR = SQLCS_NCHAR
+ SQLT_INT = SQLT_INT
+ SQLT_FLT = SQLT_FLT
+ OCI_BATCH_MODE = 0x01
+ OCI_EXACT_FETCH = 0x02
+ OCI_KEEP_FETCH_STATE = 0x04
+ OCI_DESCRIBE_ONLY = 0x10
+ OCI_COMMIT_ON_SUCCESS = 0x20
+ OCI_NON_BLOCKING = 0x40
+ OCI_BATCH_ERRORS = 0x80
+ OCI_PARSE_ONLY = 0x100
+ OCI_SHOW_DML_WARNINGS = 0x400
+ OCI_FETCH_CURRENT = OCI_FETCH_CURRENT
+ OCI_FETCH_NEXT = OCI_FETCH_NEXT
+ OCI_FETCH_FIRST = OCI_FETCH_FIRST
+ OCI_FETCH_LAST = OCI_FETCH_LAST
+ OCI_FETCH_PRIOR = OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE
+ OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE
+ OCI_FO_END = OCI_FO_END
+ OCI_FO_ABORT = OCI_FO_ABORT
+ OCI_FO_REAUTH = OCI_FO_REAUTH
+ OCI_FO_BEGIN = OCI_FO_BEGIN
+ OCI_FO_ERROR = OCI_FO_ERROR
+ OCI_FO_NONE = OCI_FO_NONE
+ OCI_FO_SESSION = OCI_FO_SESSION
+ OCI_FO_SELECT = OCI_FO_SELECT
+ OCI_FO_TXNAL = OCI_FO_TXNAL
+ OCI_FO_RETRY = OCI_FO_RETRY
+ OCI_STMT_SCROLLABLE_READONLY = 0x08
+ OCI_PRELIM_AUTH = 0x00000008
+ OCI_DBSTARTUPFLAG_FORCE = 0x00000001
+ OCI_DBSTARTUPFLAG_RESTRICT = 0x00000002
+ OCI_DBSHUTDOWN_TRANSACTIONAL = 1
+ OCI_DBSHUTDOWN_TRANSACTIONAL_LOCAL = 2
+ OCI_DBSHUTDOWN_IMMEDIATE = 3
+ OCI_DBSHUTDOWN_ABORT = 4
+ OCI_DBSHUTDOWN_FINAL = 5
+ SQLT_CHR = SQLT_CHR
+ SQLT_BIN = SQLT_BIN
+ CODE:
+ if (!ix) {
if (!name) name = GvNAME(CvGV(cv));
croak("Unknown DBD::Oracle constant '%s'", name);
- }
- else RETVAL = ix;
- OUTPUT:
- RETVAL
+ }
+ else RETVAL = ix;
+ OUTPUT:
+ RETVAL
-MODULE = DBD::Oracle PACKAGE = DBD::Oracle
+
+void
+ORA_OCI()
+ CODE:
+ SV *sv = sv_newmortal();
+ sv_setnv(sv, atof(ORA_OCI_VERSION)); /* 9.1! see docs */
+ sv_setpv(sv, ORA_OCI_VERSION); /* 9.10.11.12 */
+ SvNOK_on(sv); /* dualvar hack */
+ ST(0) = sv;
+
+void
+ora_env_var(name)
+ char *name
+ CODE:
+ char buf[1024];
+ char *p = ora_env_var(name, buf, sizeof(buf)-1);
+ SV *sv = sv_newmortal();
+ if (p)
+ sv_setpv(sv, p);
+ ST(0) = sv;
+
+#if defined(__CYGWIN32__) || defined(__CYGWIN64__)
+void
+ora_cygwin_set_env(name, value)
+ char * name
+ char * value
+ CODE:
+ ora_cygwin_set_env(name, value);
+
+#endif /* __CYGWIN32__ */
INCLUDE: Oracle.xsi
-MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
+MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
+
+
+void ora_stmt_type(sth)
+ SV * sth
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ {
+ XSRETURN_IV( imp_sth->stmt_type);
+}
+
+void
+ora_stmt_type_name(sth)
+ SV * sth
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ char *p = oci_stmt_type_name(imp_sth->stmt_type);
+ SV *sv = sv_newmortal();
+ if (p)
+ sv_setpv(sv, p);
+ ST(0) = sv;
+
+void
+ora_scroll_position(sth)
+ SV * sth
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ {
+ XSRETURN_IV( imp_sth->fetch_position);
+}
+
+void
+ora_fetch_scroll(sth,fetch_orient,fetch_offset)
+ SV * sth
+ IV fetch_orient
+ IV fetch_offset
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ {
+ AV *av;
+ imp_sth->fetch_orient=fetch_orient;
+ imp_sth->fetch_offset=fetch_offset;
+ av = dbd_st_fetch(sth,imp_sth);
+ imp_sth->fetch_offset = 1; /* default back to 1 for fetch */
+ imp_sth->fetch_orient=OCI_FETCH_NEXT; /* default back to fetch next */
+ ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
+}
+
+void
+ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs)
+ SV * sth
+ SV * param
+ SV * av_ref
+ IV maxlen
+ SV * attribs
+ CODE:
+ {
+ IV sql_type = 0;
+ D_imp_sth(sth);
+ SV *av_value;
+ if (!SvROK(av_ref) || SvTYPE(SvRV(av_ref)) != SVt_PVAV)
+ croak("bind_param_inout_array needs a reference to a array value");
+ av_value = av_ref;
+ if (SvREADONLY(av_value))
+ croak("Modification of a read-only value attempted");
+ 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, "ora_type",4, svp, sql_type);
+ }
+ }
+ ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE, maxlen)
+ ? &PL_sv_yes : &PL_sv_no;
+}
+
void
ora_fetch(sth)
- SV * sth
- PPCODE:
- /* fetchrow: but with scalar fetch returning NUM_FIELDS for Oraperl */
- /* This code is called _directly_ by Oraperl.pm bypassing the DBI. */
- /* as a result we have to do some things ourselves (like calling */
- /* CLEAR_ERROR) and we loose the tracing that the DBI offers :-( */
- D_imp_sth(sth);
- AV *av;
- int debug = DBIc_DEBUGIV(imp_sth);
- if (DBIS->debug > debug)
+ SV * sth
+ PPCODE:
+ /* fetchrow: but with scalar fetch returning NUM_FIELDS for Oraperl */
+ /* This code is called _directly_ by Oraperl.pm bypassing the DBI. */
+ /* as a result we have to do some things ourselves (like calling */
+ /* CLEAR_ERROR) and we loose the tracing that the DBI offers :-( */
+ D_imp_sth(sth);
+ AV *av;
+ int debug = DBIc_DEBUGIV(imp_sth);
+ if (DBIS->debug > debug)
debug = DBIS->debug;
- DBIh_CLEAR_ERROR(imp_sth);
- if (GIMME == G_SCALAR) { /* XXX Oraperl */
+ DBIh_CLEAR_ERROR(imp_sth);
+ if (GIMME == G_SCALAR) { /* XXX Oraperl */
/* This non-standard behaviour added only to increase the */
/* performance of the oraperl emulation layer (Oraperl.pm) */
if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth))
XSRETURN_UNDEF;
XSRETURN_IV(DBIc_NUM_FIELDS(imp_sth));
- }
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " -> ora_fetch\n");
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
+ }
+ if (debug >= 2)
+ PerlIO_printf(DBILOGFP, " -> ora_fetch\n");
+ av = dbd_st_fetch(sth, imp_sth);
+ if (av) {
int num_fields = AvFILL(av)+1;
int i;
EXTEND(sp, num_fields);
for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
+ PUSHs(AvARRAY(av)[i]);
}
if (debug >= 2)
- PerlIO_printf(DBILOGFP, " <- (...) [%d items]\n", num_fields);
- }
- else {
+ PerlIO_printf(DBILOGFP, " <- (...) [%d items]\n", num_fields);
+ }
+ else {
if (debug >= 2)
- PerlIO_printf(DBILOGFP, " <- () [0 items]\n");
- }
- if (debug >= 2 && SvTRUE(DBIc_ERR(imp_sth)))
- PerlIO_printf(DBILOGFP, " !! ERROR: %s %s",
- neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0));
+ PerlIO_printf(DBILOGFP, " <- () [0 items]\n");
+ }
+ if (debug >= 2 && SvTRUE(DBIc_ERR(imp_sth)))
+ PerlIO_printf(DBILOGFP, " !! ERROR: %s %s",
+ neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0));
+
+void
+ora_execute_array(sth, tuples, exe_count, tuples_status, err_count, cols=&PL_sv_undef)
+ SV * sth
+ SV * tuples
+ IV exe_count
+ SV * tuples_status
+ SV * cols
+ SV * err_count
+ PREINIT:
+ D_imp_sth(sth);
+ int retval;
+ CODE:
+ /* XXX Need default bindings if any phs are so far unbound(?) */
+ /* XXX this code is duplicated in selectrow_arrayref above */
+ if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
+ DBIc_ROW_COUNT(imp_sth) = 0;
+ retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status,
+ cols, (ub4)exe_count,err_count);
+ /* XXX Handle return value ... like DBI::execute_array(). */
+ /* 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 */
void
cancel(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- ST(0) = dbd_st_cancel(sth, imp_sth) ? &sv_yes : &sv_no;
+ SV * sth
+ CODE:
+ D_imp_sth(sth);
+ ST(0) = dbd_st_cancel(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
+
+
+
+
+MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
+
+void
+ora_db_startup(dbh, attribs)
+ SV *dbh
+ SV *attribs
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+#if defined(ORA_OCI_102)
+ ub4 mode;
+ ub4 flags;
+ OCIAdmin *admhp;
+ STRLEN svp_len;
+ text *str;
+#endif
+ CODE:
+#if defined(ORA_OCI_102)
+ SV **svp;
+ mode = OCI_DEFAULT;
+ DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode);
+ flags = OCI_DEFAULT;
+ DBD_ATTRIB_GET_IV(attribs, "ora_flags", 9, svp, flags);
+ admhp = (OCIAdmin*)0;
+ if ((svp=DBD_ATTRIB_GET_SVP(attribs, "ora_pfile", 9)) && SvOK(*svp)) {
+ if (!SvPOK(*svp))
+ croak("ora_pfile is not a string");
+ str = (text*)SvPV(*svp, svp_len);
+ OCIHandleAlloc(imp_dbh->envhp, (dvoid**)&admhp, (ub4)OCI_HTYPE_ADMIN, (size_t)0, (dvoid**)0);
+ OCIAttrSet_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, (dvoid*)str, (ub4)svp_len, (ub4)OCI_ATTR_ADMIN_PFILE, (OCIError*)imp_dbh->errhp, status);
+ }
+ OCIDBStartup_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, flags, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIDBStartup");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = &PL_sv_yes;
+ }
+ if (admhp) OCIHandleFree_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, status);
+#else
+ croak("OCIDBStartup not available");
+#endif
-MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
+void
+ora_db_shutdown(dbh, attribs)
+ SV *dbh
+ SV *attribs
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+#if defined(ORA_OCI_102)
+ ub4 mode;
+ OCIAdmin *admhp;
+#endif
+ CODE:
+#if defined(ORA_OCI_102)
+ SV **svp;
+ mode = OCI_DEFAULT;
+ DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode);
+ admhp = (OCIAdmin*)0;
+ OCIDBShutdown_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIDBShutdown");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = &PL_sv_yes;
+ }
+#else
+ croak("OCIDBShutdown not available");
+#endif
+
+void
+ora_can_taf(dbh)
+ SV *dbh
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ ub4 can_taf = 0;
+ CODE:
+#ifdef OCI_ATTR_TAF_ENABLED
+ OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
+ OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
+ if (status != OCI_SUCCESS) {
+# else
+ if ( 1 ) {
+# endif
+ oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_TAF_ENABLED");
+ XSRETURN_IV(0);
+ }
+ else {
+ XSRETURN_IV(can_taf);
+ }
+
+void
+ora_ping(dbh)
+ SV *dbh
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+#if defined(ORA_OCI_102)
+ ub4 vernum;
+#endif
+ text buf[2];
+ CODE:
+ /*when OCIPing not available,*/
+ /*simply does a call to OCIServerVersion which should make 1 round trip*/
+ /*later I will replace this with the actual OCIPing command*/
+ /*This will work if the DB goes down, */
+ /*If the listener goes down it is another case as the Listener is needed to establish the connection not maintain it*/
+ /*so we should stay connected but we cannot get nay new connections*/
+ {
+ /* RT 69059 - despite OCIPing being introduced in 10.2
+ * it is not available in all versions of 10.2 for AIX
+ * e.g., 10.2.0.4 does not have it and 10.2.0.5 does
+ * see http://comments.gmane.org/gmane.comp.lang.perl.modules.dbi.general/16206
+ * We don't do versions to that accuracy so for AIX you have
+ * to wait until 11.2 for OCIPing.
+ *
+ * Further comments on dbi-dev
+ * "DBD::Oracle RTs a summary and request for help" suggested it
+ * was Oracle bug 5759845 and fixes in 10.2.0.2.
+ */
+#if !defined(ORA_OCI_102) || (defined(_AIX) && !defined(ORA_OCI_112))
+ OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
+#else
+ vernum = ora_db_version(dbh,imp_dbh);
+ /* OCIPing causes server failures if called against server ver < 10.2 */
+ if (((int)((vernum>>24) & 0xFF) < 10 ) || (((int)((vernum>>24) & 0xFF) == 10 ) && ((int)((vernum>>20) & 0x0F) < 2 ))){
+ OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
+ } else {
+ OCIPing_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,status);
+ }
+#endif
+ if (status != OCI_SUCCESS){
+ XSRETURN_IV(0);
+ } else {
+ XSRETURN_IV(1);
+ }
+}
+
void
reauthenticate(dbh, uid, pwd)
- SV * dbh
- char * uid
- char * pwd
- CODE:
- D_imp_dbh(dbh);
- ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &sv_yes : &sv_no;
+ SV * dbh
+ char * uid
+ char * pwd
+ CODE:
+ D_imp_dbh(dbh);
+ ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &PL_sv_yes : &PL_sv_no;
+
+void
+ora_lob_write(dbh, locator, offset, data)
+ SV *dbh
+ OCILobLocator *locator
+ UV offset
+ SV *data
+ PREINIT:
+ D_imp_dbh(dbh);
+ ub4 amtp;
+ STRLEN data_len; /* bytes not chars */
+ dvoid *bufp;
+ sword status;
+ ub2 csid;
+ ub1 csform;
+ CODE:
+ csid = 0;
+ csform = SQLCS_IMPLICIT;
+ bufp = SvPV(data, data_len);
+ amtp = data_len;
+ /* if locator is CLOB and data is UTF8 and not in bytes pragma */
+ /* if (0 && SvUTF8(data) && !IN_BYTES) { amtp = sv_len_utf8(data); } */
+ /* added by lab: */
+ /* LAB do something about length here? see above comment */
+ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
+ ST(0) = &PL_sv_undef;
+ return;
+ }
+#ifdef OCI_ATTR_CHARSET_ID
+ /* Effectively only used so AL32UTF8 works properly */
+ OCILobCharSetId_log_stat(imp_dbh,
+ imp_dbh->envhp,
+ imp_dbh->errhp,
+ locator,
+ &csid,
+ status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
+ ST(0) = &PL_sv_undef;
+ return;
+ }
+#endif /* OCI_ATTR_CHARSET_ID */
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
+
+ OCILobWrite_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
+ &amtp, (ub4)offset,
+ bufp, (ub4)data_len, OCI_ONE_PIECE,
+ NULL, NULL,
+ (ub2)0, csform , status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = &PL_sv_yes;
+ }
+
+void
+ora_lob_append(dbh, locator, data)
+ SV *dbh
+ OCILobLocator *locator
+ SV *data
+ PREINIT:
+ D_imp_dbh(dbh);
+ ub4 amtp;
+ STRLEN data_len; /* bytes not chars */
+ dvoid *bufp;
+ sword status;
+#if !defined(OCI_HTYPE_DIRPATH_FN_CTX) /* Oracle is < 9.0 */
+ ub4 startp;
+#endif
+ ub1 csform;
+ ub2 csid;
+ CODE:
+ csid = 0;
+ csform = SQLCS_IMPLICIT;
+ bufp = SvPV(data, data_len);
+ amtp = data_len;
+ /* if locator is CLOB and data is UTF8 and not in bytes pragma */
+ /* if (1 && SvUTF8(data) && !IN_BYTES) */
+ /* added by lab: */
+ /* LAB do something about length here? see above comment */
+ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
+ ST(0) = &PL_sv_undef;
+ return;
+ }
+#ifdef OCI_ATTR_CHARSET_ID
+ /* Effectively only used so AL32UTF8 works properly */
+ OCILobCharSetId_log_stat(imp_dbh,
+ imp_dbh->envhp,
+ imp_dbh->errhp,
+ locator,
+ &csid,
+ status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
+ ST(0) = &PL_sv_undef;
+ return;
+ }
+#endif /* OCI_ATTR_CHARSET_ID */
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
+ OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
+ &amtp, bufp, (ub4)data_len, OCI_ONE_PIECE,
+ NULL, NULL,
+ csid, csform, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = &PL_sv_yes;
+ }
+
+
-
-MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr
+
+void
+ora_lob_read(dbh, locator, offset, length)
+ SV *dbh
+ OCILobLocator *locator
+ UV offset
+ UV length
+ PREINIT:
+ D_imp_dbh(dbh);
+ ub4 amtp;
+ STRLEN bufp_len;
+ SV *dest_sv;
+ dvoid *bufp;
+ sword status;
+ ub1 csform;
+ CODE:
+
+ csform = SQLCS_IMPLICIT;
+ /* NOTE, if length is 0 this will create an empty SV of undef
+ see RT55028 */
+ dest_sv = sv_2mortal(newSV(length*4)); /*LAB: crude hack that works... tim did it else where XXX */
+
+ if (length > 0) {
+ SvPOK_on(dest_sv);
+ bufp_len = SvLEN(dest_sv); /* XXX bytes not chars? (lab: yes) */
+ bufp = SvPVX(dest_sv);
+ amtp = length; /* if utf8 and clob/nclob: in: chars, out: bytes */
+ /* http://www.lc.leidenuniv.nl/awcourse/oracle/appdev.920/a96584/oci16m40.htm#427818 */
+ /* if locator is CLOB and data is UTF8 and not in bytes pragma */
+ /* if (0 && SvUTF8(dest_sv) && !IN_BYTES) { amtp = sv_len_utf8(dest_sv); } */
+ /* added by lab: */
+ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
+ dest_sv = &PL_sv_undef;
+ return;
+ }
+ {
+ /* see rt 75163 */
+ boolean is_open;
+
+ OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &is_open, status);
+ if (status == OCI_SUCCESS && !is_open) {
+ OCILobFileOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
+ (ub1)OCI_FILE_READONLY, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobFileOpen");
+ dest_sv = &PL_sv_undef;
+ }
+ }
+ }
+
+ OCILobRead_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
+ &amtp, (ub4)offset, /* offset starts at 1 */
+ bufp, (ub4)bufp_len,
+ 0, 0, (ub2)0, csform, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobRead");
+ dest_sv = &PL_sv_undef;
+ }
+ else {
+ SvCUR(dest_sv) = amtp; /* always bytes here */
+ *SvEND(dest_sv) = '\0';
+ if (csform){
+ if (CSFORM_IMPLIES_UTF8(csform)){
+ SvUTF8_on(dest_sv);
+ }
+ }
+ }
+ } /* length > 0 */
+
+ ST(0) = dest_sv;
+
+void
+ora_lob_trim(dbh, locator, length)
+ SV *dbh
+ OCILobLocator *locator
+ UV length
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ CODE:
+ OCILobTrim_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, length, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = &PL_sv_yes;
+ }
+
+void
+ora_lob_is_init(dbh, locator)
+ SV *dbh
+ OCILobLocator *locator
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ boolean is_init = 0;
+ CODE:
+ OCILobLocatorIsInit_log_stat(imp_dbh, imp_dbh->envhp,imp_dbh->errhp,locator,&is_init,status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobLocatorIsInit ora_lob_is_init");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = sv_2mortal(newSVuv(is_init));
+ }
+
+void
+ora_lob_length(dbh, locator)
+ SV *dbh
+ OCILobLocator *locator
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ ub4 len = 0;
+ CODE:
+ OCILobGetLength_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &len, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength ora_lob_length");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = sv_2mortal(newSVuv(len));
+ }
+
+
+void
+ora_lob_chunk_size(dbh, locator)
+ SV *dbh
+ OCILobLocator *locator
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ ub4 chunk_size = 0;
+ CODE:
+ OCILobGetChunkSize_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCILobGetChunkSize");
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ ST(0) = sv_2mortal(newSVuv(chunk_size));
+ }
+
+
+MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr
void
init_oci(drh)
- SV * drh
- CODE:
- D_imp_drh(drh);
+ SV * drh
+ CODE:
+ D_imp_drh(drh);
dbd_init_oci(DBIS) ;
dbd_init_oci_drh(imp_drh) ;
-
-
+
+
@@ -1,881 +0,0 @@
-# Oraperl Emulation Interface for Perl 5 DBD::Oracle DBI
-#
-# $Id: Oraperl.pm,v 1.43 2003/03/25 17:40:10 timbo Exp $
-#
-# Copyright (c) 1994,1995 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,
-# with the exception that it cannot be placed on a CD-ROM or similar media
-# for commercial distribution without the prior approval of the author.
-#
-# To use this interface use one of the following invocations:
-#
-# use Oraperl;
-# or
-# eval 'use Oraperl; 1;' || die $@ if $] >= 5;
-#
-# The second form allows oraperl scripts to be used with
-# both oraperl and perl 5.
-
-package Oraperl;
-
-require 5.004;
-
-use DBI 1.21;
-use Exporter;
-
-$VERSION = substr(q$Revision: 1.43 $, 10);
-
-@ISA = qw(Exporter);
-
-@EXPORT = qw(
- &ora_login &ora_open &ora_bind &ora_fetch &ora_close
- &ora_logoff &ora_do &ora_titles &ora_lengths &ora_types
- &ora_commit &ora_rollback &ora_autocommit &ora_version
- &ora_readblob
- $ora_cache $ora_long $ora_trunc $ora_errno $ora_errstr
- $ora_verno $ora_debug
-);
-
-$debug = 0 unless defined $debug;
-$debugdbi = 0;
-# $safe # set true/false before 'use Oraperl' if needed.
-$safe = 1 unless defined $safe;
-
-# Help those who get core dumps from non-'safe' Oraperl (bad cursors)
-use sigtrap qw(ILL);
-if (!$safe) {
- $SIG{BUS} = $SIG{SEGV} = sub {
- print STDERR "Add BEGIN { \$Oraperl::safe=1 } above 'use Oraperl'.\n"
- unless $safe;
- goto &sigtrap::trap;
- };
-}
-
-
-# Install Driver (use of install_driver is a special case here)
-$drh = DBI->install_driver('Oracle');
-if ($drh) {
- print "DBD::Oracle driver installed as $drh\n" if $debug;
- $drh->trace($debug);
- $drh->{CompatMode} = 1;
- $drh->{Warn} = 0;
-}
-
-
-use strict;
-
-sub _func_ref {
- my $name = shift;
- my $pkg = ($Oraperl::safe) ? "DBI" : "DBD::Oracle";
- \&{"${pkg}::$name"};
-}
-
-sub _warn {
- my $prev_warn = shift;
- if ($_[0] =~ /^(Bad|Duplicate) free/) {
- return unless $ENV{PERL_DBD_DUMP} eq 'dump';
- print STDERR "Aborting with a core dump for diagnostics (PERL_DBD_DUMP)\n";
- CORE::dump;
- }
- $prev_warn ? &$prev_warn(@_) : warn @_;
-}
-
-
-# -----------------------------------------------------------------
-#
-# $lda = &ora_login($system_id, $name, $password)
-# &ora_logoff($lda)
-
-sub ora_login {
- my($system_id, $name, $password) = @_;
- local($Oraperl::prev_warn) = $SIG{'__WARN__'} || 0; # must be local
- local($SIG{'__WARN__'}) = sub { _warn($Oraperl::prev_warn, @_) };
- # we now use the new style connect, since the old style is
- # deprecated
- my $dbh = DBI->connect("dbi:Oracle:$system_id", $name, $password, {
- HandleError => sub {
- my ($errstr, $h,) = @_;
- $Oraperl::ora_errno = $h->err;
- $Oraperl::ora_errstr = $h->errstr;
- return; # false
- },
- });
- return $dbh;
-}
-sub ora_logoff {
- my($dbh) = @_;
- return if !$dbh;
- local($Oraperl::prev_warn) = $SIG{'__WARN__'} || 0; # must be local
- local($SIG{'__WARN__'}) = sub { _warn($Oraperl::prev_warn, @_) };
- $dbh->disconnect();
-}
-
-
-
-# -----------------------------------------------------------------
-#
-# $csr = &ora_open($lda, $stmt [, $cache])
-# &ora_bind($csr, $var, ...)
-# &ora_fetch($csr [, $trunc])
-# &ora_do($lda, $stmt)
-# &ora_close($csr)
-
-sub ora_open {
- my($lda, $stmt) = @_;
- $Oraperl::ora_cache_o = $_[2]; # temp hack to pass cache through
-
- my $csr = $lda->prepare($stmt) or return undef;
-
- # only execute here if no bind vars specified
- $csr->execute or return undef unless $csr->{NUM_OF_PARAMS};
-
- $csr;
-}
-
-*ora_bind = _func_ref('st::execute');
-*ora_fetch = \&{"DBD::Oracle::st::ora_fetch"};
-*ora_close = _func_ref('st::finish');
-
-sub ora_do {
- # error => undef
- # 0 => "0E0" (0 but true)
- # >0 => >0
- my($lda, $stmt, @params) = @_; # @params are an extension to the original Oraperl.
-
- return $lda->do($stmt, undef, @params); # SEE DEFAULT METHOD IN DBI.pm
-
- # OLD CODE:
- # $csr is local, cursor will be closed on exit
- my $csr = $lda->prepare($stmt) or return undef;
- # Oracle OCI will automatically execute DDL statements in prepare()!
- # We must be carefull not to execute them again! This needs careful
- # examination and thought.
- # Perhaps oracle is smart enough not to execute them again?
- my $ret = $csr->execute(@params);
- my $rows = $csr->rows;
- ($rows == 0) ? "0E0" : $rows;
-}
-
-
-# -----------------------------------------------------------------
-#
-# &ora_titles($csr [, $truncate])
-# &ora_lengths($csr)
-# &ora_types($csr)
-
-sub ora_titles{
- my($csr, $trunc) = @_;
- warn "ora_titles: truncate option not implemented" if $trunc;
- @{$csr->{'NAME'}};
-}
-sub ora_lengths{
- @{shift->{'ora_lengths'}} # oracle specific
-}
-sub ora_types{
- @{shift->{'ora_types'}} # oracle specific
-}
-
-
-# -----------------------------------------------------------------
-#
-# &ora_commit($lda)
-# &ora_rollback($lda)
-# &ora_autocommit($lda, $on_off)
-# &ora_version
-
-*ora_commit = _func_ref('db::commit');
-*ora_rollback = _func_ref('db::rollback');
-
-sub ora_autocommit {
- my($lda, $mode) = @_;
- $lda->{AutoCommit} = $mode;
- "0E0";
-}
-sub ora_version {
- my($sw) = DBI->internal;
- print "\n";
- print "Oraperl emulation interface version $Oraperl::VERSION\n";
- print "$Oraperl::drh->{Attribution}\n";
- print "$sw->{Attribution}\n\n";
-}
-
-
-# -----------------------------------------------------------------
-#
-# $ora_errno
-# $ora_errstr
-
-# This is really internal knowledge but it saves using tie and
-# performance for ora_errno is very important.
-*Oraperl::ora_errno = \$DBD::Oracle::err;
-*Oraperl::ora_errstr = \$DBD::Oracle::errstr;
-
-
-# -----------------------------------------------------------------
-#
-# $ora_verno
-# $ora_debug not supported, use $h->debug(2) where $h is $lda or $csr
-# $ora_cache not supported
-# $ora_long used at ora_open()
-# $ora_trunc used at ora_open()
-
-$Oraperl::ora_verno = '3.000'; # to distinguish it from oraperl 2.4
-
-# ora_long is left unset so that the DBI $h->{LongReadLen} attrib will be used
-# by default. If ora_long is set then LongReadLen will be ignored (sadly) but
-# that behaviour may change later to only apply to oraperl mode handles.
-#$Oraperl::ora_long = 80; # 80, oraperl default
-$Oraperl::ora_trunc = 0; # long trunc is error, oraperl default
-
-
-# -----------------------------------------------------------------
-#
-# Non-oraperl extensions added here to make it easy to still run
-# script using oraperl (by avoiding $csr->blob_read(...))
-
-*ora_readblob = _func_ref('st::blob_read');
-
-
-1;
-__END__
-
-=head1 NAME
-
-Oraperl - Perl access to Oracle databases for old oraperl scripts
-
-=head1 SYNOPSIS
-
- eval 'use Oraperl; 1;' || die $@ if $] >= 5; # ADD THIS LINE TO OLD SCRIPTS
-
- $lda = &ora_login($system_id, $name, $password)
- $csr = &ora_open($lda, $stmt [, $cache])
- &ora_bind($csr, $var, ...)
- &ora_fetch($csr [, $trunc])
- &ora_close($csr)
- &ora_logoff($lda)
-
- &ora_do($lda, $stmt)
-
- &ora_titles($csr)
- &ora_lengths($csr)
- &ora_types($csr)
- &ora_commit($lda)
- &ora_rollback($lda)
- &ora_autocommit($lda, $on_off)
- &ora_version()
-
- $ora_cache
- $ora_long
- $ora_trunc
- $ora_errno
- $ora_errstr
- $ora_verno
-
- $ora_debug
-
-=head1 DESCRIPTION
-
-Oraperl is an extension to Perl which allows access to Oracle databases.
-
-The original oraperl was a Perl 4 binary with Oracle OCI compiled into it.
-The Perl 5 Oraperl module described here is distributed with L<DBD::Oracle>
-(a database driver what operates within L<DBI>) and adds an extra layer over
-L<DBI> method calls.
-The Oraperl module should only be used to allow existing Perl 4 oraperl scripts
-to run with minimal changes; any new development should use L<DBI> directly.
-
-The functions which make up this extension are described in the
-following sections. All functions return a false or undefined (in the
-Perl sense) value to indicate failure. You do not need to understand
-the references to OCI in these descriptions. They are here to help
-those who wish to extend the routines or to port them to new machines.
-
-The text in this document is largely unchanged from the original Perl4
-oraperl manual written by Kevin Stock <kstock@auspex.fr>. Any comments
-specific to the DBD::Oracle Oraperl emulation are prefixed by B<DBD:>.
-See the DBD::Oracle and DBI manuals for more information.
-
-B<DBD:> In order to make the oraperl function definitions available in
-perl5 you need to arrange to 'use' the Oraperl.pm module in each file
-or package which uses them. You can do this by simply adding S<C<use
-Oraperl;>> in each file or package. If you need to make the scripts work
-with both the perl4 oraperl and perl5 you should add add the following
-text instead:
-
- eval 'use Oraperl; 1;' || die $@ if $] >= 5;
-
-=head2 Principal Functions
-
-The main functions for database access are &ora_login(), &ora_open(),
-&ora_bind(), &ora_fetch(), &ora_close(), &ora_do() and &ora_logoff().
-
-=over 2
-
-=item * ora_login
-
- $lda = &ora_login($system_id, $username, $password)
-
-In order to access information held within an Oracle database, a
-program must first log in to it by calling the &ora_login() function.
-This function is called with three parameters, the system ID (see
-below) of the Oracle database to be used, and the Oracle username and
-password. The value returned is a login identifier (actually an Oracle
-Login Data Area) referred to below as $lda.
-
-Multiple logins may be active simultaneously. This allows a simple
-mechanism for correlating or transferring data between databases.
-
-Most Oracle programs (for example, SQL*Plus or SQL*Forms) examine the
-environment variable ORACLE_SID or TWO_TASK to determine which database
-to connect to. In an environment which uses several different
-databases, it is easy to make a mistake, and attempt to run a program
-on the wrong one. Also, it is cumbersome to create a program which
-works with more than one database simultaneously. Therefore, Oraperl
-requires the system ID to be passed as a parameter. However, if the
-system ID parameter is an empty string then oracle will use the
-existing value of ORACLE_SID or TWO_TASK in the usual manner.
-
-Example:
-
- $lda = &ora_login('personnel', 'scott', 'tiger') || die $ora_errstr;
-
-This function is equivalent to the OCI olon and orlon functions.
-
-B<DBD:> note that a name is assumed to be a TNS alias if it does not
-appear as the name of a SID in /etc/oratab or /var/opt/oracle/oratab.
-See the code in Oracle.pm for the full logic of database name handling.
-
-B<DBD:> Since the returned $lda is a Perl5 reference the database login
-identifier is now automatically released if $lda is overwritten or goes
-out of scope.
-
-=item * ora_open
-
- $csr = &ora_open($lda, $statement [, $cache])
-
-To specify an SQL statement to be executed, the program must call the
-&ora_open() function. This function takes at least two parameters: a
-login identifier (obtained from &ora_login()) and the SQL statement to
-be executed. An optional third parameter specifies the size of the row
-cache to be used for a SELECT statement. The value returned from
-&ora_open() is a statement identifier (actually an ORACLE Cursor)
-referred to below as $csr.
-
-If the row cache size is not specified, a default size is
-used. As distributed, the default is five rows, but this
-may have been changed at your installation (see the
-&ora_version() function and $ora_cache variable below).
-
-Examples:
-
- $csr = &ora_open($lda, 'select ename, sal from emp order by ename', 10);
-
- $csr = &ora_open($lda, 'insert into dept values(:1, :2, :3)');
-
-This function is equivalent to the OCI oopen and oparse functions. For
-statements which do not contain substitution variables (see the section
-Substitution Variables below), it also uses of the oexec function. For
-SELECT statements, it also makes use of the odescr and odefin functions
-to allocate memory for the values to be returned from the database.
-
-=item * ora_bind
-
- &ora_bind($csr, $var, ...)
-
-If an SQL statement contains substitution variables (see the section
-Substitution Variables below), &ora_bind() is used to assign actual
-values to them. This function takes a statement identifier (obtained
-from &ora_open()) as its first parameter, followed by as many
-parameters as are required by the statement.
-
-Example:
-
- &ora_bind($csr, 50, 'management', 'Paris');
-
-This function is equivalent to the OCI obndrn and oexec statements.
-
-The OCI obndrn function does not allow empty strings to be bound. As
-distributed, $ora_bind therefore replaces empty strings with a single
-space. However, a compilation option allows this substitution to be
-suppressed, causing &ora_bind() to fail. The output from the
-&ora_version() function specifies which is the case at your installation.
-
-=item * ora_fetch
-
- $nfields = &ora_fetch($csr)
-
- @data = &ora_fetch($csr [, $trunc])
-
-The &ora_fetch() function is used in conjunction with a SQL SELECT
-statement to retrieve information from a database. This function takes
-one mandatory parameter, a statement identifier (obtained from
-&ora_open()).
-
-Used in a scalar context, the function returns the number of fields
-returned by the query but no data is actually fetched. This may be
-useful in a program which allows a user to enter a statement interactively.
-
-Example:
-
- $nfields = &ora_fetch($csr);
-
-Used in an array context, the value returned is an array containing the
-data, one element per field. Note that this will not work as expected:
-
- @data = &ora_fetch($csr) || die "..."; # WRONG
-
-The || forces a scalar context so ora_fetch returns the number of fields.
-
-An optional second parameter may be supplied to indicate whether the
-truncation of a LONG or LONG RAW field is to be permitted (non-zero) or
-considered an error (zero). If this parameter is not specified, the
-value of the global variable $ora_trunc is used instead. Truncation of
-other datatypes is always considered a error.
-
-B<DBD:> The optional second parameter to ora_fetch is not supported.
-A DBI usage error will be generated if a second parameter is supplied.
-Use the global variable $ora_trunc instead. Also note that the
-experimental DBI blob_read method can be used to retrieve a long:
-
- $csr->blob_read($field, $offset, $len [, \$dest, $destoffset]);
-
-If truncation occurs, $ora_errno will be set to 1406. &ora_fetch()
-will complete successfully if truncation is permitted, otherwise it
-will fail.
-
-&ora_fetch() will fail at the end of the data or if an error occurs. It
-is possible to distinguish between these cases by testing the value of
-the variable $ora_errno. This will be zero for end of data, non-zero if
-an error has occurred.
-
-Example:
-
- while (($deptno, $dname, $loc) = &ora_fetch($csr))
- {
- warn "Truncated!!!" if $ora_errno == 1406;
- # do something with the data
- }
- warn $ora_errstr if $ora_errno;
-
-This function is equivalent to the OCI ofetch function.
-
-=item * ora_close
-
- &ora_close($csr)
-
-If an SQL statement is no longer required (for example, all the data
-selected has been processed, or no more rows are to be inserted) then
-the statement identifier should be released. This is done by calling
-the &ora_close() function with the statement identifier as its only
-parameter.
-
-This function is equivalent to the OCI oclose function.
-
-B<DBD:> Since $csr is a Perl5 reference the statement/cursor is now
-automatically closed if $csr is overwritten or goes out of scope.
-
-
-=item * ora_do
-
- &ora_do($lda, $statement)
-
-Not all SQL statements return data or contain substitution
-variables. In these cases the &ora_do() function may be
-used as an alternative to &ora_open() and &ora_close().
-This function takes two parameters, a login identifier and
-the statement to be executed.
-
-Example:
-
- &ora_do($lda, 'drop table employee');
-
-This function is roughly equivalent to
-
- &ora_close( &ora_open($lda, $statement) )
-
-B<DBD:> oraperl v2 used to return the string 'OK' to indicate
-success with a zero numeric value. The Oraperl emulation now
-uses the string '0E0' to achieve the same effect since it does
-not cause any C<-w> warnings when used in a numeric context.
-
-=item * ora_logoff
-
- &ora_logoff($lda)
-
-When the program no longer needs to access a given database, the login
-identifier should be released using the &ora_logoff() function.
-
-This function is equivalent to the OCI ologoff function.
-
-B<DBD:> Since $lda is a Perl5 reference the database login identifier
-is now automatically released if $lda is overwritten or goes out of scope.
-
-=back
-
-=head2 Ancillary Functions
-
-Additional functions available are: &ora_titles(),
-&ora_lengths(), &ora_types(), &ora_autocommit(),
-&ora_commit(), &ora_rollback() and &ora_version().
-
-The first three are of most use within a program which
-allows statements to be entered interactively. See, for
-example, the sample program sql which is supplied with
-Oraperl and may have been installed at your site.
-
-=over 2
-
-=item * ora_titles
-
- @titles = &ora_titles($csr)
-
-A program may determine the field titles of an executed
-query by calling &ora_titles(). This function takes a
-single parameter, a statement identifier (obtained from
-&ora_open()) indicating the query for which the titles are
-required. The titles are returned as an array of strings,
-one for each column.
-
-Titles are truncated to the length of the field, as reported
-by the &ora_lengths() function.
-
-B<DBD:> oraperl v2.2 actually changed the behaviour such that the
-titles were not truncated unless an optional second parameter was
-true. This was not reflected in the oraperl manual. The Oraperl
-emulation adopts the non truncating behaviour and doesn't support the
-truncate parameter.
-
-
-=item * ora_lengths
-
- @lengths = &ora_lengths($csr)
-
-A program may determine the length of each of the fields
-returned by a query by calling the &ora_lengths() function.
-This function takes a single parameter, a statement
-identifier (obtained from &ora_open()) indicating the query
-for which the lengths are required. The lengths are
-returned as an array of integers, one for each column.
-
-
-=item * ora_types
-
- @types = &ora_types($csr)
-
-A program may determine the type of each of the fields returned by a
-query by calling the &ora_types() function. This function takes a
-single parameter, a statement identifier (obtained from &ora_open())
-indicating the query for which the lengths are required. The types are
-returned as an array of integers, one for each field.
-
-These types are defined in your OCI documentation. The correct
-interpretation for Oracle v6 is given in the file oraperl.ph.
-
-
-=item * ora_autocommit
-
- &ora_autocommit($lda, $on_or_off)
-
-Autocommit mode (in which each transaction is committed immediately,
-without waiting for an explicit commit) may be enabled or disabled
-using &ora_autocommit(). This function takes two parameters, a login
-identifier (obtained from &ora_login()) and a true/false value
-indicating whether autocommit is to be enabled (non-zero) or disabled
-(zero). By default, autocommit is off.
-
-Note that autocommit can only be set per login, not per statement. If
-you need to control autocommit by statement (for example, to allow
-deletions to be rolled back, but insertions to be committed
-immediately) you should make multiple calls to &ora_login() and use a
-separate login identifier for each statement.
-
-
-=item * ora_commit, ora_rollback
-
- &ora_commit($lda)
- &ora_rollback($lda)
-
-Modifications to a database may be committed or rolled back using the
-&ora_commit() and &ora_rollback() functions. These functions take a
-single parameter, a login identifier obtained from &ora_login().
-
-Transactions which have been committed (either explicitly by a call to
-&ora_commit() or implicitly through the use of &ora_autocommit())
-cannot be subsequently rolled back.
-
-Note that commit and rollback can only be used per login, not per
-statement. If you need to commit or rollback by statement you should
-make multiple calls to &ora_login() and use a separate login identifier
-for each statement.
-
-
-=item * ora_version
-
- &ora_version()
-
-The &ora_version() function prints the version number and
-copyright information concerning Oraperl. It also prints
-the values of various compilation time options. It does not
-return any value, and should not normally be used in a
-program.
-
-Example:
-
- perl -MOraperl -e 'ora_version()'
-
- This is Oraperl, version 2, patch level 0.
-
- Debugging is available, including the -D flag.
- Default fetch row cache size is 5.
- Empty bind values are replaced by a space.
-
- Perl is copyright by Larry Wall; type oraperl -v for details.
- Additions for oraperl: Copyright 1991, 1992, Kevin Stock.
-
- Oraperl may be distributed under the same conditions as Perl.
-
-This function is the equivalent of Perl's C<-v> flag.
-
-B<DBD:> The Oraperl emulation printout is similar but not identical.
-
-=back
-
-=head1 VARIABLES
-
-Six special variables are provided, $ora_cache, $ora_long,
-$ora_trunc, $ora_errno, $ora_errstr and $ora_verno.
-
-=head2 Customisation Variables
-
-These variables are used to dictate the behaviour of Oraperl
-under certain conditions.
-
-=over 2
-
-=item * $ora_cache
-
-The $ora_cache variable determines the default cache size used by the
-&ora_open() function for SELECT statements if an explicit cache size is
-not given.
-
-It is initialised to the default value reported by &ora_version() but
-may be set within a program to apply to all subsequent calls to
-&ora_open(). Cursors which are already open are not affected. As
-distributed, the default value is five, but may have been altered at
-your installation.
-
-As a special case, assigning zero to $ora_cache resets it to the
-default value. Attempting to set $ora_cache to a negative value results
-in a warning.
-
-
-=item * $ora_long
-
-Normally, Oraperl interrogates the database to determine the length of
-each field and allocates buffer space accordingly. This is not
-possible for fields of type LONG or LONGRAW. To allocate space
-according to the maximum possible length (65535 bytes) would obviously
-be extremely wasteful of memory.
-
-Therefore, when &ora_open() determines that a field is a LONG type, it
-allocates the amount of space indicated by the $ora_long variable. This
-is initially set to 80 (for compatibility with Oracle products) but may
-be set within a program to whatever size is required.
-
-$ora_long is only used when fetching data, not when inserting it.
-
-
-=item * $ora_trunc
-
-Since Oraperl cannot determine exactly the maximum length of a LONG
-field, it is possible that the length indicated by $ora_long is not
-sufficient to store the data fetched. In such a case, the optional
-second parameter to &ora_fetch() indicates whether the truncation
-should be allowed or should provoke an error.
-
-If this second parameter is not specified, the value of $ora_trunc is
-used as a default. This only applies to LONG and LONGRAW data types.
-Truncation of a field of any other type is always considered an error
-(principally because it indicates a bug in Oraperl).
-
-=back
-
-=head2 Status Variables
-
-These variables report information about error conditions or about
-Oraperl itself. They may only be read; a fatal error occurs if a
-program attempts to change them.
-
-=over 2
-
-=item * $ora_errno
-
-$ora_errno contains the Oracle error code provoked by the last function
-call.
-
-There are two cases of particular interest concerning &ora_fetch(). If
-a LONG or LONGRAW field is truncated (and truncation is allowed) then
-&ora_fetch() will complete successfully but $ora_errno will be set to
-1406 to indicate the truncation. When &ora_fetch() fails, $ora_errno
-will be set to zero if this was due to the end of data or an error code
-if it was due to an actual error.
-
-
-=item * $ora_errstr
-
-The $ora_errstr variable contains the Oracle error message
-corresponding to the current value of $ora_errno.
-
-
-=item * $ora_verno
-
-The $ora_verno variable contains the version number of Oraperl in the
-form v.ppp where v is the major version number and ppp is the
-patchlevel. For example, in Oraperl version 3, patch level 142,
-$ora_verno would contain the value 3.142 (more or less, allowing for
-floating point error).
-
-=back
-
-
-=head1 SUBSTITUTION VARIABLES
-
-Oraperl allows an SQL statement to contain substitution variables.
-These consist of a colon followed by a number. For example, a program
-which added records to a telephone list might use the following call to
-&ora_open():
-
- $csr = &ora_open($csr, "insert into telno values(:1, :2)");
-
-The two names :1 and :2 are called substitution variables. The
-function &ora_bind() is used to assign values to these variables. For
-example, the following statements would add two new people to the
-list:
-
- &ora_bind($csr, "Annette", "472-8836");
- &ora_bind($csr, "Brian", "937-1823");
-
-Note that the substitution variables must be assigned consecutively
-beginning from 1 for each SQL statement, as &ora_bind() assigns its
-parameters in this order. Named substitution variables (for example,
-:NAME, :TELNO) are not permitted.
-
-B<DBD:> Substitution variables are now bound as type 1 (VARCHAR2)
-and not type 5 (STRING) by default. This can alter the behaviour of
-SQL code which compares a char field with a substitution variable.
-See the String Comparison section in the Datatypes chapter of the
-Oracle OCI manual for more details.
-
-You can work around this by using DBD::Oracle's ability to specify
-the Oracle type to be used on a per field basis:
-
- $char_attrib = { ora_type => 5 }; # 5 = STRING (ala oraperl2.4)
- $csr = ora_open($dbh, "select foo from bar where x=:1 and y=:2");
- $csr->bind_param(1, $value_x, $char_attrib);
- $csr->bind_param(2, $value_y, $char_attrib);
- ora_bind($csr); # bind with no parameters since we've done bind_param()'s
-
-
-=head1 DEBUGGING
-
-B<DBD:> The Oraperl $ora_debug variable is not supported. However
-detailed debugging can be enabled at any time by executing
-
- $h->debug(2);
-
-where $h is either a $lda or a $csr. If debugging is enabled on an
-$lda then it is automatically passed on to any cursors returned by
-&ora_open().
-
-=head1 EXAMPLE
-
- format STDOUT_TOP =
- Name Phone
- ==== =====
- .
-
- format STDOUT =
- @<<<<<<<<<< @>>>>>>>>>>
- $name, $phone
- .
-
- die "You should use oraperl, not perl\n" unless defined &ora_login;
- $ora_debug = shift if $ARGV[0] =~ /^\-#/;
-
- $lda = &ora_login('t', 'kstock', 'kstock')
- || die $ora_errstr;
- $csr = &ora_open($lda, 'select * from telno order by name')
- || die $ora_errstr;
-
- $nfields = &ora_fetch($csr);
- print "Query will return $nfields fields\n\n";
-
- while (($name, $phone) = &ora_fetch($csr)) { write; }
- warn $ora_errstr if $ora_errno;
-
- die "fetch error: $ora_errstr" if $ora_errno;
-
- do ora_close($csr) || die "can't close cursor";
- do ora_logoff($lda) || die "can't log off Oracle";
-
-
-=head1 NOTES
-
-In keeping with the philosophy of Perl, there is no pre-defined limit
-to the number of simultaneous logins or SQL statements which may be
-active, nor to the number of data fields which may be returned by a
-query. The only limits are those imposed by the amount of memory
-available, or by Oracle.
-
-
-=head1 WARNINGS
-
-The Oraperl emulation software shares no code with the original
-oraperl. It is built on top of the new Perl5 DBI and DBD::Oracle
-modules. These modules are still evolving. (One of the goals of
-the Oraperl emulation software is to allow useful work to be done
-with the DBI and DBD::Oracle modules whilst insulating users from
-the ongoing changes in their interfaces.)
-
-It is quite possible, indeed probable, that some differences in
-behaviour will exist. These are probably confined to error handling.
-
-B<All> differences in behaviour which are not documented here should be
-reported to to dbi-users@perl.org.
-
-
-=head1 SEE ALSO
-
-=over 2
-
-=item Oracle Documentation
-
-SQL Language Reference Manual.
-Programmer's Guide to the Oracle Call Interfaces.
-
-=item Books
-
-Programming Perl by Larry Wall and Randal Schwartz.
-Learning Perl by Randal Schwartz.
-
-=item Manual Pages
-
-perl(1)
-
-=back
-
-=head1 AUTHORS
-
-Perl by Larry Wall <lwall@netlabs.com>.
-
-ORACLE by Oracle Corporation, California.
-
-Original Oraperl 2.4 code and documentation
-by Kevin Stock <kstock@auspex.fr>.
-
-DBI and Oraperl emulation using DBD::Oracle
-by <Tim.Bunce@ig.co.uk>
-
-=cut
@@ -1,249 +1,4293 @@
+NAME
+ DBD::Oracle - Oracle database driver for the DBI module
-DBD::Oracle -- an Oracle 7 and Oracle 8 interface for Perl 5.
+VERSION
+ version 1.74
- Copyright (c) 1994,1995,1996,1997,1998,1999 Tim Bunce, England.
+SYNOPSIS
+ use DBI;
- You may distribute under the terms of either the GNU General Public
- License or the Artistic License, as specified in the Perl README file,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
+ $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd);
- PLEASE READ THE ENTIRE README FILE CAREFULLY !
+ $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd);
- If you are building under MS Windows, read all of README.win32 too.
+ # See the DBI module documentation for full details
+ # for some advanced uses you may need Oracle type values:
+ use DBD::Oracle qw(:ora_types);
-*** QUICK START GUIDE:
+DESCRIPTION
+ DBD::Oracle is a Perl module which works with the DBI module to provide
+ access to Oracle databases.
- The DBI requires one or more 'driver' modules to talk to databases.
- Fetch, build and install the DBI module as per its README file.
- You may then delete its source directory tree since it's no longer needed.
- Use the 'perldoc DBI' command to read the DBI documentation.
- Fetch the DBD::Oracle driver module and unpack it.
- Follow the guidelines in this README file carefully.
+ This documentation describes driver specific behaviour and restrictions.
+ It is not supposed to be used as the only reference for the user. In any
+ case consult the DBI documentation first!
+CONSTANTS
+ :ora_session_modes
+ ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM
-*** *BEFORE* BUILDING, TESTING AND INSTALLING this you will need to:
+ :ora_types
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
- Build, test and install Perl 5 (at least 5.004, preferably
- version 5.004_04 or later).
- It is very important to TEST it and INSTALL it!
+ SQLCS_IMPLICIT
+ SQLCS_NCHAR
+ SQLCS_IMPLICIT and SQLCS_NCHAR are *character set form* values. See
+ notes about Unicode elsewhere in this document.
- Build, test and install the DBI module (at least DBI 1.08).
- It is very important to TEST it and INSTALL it!
+ SQLT_INT
+ SQLT_FLT
+ These types are used only internally, and may be specified as
+ internal bind type for ORA_NUMBER_TABLE. See notes about
+ ORA_NUMBER_TABLE elsewhere in this document
- Remember to *read* the DBI README file and this one CAREFULLY!
+ ORA_OCI
+ Oracle doesn't provide a formal API for determining the exact
+ version number of the OCI client library used, so DBD::Oracle has to
+ go digging (and sometimes has to more or less guess). The ORA_OCI
+ constant holds the result of that process.
- Install enough Oracle software to enable DBD::Oracle to build.
- That usually includes Pro*C and SQL*Net. That's not very specific
- because it varies so much between Oracle releases.
+ In string context ORA_OCI returns the full "A.B.C.D" version string.
- Except under MS Windows, ORACLE_HOME must point to the Oracle Home
- used to create DBD::Oracle. Even under MS Windows, it doesn't hurt.
+ In numeric context ORA_OCI returns the major.minor version number
+ (8.1, 9.2, 10.0 etc). But note that version numbers are not actually
+ floating point and so if Oracle ever makes a release that has a two
+ digit minor version, such as 9.10 it will have a lower numeric value
+ than the preceding 9.9 release. So use with care.
-*** BUILDING:
+ The contents and format of ORA_OCI are subject to change (it may,
+ for example, become a *version object* in later releases). I
+ recommend that you avoid checking for exact values.
- perl Makefile.PL # use a perl that's in your PATH
- make
+ :ora_fetch_orient
+ OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST
+ OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE
-Don't worry about most warnings, specifically "end-of-loop code not
-reached", "ANSI C forbids braced-groups within expressions", "cast
-increases required alignment of target type" and "passing arg 2 of
-`oerhms' with different width due to prototype".
+ These constants are used to set the orientation of a fetch on a
+ scrollable cursor.
-If you have problems see the 'IF YOU HAVE PROBLEMS' section below.
-If it builds without error you should then run the tests. For the
-main tests to work they must be able to connect to an Oracle database.
+ :ora_exe_modes
+ OCI_STMT_SCROLLABLE_READONLY
-You will need to set either the TWO_TASK or ORACLE_SID environment
-variables to the correct values for your database. Consult Oracle
-documentation for more details. Test your setting by connecting to
-the database using an Oracle tool such as sqlplus. Once you can do
-that then you can test DBD::Oracle knowing that it should work.
+ :ora_fail_over
+ OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR
+ OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY
-The supplied tests will connect to the database using the value of the
-ORACLE_USERID environment variable so you should set that to the correct
-value (like 'scott/tiger') before starting the test. Please read README.login.
+DBI CLASS METHODS
+ connect
+ This method creates a database handle by connecting to a database, and
+ is the DBI equivalent of the "new" method. To open a connection to an
+ Oracle database you need to specify a database connection string (URL),
+ username and password.
- make test
+ The connection string is always of the form: "dbi:Oracle:<db
+ identifier>" There are several ways to identify a database:
- make install (if the tests look okay)
+ 1 If the database is local, specifying the SID or service name will be
+ enough.
+ 2 If the database is defined in a TNSNAMES.ORA file, you can use the
+ service name given in the file
-*** IF YOU HAVE PROBLEMS:
+ 3 To connect without TNSNAMES.ORA file, you can use an EZCONNECT url,
+ of the form: //host[:port][/service_name]
-Make sure you are using a recent perl (5.004_05, 5.005_03 or later) and
-make sure it's on your PATH so you can say 'perl Makefile.PL' and not
-'/path/to/perl Makefile.PL'.
+ If port name is not specified, 1521 is the default. If service name is
+ not specified, the hostname will be used as a service name.
-If you get compiler errors refering to Perl's own header files
-(.../CORE/*.h) then there is something wrong with your installation.
-It is 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.
+ The following examples show several ways a connection can be created:
-If you have build/link or core dump problems try:
- perl Makefile.PL -p
-or
- perl Makefile.PL -nob
-If it helps then please let me know (and please include a copy
-of the log from the failed default build, the log from the build that
-worked, plus the output of the "perl -V" command).
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password');
-The new enhanced Oracle 8 OCI is now supported by DBD::Oracle versions
-above 0.54. If the new code causes you problems you can build
-DBD::Oracle for Oracle 8 to use the Oracle 7 OCI API by doing:
- perl Makefile.PL -8
+ $dbh = DBI->connect('dbi:Oracle:DB','username/password','');
-Do not hand edit the generated Makefile unless you are completely sure
-you understand the implications! Always try to make changes via the
-Makefile.PL command line and/or editing the Makefile.PL.
-You should not need to make any changes. If you do please let me
-know so that I can try to make it automatic in a later release.
+ $dbh = DBI->connect('dbi:Oracle:','username@DB','password');
-If you just can't login or login takes a long time then read
-README.login and possibly edit test.pl to suit.
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', '');
-If you can't get it to build on a minimally configured client system
-then read README.client, it might help but basically I can't help much.
-Others on the dbi-users mailing list probably can.
+ $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password');
-If you have linking problems (errors related to libraries or functions)
-then you could try forcing a 'static' build using:
+ OS authentication
+ To connect to a local database with a user which has been set up to
+ authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"):
- make realclean
- perl Makefile.PL LINKTYPE=static
- make
- make perl (you'll need to use and install _this_ new perl binary)
- make test
- make -f Makefile.aperl inst_perl MAP_TARGET=perl (install new perl)
- make install (install DBD::Oracle)
+ $dbh = DBI->connect('dbi:Oracle:','/','');
+ Note the lack of a connection name (use the ORACLE_SID environment
+ variable). If an explicit SID is used you will probably get an ORA-01004
+ error.
->>> Also carefully read the README.help file which is full of useful
->>> tips and workarounds for various problems of various systems.
+ That only works for local databases. (Authentication to remote Oracle
+ databases using your Unix login name without a password is possible but
+ it is not secure and not recommended so not documented here.
+
+ Oracle Environment Variables
+ To use DBD::ORACLE to connect to an Oracle database, ORACLE_HOME
+ environment variable should be set correctly. In general, the value used
+ should match the version of Oracle that was used to build DBD::Oracle.
+ If using dynamic linking then ORACLE_HOME should match the version of
+ Oracle that will be used to load in the Oracle client libraries (via
+ LD_LIBRARY_PATH, ldconfig, or similar on Unix).
+
+ Oracle can use two environment variables to specify default connections:
+ ORACLE_SID and TWO_TASK.
+
+ To use them, specify either a local SID or service name, or a service
+ name that is specified in the TNSNAMES.ORA file.
+
+ Note that if you have *both* local and remote databases, and you have
+ ORACLE_SID *and* TWO_TASK set, and you don't specify a fully qualified
+ connect string on the command line, TWO_TASK takes precedence over
+ ORACLE_SID (i.e. you get connected to remote system).
+
+ It is highly recommended not to rely on environment variables and to
+ always explicitly specify the SID in the connection string. This can
+ prevent serious mistakes such as dropping a schema in the wrong
+ database, and generally makes debugging and troubleshooting easier.
+
+ Also remember that depending on the operating system you are using the
+ differing "ORACLE" environment variables may be case sensitive, so if
+ you are not connecting as you should double check the case of both the
+ variable and its value.
+
+ Timezones
+ If the query is run through SQL*Net (mostly queries that are executed on
+ remote servers), Oracle will return the time zone based on the setting
+ of the UNIX environment variable "TZ" for the user who started the
+ listener.
+
+ If the query is run locally, Oracle will return the time zone based on
+ the "TZ" environment variable setting of the user running the query.
+
+ With local queries, you can change the time zone for a particular user
+ by simply changing the setting of "TZ". To check the current setting,
+ issue the UNIX "date" command.
+
+ Oracle DRCP
+ DBD::Oracle supports DRCP (Database Resident Connection Pool) so if you
+ have an 11.2 database and DRCP is enabled you can direct all of your
+ connections to it by adding ':POOLED' to the SID or setting a connection
+ attribute of ora_drcp, or set the SERVER=POOLED when using a TNSENTRY
+ style connection or even by setting an environment variable ORA_DRCP.
+ All of which are demonstrated below;
+
+ $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password')
+
+ $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password')
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1})
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1,
+ ora_drcp_class=>'my_app',
+ ora_drcp_min =>10})
+
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '')
+
+ $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION=
+ (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521))
+ (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "")
+
+ if the ORA_DRCP environment variable is set then just this
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password')
+
+ You can find a white paper on setting up DRCP and its advantages at
+ <http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf>.
+
+ Please note that DRCP support in DBD::Oracle is relatively new so the
+ mechanics or its implementation are subject to change.
+
+ TAF (Transparent Application Failover)
+ Transparent Application Failover (TAF) is the feature in OCI that allows
+ for clients to automatically reconnect to an instance in the event of a
+ failure of the instance. The reconnect happens automatically from within
+ the OCI (Oracle Call Interface) library. DBD::Oracle now supports a
+ callback function that will fire when a TAF event takes place. You may
+ use the callback to inform the user a failover is taking place or to
+ setup the session again once the failover has succeeded.
+
+ You will have to set up TAF on your instance before you can use this
+ callback. You can test your instance to see if you can use TAF callback
+ with
+
+ $dbh->ora_can_taf();
+
+ If you try to set up a callback without it being enabled DBD::Oracle
+ will croak.
+
+ NOTE: Currently, you must enable TAF during DBI's connect. However once
+ enabled you can change the TAF settings.
+
+ It is outside the scope of this document to go through all of the
+ possible TAF situations you might want to set up but here is a simple
+ example:
+
+ The TNS entry for the instance has had the following added to the
+ CONNECT_DATA section
+
+ (FAILOVER_MODE=
+ (TYPE=select)
+ (METHOD=basic)
+ (RETRIES=10)
+ (DELAY=10))
+
+ You will also have to create your own perl function that will be called
+ from the client. You can name it anything you want and it will always be
+ passed two parameters, the failover event value and the failover type.
+ You can also set a sleep value in case of failover error and the OCI
+ client will sleep for the specified seconds before it attempts another
+ event.
+
+ use DBD::Oracle(qw(:ora_fail_over));
+ #import the ora fail over constants
+
+ #set up TAF on the connection
+ # NOTE since DBD::Oracle uses call_pv you may need to pass a full
+ # name space as the function e.g., 'main::handle_taf'
+ # NOTE from 1.49_00 ora_taf_function can accept a code ref as well
+ # as a sub name as it now uses call_sv
+ my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr',
+ {ora_taf_function => 'main::handle_taf'});
+
+ #create the perl TAF event function
+
+ sub handle_taf {
+ # NOTE from 1.49_00 the $dbh handle was passed to your callback
+ my ($fo_event,$fo_type, $dbh) = @_;
+ if ($fo_event == OCI_FO_BEGIN){
+
+ print " Instance Unavailable Please stand by!! \n";
+ printf(" Your TAF type is %s \n",
+ (($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_ABORT){
+ print " Failover aborted. Failover will not take place.\n";
+ }
+ elsif ($fo_event == OCI_FO_END){
+ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_REAUTH){
+ print " Failed over user. Resuming services\n";
+ }
+ elsif ($fo_event == OCI_FO_ERROR){
+ print " Failover error ...\n";
+ sleep 5; # sleep before having another go
+ return OCI_FO_RETRY;
+ }
+ else {
+ printf(" Bad Failover Event: %d.\n", $fo_event);
+
+ }
+ return 0;
+ }
+
+ The TAF types are as follows
+
+ OCI_FO_SESSION indicates the user has requested only session failover.
+ OCI_FO_SELECT indicates the user has requested select failover.
+ OCI_FO_NONE indicates the user has not requested a failover type.
+ OCI_FO_TXNAL indicates the user has requested a transaction failover.
+
+ The TAF events are as follows
+
+ OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting.
+ OCI_FO_END indicates successful completion of failover.
+ OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying.
+ OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover.
+ OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter).
+
+ Connect Attributes
+ ora_ncs_buff_mtpl
+ You can customize the size of the buffer when selecting LOBs with the
+ built-in AUTO Lob. The default value is 4 which is probably excessive
+ for most situations but is needed for backward compatibility. If you not
+ converting between a NCS on the DB and the Client then you might want to
+ set this to 1 to reduce memory usage.
+
+ This value can also be specified with the "ORA_DBD_NCS_BUFFER"
+ environment variable in which case it sets the value at the connect
+ stage.
+
+ ora_drcp
+ For Oracle 11.2 or greater.
+
+ Set to *1* to enable DRCP. Can also be set via the "ORA_DRCP"
+ environment variable.
+
+ ora_drcp_class
+ If you are using DRCP, you can set a CONNECTION_CLASS for your pools as
+ well. As sessions from a DRCP cannot be shared by users, you can use
+ this setting to identify the same user across different applications.
+ OCI will ensure that sessions belonging to a 'class' are not shared
+ outside the class'.
+
+ The values for ora_drcp_class cannot contain a '*' and must be less than
+ 1024 characters.
+
+ This value can be also be specified with the "ORA_DRCP_CLASS"
+ environment variable.
+
+ ora_drcp_min
+ This optional value specifies the minimum number of sessions that are
+ initially opened. New sessions are only opened after this value has been
+ reached.
+
+ The default value is 4 and any value above 0 is valid.
+
+ Generally, it should be set to the number of concurrent statements the
+ application is planning or expecting to run.
+
+ This value can also be specified with the "ORA_DRCP_MIN" environment
+ variable.
+
+ ora_drcp_max
+ This optional value specifies the maximum number of sessions that can be
+ open at one time. Once reached no more sessions can be opened until one
+ becomes free. The default value is 40 and any value above 1 is valid.
+ You should not set this value lower than ora_drcp_min as that will just
+ waste resources.
+
+ This value can also be specified with the "ORA_DRCP_MAX" environment
+ variable.
+
+ ora_drcp_incr
+ This optional value specifies the next increment for sessions to be
+ started if the current number of sessions are less than ora_drcp_max.
+ The default value is 2 and any value above 0 is valid as long as the
+ value of ora_drcp_min + ora_drcp_incr is not greater than ora_drcp_max.
+
+ This value can also be specified with the "ORA_DRCP_INCR" environment
+ variable.
+
+ ora_taf
+ This attribute was removed in 1.49_00 as it was redundant. To enable TAF
+ simply set "ora_taf_function".
+
+ ora_taf_function
+ If your Oracle instance has been configured to use TAF events you can
+ enable the TAF callback by setting this option.
+
+ The name of the Perl subroutine (or a code ref from 1.49_00) that will
+ be called from OCI when a TAF event occurs. You must supply a perl
+ function to use the callback and it will always receive at least two
+ parameters; the failover event value and the failover type. From 1.49_00
+ the dbh is passed as the third argument. Below is an example of a TAF
+ function
+
+ sub taf_event{
+ # NOTE from 1.49_00 the $dbh handle is passed to the callback
+ my ($event, $type, $dbh) = @_;
+
+ print "My TAF event=$event\n";
+ print "My TAF type=$type\n";
+ return;
+ }
+
+ Note if passing a sub name you will probably have to use the full name
+ space when setting the TAF function e.g., 'main::my_taf_function' and
+ not just 'my_taf_function'.
+
+ ora_taf_sleep
+ This attribute was removed in 1.49_00 as it was redundant. If you want
+ to sleep between retries simple add a sleep to your callback sub.
+
+ ora_session_mode
+ The ora_session_mode attribute can be used to connect with SYSDBA,
+ SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG
+ authorization. The ORA_SYSDBA, ORA_SYSOPER, ORA_SYSASM, ORA_SYSBACKUP,
+ ORA_SYSKM and ORA_SYSDG constants can be imported using
+
+ use DBD::Oracle qw(:ora_session_modes);
+
+ This is one case where setting ORACLE_SID may be useful since connecting
+ as SYSDBA or SYSOPER via SQL*Net is frequently disabled for security
+ reasons.
+
+ Example:
+
+ $dsn = "dbi:Oracle:"; # no dbname here
+ $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed
+ delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set
+
+ $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA });
+
+ It has been reported that this only works if $dsn does not contain a SID
+ so that Oracle then uses the value of ORACLE_SID (not TWO_TASK)
+ environment variable to connect to a local instance. Also the username
+ and password should be empty, and the user executing the script needs to
+ be part of the dba group or osdba group.
+
+ ora_oratab_orahome
+ Passing a true value for the ora_oratab_orahome attribute will make
+ DBD::Oracle change $ENV{ORACLE_HOME} to make the Oracle home directory
+ that specified in the "/etc/oratab" file *if* the database to connect to
+ is specified as a SID that exists in the oratab file, and DBD::Oracle
+ was built to use the Oracle 7 OCI API (not Oracle 8+).
+
+ ora_module_name
+ After connecting to the database the value of this attribute is passed
+ to the SET_MODULE() function in the "DBMS_APPLICATION_INFO" PL/SQL
+ package. This can be used to identify the application to the DBA for
+ monitoring and performance tuning purposes. For example:
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 });
+
+ $dbh->{ora_module_name} = $y;
+
+ The maximum size is 48 bytes.
+
+ NOTE: You will need an Oracle client 10.1 or later to use this.
+
+ ora_driver_name
+ For 11g and later you can now set the name of the driver layer using
+ OCI. Perl, Perl5, ApachePerl so on. Names starting with "ORA" are
+ reserved. You can enter up to 8 characters. If none is enter then this
+ will default to DBDOxxxx where xxxx is the current version number. This
+ value can be retrieved on the server side using V$SESSION_CONNECT_INFO
+ or GV$SESSION_CONNECT_INFO
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' });
+
+ $dbh->{ora_driver_name} = $q;
+
+ ora_client_info
+ Allows you to add any value (up to 64 bytes) to your session and it can
+ be retrieved on the server side from the "V$SESSION"a view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' });
+
+ $dbh->{ora_client_info} = "Remote2";
+
+ NOTE: You will need an Oracle client 10.1 or later to use this.
+
+ ora_client_identifier
+ Allows you to specify the user identifier in the session handle.
+
+ Most useful for web applications as it can pass in the session user name
+ which might be different to the connection user name. Can be up to 64
+ bytes long but do not to include the password for security reasons and
+ the first character of the identifier should not be ':'. This value can
+ be retrieved on the server side using "V$SESSION" view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user });
+
+ $dbh->{ora_client_identifier} = $local_user;
+
+ ora_action
+ Allows you to specify any string up to 32 bytes which may be retrieved
+ on the server side using "V$SESSION" view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"});
+
+ $dbh->{ora_action} = "New Long Query 22";
+
+ NOTE: You will need an Oracle client 10.1 or later to use this.
+
+ ora_dbh_share
+ Requires at least Perl 5.8.0 compiled with ithreads.
+
+ Allows you to share database connections between threads. The first
+ connect will make the connection, all following calls to connect with
+ the same ora_dbh_share attribute will use the same database connection.
+ The value must be a reference to a already shared scalar which is
+ initialized to an empty string.
+
+ our $orashr : shared = '' ;
+
+ $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ;
+
+ ora_envhp
+ The first time a connection is made a new OCI 'environment' is created
+ by DBD::Oracle and stored in the driver handle. Subsequent connects
+ reuse (share) that same OCI environment by default.
+
+ The ora_envhp attribute can be used to disable the reuse of the OCI
+ environment from a previous connect. If the value is 0 then a new OCI
+ environment is allocated and used for this connection.
+
+ The OCI environment holds information about the client side context,
+ such as the local NLS environment. By altering %ENV and setting
+ ora_envhp to 0 you can create connections with different NLS settings.
+ This is most useful for testing.
+
+ ora_charset, ora_ncharset
+ For oracle versions >= 9.2 you can specify the client charset and
+ ncharset with the ora_charset and ora_ncharset attributes. You still
+ need to pass "ora_envhp = 0" for all but the first connect.
+
+ These attributes override the settings from environment variables.
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_charset => 'AL32UTF8'});
+
+ ora_verbose
+ Use this value to enable DBD::Oracle only tracing. Simply either set the
+ ora_verbose attribute on the connect() method to the trace level you
+ desire like this
+
+ my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6});
+
+ or set it directly on the DB handle like this;
+
+ $dbh->{ora_verbose} =6;
+
+ In both cases the DBD::Oracle trace level is set to 6, which is the
+ highest level tracing most of the calls to OCI.
+
+ NOTE: In future versions of DBD::Oracle ora_verbose will be changed so
+ that it is simply a switch to turn DBI's DBD tracing on or off. A true
+ value will turn it on and a false value will turn it off. DBI's "DBD"
+ tracing was not available when ora_verbose was created and ora_verbose
+ adds an additional test to every trace test.
+
+ ora_oci_success_warn
+ Use this value to print otherwise silent OCI warnings that may happen
+ when an execute or fetch returns "Success With Info" or when you want to
+ tune RowCaching and LOB Reads
+
+ $dbh->{ora_oci_success_warn} = 1;
+
+ ora_objects
+ Use this value to enable extended embedded oracle objects mode. In
+ extended:
+
+ 1 Embedded objects are returned as <DBD::Oracle::Object> instance
+ (including type-name etc.) instead of simple ARRAY.
+
+ 2 Determine object type for each instance. All object attributes are
+ returned (not only super-type's attributes).
+
+ $dbh->{ora_objects} = 1;
+
+ ora_ph_type
+ The default placeholder datatype for the database session. The "TYPE" or
+ "ora_type" attributes to "bind_param" in DBI and "bind_param_inout" in
+ DBI override the datatype for individual placeholders. The most frequent
+ reason for using this attribute is to permit trailing spaces in values
+ passed by placeholders.
+
+ Constants for the values allowed for this attribute can be imported
+ using
+
+ use DBD::Oracle qw(:ora_types);
+
+ Only the following values are permitted for this attribute.
+
+ ORA_VARCHAR2
+ Oracle clients using OCI 8 will strip trailing spaces and allow
+ embedded \0 bytes. Oracle clients using OCI 9.2 do not strip
+ trailing spaces and allow embedded \0 bytes. This is the normal
+ default placeholder type.
+
+ ORA_STRING
+ Do not strip trailing spaces and end the string at the first \0.
+
+ ORA_CHAR
+ Do not strip trailing spaces and allow embedded \0. Force
+ 'blank-padded comparison semantics'.
+
+ For example:
+
+ use DBD::Oracle qw(:ora_types);
+
+ $SQL="select username from all_users where username = ?";
+ #username is a char(8)
+ $sth=$dbh->prepare($SQL)";
+ $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR});
+
+ Will pad bloggs out to 8 characters and return the username.
+
+ ora_parse_error_offset
+ If the previous error was from a failed "prepare" due to a syntax error,
+ this attribute gives the offset into the "Statement" attribute where the
+ error was found.
+
+ ora_array_chunk_size
+ Due to OCI limitations, DBD::Oracle needs to buffer up rows of bind
+ values in its "execute_for_fetch" implementation. This attribute sets
+ the number of rows to buffer at a time (default value is 1000).
+
+ The "execute_for_fetch" function will collect (at most) this many rows
+ in an array, send them off to the DB for execution, then go back to
+ collect the next chunk of rows and so on. This attribute can be used to
+ limit or extend the number of rows processed at a time.
+
+ Note that this attribute also applies to "execute_array", since that
+ method is implemented using "execute_for_fetch".
+
+ ora_connect_with_default_signals
+ Sometimes the Oracle client seems to change some of the signal handlers
+ of the process during the connect phase. For instance, some users have
+ observed Perl's default $SIG{INT} handler being ignored after connecting
+ to an Oracle database. If this causes problems in your application, set
+ this attribute to an array reference of signals you would like to be
+ localized during the connect process. Once the connect is complete, the
+ signal handlers should be returned to their previous state.
+
+ For example:
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => [ 'INT' ] });
+
+ NOTE disabling the signal handlers the OCI library sets up may affect
+ functionality in the OCI library.
+
+ NOTE If you are using connect_cached then the above example will lead to
+ DBI thinking each connection is different as an anonymous array
+ reference is being used. To avoid this when using connect_cached you are
+ advised to use:
+
+ my @ora_default_signals = (...);
+ $dbh = DBI->connect($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => \@ora_default_signals});
+
+ In more recent Perl versions you could possibly make use of new state
+ variables.
+
+ connect_cached
+ Implemented by DBI, no driver-specific impact. Please note that
+ connect_cached as not been tested with DRCP.
+
+ data_sources
+ @data_sources = DBI->data_sources('Oracle');
+ @data_sources = $dbh->data_sources();
+
+ Returns a list of available databases. You will have to set either the
+ 'ORACLE_HOME' or 'TNS_ADMIN' environment value to retrieve this list. It
+ will read these values from TNSNAMES.ORA file entries.
+
+METHODS COMMON TO ALL HANDLES
+ For all of the methods below, $h can be either a database handle ($dbh)
+ or a statement handle ($sth). Note that *$dbh* and *$sth* can be
+ replaced with any variable name you choose: these are just the names
+ most often used. Another common variable used in this documentation is
+ $*rv*, which stands for "return value".
+
+ err
+ $rv = $h->err;
+
+ Returns the error code from the last method called.
+
+ errstr
+ $str = $h->errstr;
+
+ Returns the last error that was reported by Oracle. Starting with
+ "ORA-00000" code followed by the error message.
+
+ state
+ $str = $h->state;
+
+ Oracle hasn't supported SQLSTATE since the early versions OCI. It will
+ return empty when the command succeeds and 'S1000' (General Error) for
+ all other errors.
+
+ While this method can be called as either "$sth->state" or
+ "$dbh->state", it is usually clearer to always use "$dbh->state".
+
+ trace
+ Implemented by DBI, no driver-specific impact.
+
+ trace_msg
+ Implemented by DBI, no driver-specific impact.
+
+ parse_trace_flag and parse_trace_flags
+ Implemented by DBI, no driver-specific impact.
+
+ func
+ DBD::Oracle uses the "func" method to support a variety of functions.
+
+ Private database handle functions
+ Some of these functions are called through the method func() which is
+ described in the DBI documentation. Any function that begins with ora_
+ can be called directly.
+
+ plsql_errstr
+ This function returns a string which describes the errors from the most
+ recent PL/SQL function, procedure, package, or package body compile in a
+ format similar to the output of the SQL*Plus command 'show errors'.
+
+ The function returns undef if the error string could not be retrieved
+ due to a database error. Look in $dbh->errstr for the cause of the
+ failure.
+
+ If there are no compile errors, an empty string is returned.
+
+ Example:
+
+ # Show the errors if CREATE PROCEDURE fails
+ $dbh->{RaiseError} = 0;
+ if ( $dbh->do( q{
+ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as
+ BEGIN
+ PROCEDURE filltab( stuff OUT TAB ); asdf
+ END; } ) ) {} # Statement succeeded
+ }
+ elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure
+ else {
+ my $msg = $dbh->func( 'plsql_errstr' );
+ die $dbh->errstr if ! defined $msg;
+ die $msg if $msg;
+ }
+
+ dbms_output_enable / dbms_output_put / dbms_output_get
+ These functions use the PL/SQL DBMS_OUTPUT package to store and retrieve
+ text using the DBMS_OUTPUT buffer. Text stored in this buffer by
+ dbms_output_put or any PL/SQL block can be retrieved by dbms_output_get
+ or any PL/SQL block connected to the same database session.
+
+ Stored text is not available until after dbms_output_put or the PL/SQL
+ block that saved it completes its execution. This means you CAN NOT use
+ these functions to monitor long running PL/SQL procedures.
+
+ Example 1:
+
+ # Enable DBMS_OUTPUT and set the buffer size
+ $dbh->{RaiseError} = 1;
+ $dbh->func( 1000000, 'dbms_output_enable' );
+
+ # Put text in the buffer . . .
+ $dbh->func( @text, 'dbms_output_put' );
+
+ # . . . and retrieve it later
+ @text = $dbh->func( 'dbms_output_get' );
+
+ Example 2:
+
+ $dbh->{RaiseError} = 1;
+ $sth = $dbh->prepare(q{
+ DECLARE tmp VARCHAR2(50);
+ BEGIN
+ SELECT SYSDATE INTO tmp FROM DUAL;
+ dbms_output.put_line('The date is '||tmp);
+ END;
+ });
+ $sth->execute;
+
+ # retrieve the string
+ $date_string = $dbh->func( 'dbms_output_get' );
+
+ dbms_output_enable ( [ buffer_size ] )
+ This function calls DBMS_OUTPUT.ENABLE to enable calls to package
+ DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to these
+ procedures are ignored unless DBMS_OUTPUT.ENABLE is called first.
+
+ The buffer_size is the maximum amount of text that can be saved in the
+ buffer and must be between 2000 and 1,000,000. If buffer_size is not
+ given, the default is 20,000 bytes.
+
+ dbms_output_put ( [ @lines ] )
+ This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer.
+
+ If all lines were saved successfully the function returns 1. Depending
+ on the context, an empty list or undef is returned for failure.
+
+ If any line causes buffer_size to be exceeded, a buffer overflow error
+ is raised and the function call fails. Some of the text might be in the
+ buffer.
+
+ dbms_output_get
+ This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from
+ the buffer.
+
+ In an array context, all complete lines are removed from the buffer and
+ returned as a list. If there are no complete lines, an empty list is
+ returned.
+
+ In a scalar context, the first complete line is removed from the buffer
+ and returned. If there are no complete lines, undef is returned.
+
+ Any text in the buffer after a call to DBMS_OUTPUT.GET_LINE or
+ DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE,
+ DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE.
+
+ reauthenticate ( $username, $password )
+ Starts a new session against the current database using the credentials
+ supplied.
+
+ private_attribute_info
+ $hashref = $dbh->private_attribute_info();
+ $hashref = $sth->private_attribute_info();
+
+ Returns a hash of all private attributes used by DBD::Oracle, for either
+ a database or a statement handle. Currently, all the hash values are
+ undef.
+
+ATTRIBUTES COMMON TO ALL HANDLES
+ InactiveDestroy (boolean)
+ Implemented by DBI, no driver-specific impact.
+
+ RaiseError (boolean, inherited)
+ Forces errors to always raise an exception. Although it defaults to off,
+ it is recommended that this be turned on, as the alternative is to check
+ the return value of every method (prepare, execute, fetch, etc.)
+ manually, which is easy to forget to do.
+
+ PrintError (boolean, inherited)
+ Forces database errors to also generate warnings, which can then be
+ filtered with methods such as locally redefining *$SIG{__WARN__}* or
+ using modules such as "CGI::Carp". This attribute is on by default.
+
+ ShowErrorStatement (boolean, inherited)
+ Appends information about the current statement to error messages. If
+ placeholder information is available, adds that as well. Defaults to
+ true.
+
+ Warn (boolean, inherited)
+ Enables warnings. This is on by default, and should only be turned off
+ in a local block for a short a time only when absolutely needed.
+
+ Executed (boolean, read-only)
+ Indicates if a handle has been executed. For database handles, this
+ value is true after the "do" method has been called, or when one of the
+ child statement handles has issued an "execute". Issuing a "commit" or
+ "rollback" always resets the attribute to false for database handles.
+ For statement handles, any call to "execute" or its variants will flip
+ the value to true for the lifetime of the statement handle.
+
+ TraceLevel (integer, inherited)
+ Sets the trace level, similar to the "trace" method. See the sections on
+ "trace" and "parse_trace_flag" for more details.
+
+ Active (boolean, read-only)
+ Indicates if a handle is active or not. For database handles, this
+ indicates if the database has been disconnected or not. For statement
+ handles, it indicates if all the data has been fetched yet or not. Use
+ of this attribute is not encouraged.
+
+ Kids (integer, read-only)
+ Returns the number of child processes created for each handle type. For
+ a driver handle, indicates the number of database handles created. For a
+ database handle, indicates the number of statement handles created. For
+ statement handles, it always returns zero, because statement handles do
+ not create kids.
+
+ ActiveKids (integer, read-only)
+ Same as "Kids", but only returns those that are active.
+
+ CachedKids (hash ref)
+ Returns a hashref of handles. If called on a database handle, returns
+ all statement handles created by use of the "prepare_cached" method. If
+ called on a driver handle, returns all database handles created by the
+ "connect_cached" method.
+
+ ChildHandles (array ref)
+ Implemented by DBI, no driver-specific impact.
+
+ PrintWarn (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ HandleError (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ HandleSetErr (code ref, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ ErrCount (unsigned integer)
+ Implemented by DBI, no driver-specific impact.
+
+ FetchHashKeyName (string, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ ChopBlanks (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ Taint (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ TaintIn (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ TaintOut (boolean, inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ Profile (inherited)
+ Implemented by DBI, no driver-specific impact.
+
+ Type (scalar)
+ Returns "dr" for a driver handle, "db" for a database handle, and "st"
+ for a statement handle. Should be rarely needed.
+
+ LongReadLen
+ The maximum size of long or longraw columns to retrieve. If one of these
+ columns is longer than LongReadLen then either a data truncation error
+ will be raised (LongTrunkOk is false) or the column will be silently
+ truncated (LongTruncOk is true).
+
+ DBI currently defaults this to 80.
+
+ LongTruncOk
+ Implemented by DBI, no driver-specific impact.
+
+ CompatMode
+ Type: boolean, inherited
+
+ The 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.
+
+ORACLE-SPECIFIC DATABASE HANDLE METHODS
+ ora_can_unicode ( [ $refresh ] )
+ Returns a number indicating whether either of the database character
+ sets is a Unicode encoding. Calls ora_nls_parameters() and passes the
+ optional $refresh parameter to it.
+
+ 0 = Neither character set is a Unicode encoding.
+
+ 1 = National character set is a Unicode encoding.
+
+ 2 = Database character set is a Unicode encoding.
+
+ 3 = Both character sets are Unicode encodings.
+
+ ora_can_taf
+ Returns true if the current connection supports TAF events. False if
+ otherwise.
+
+ ora_nls_parameters ( [ $refresh ] )
+ Returns a hash reference containing the current NLS parameters, as given
+ by the v$nls_parameters view. The values fetched are cached between
+ calls. To cause the latest values to be fetched, pass a true value to
+ the function.
+
+ORACLE-SPECIFIC DATABASE FUNCTIONS
+ ora_server_version
+ $versions = $dbh->func('ora_server_version');
+
+ Returns an array reference of server version strings e.g.,
+
+ [11,2,0,2,0]
+
+DATABASE HANDLE METHODS
+ selectall_arrayref
+ $ary_ref = $dbh->selectall_arrayref($sql);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values);
+
+ Returns a reference to an array containing the rows returned by
+ preparing and executing the SQL string. See the DBI documentation for
+ full details.
+
+ selectall_hashref
+ $hash_ref = $dbh->selectall_hashref($sql, $key_field);
+
+ Returns a reference to a hash containing the rows returned by preparing
+ and executing the SQL string. See the DBI documentation for full
+ details.
+
+ selectcol_arrayref
+ $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values);
+
+ Returns a reference to an array containing the first column from each
+ rows returned by preparing and executing the SQL string. It is possible
+ to specify exactly which columns to return. See the DBI documentation
+ for full details.
+
+ prepare
+ $sth = $dbh->prepare($statement, \%attr);
+
+ Prepares a statement for later execution by the database engine and
+ returns a reference to a statement handle object.
+
+ Prepare Attributes
+ These attributes may be used in the "\%attr" parameter of the "prepare"
+ in DBI database handle method.
+
+ ora_placeholders
+ Set to false to disable processing of placeholders. Used mainly for
+ loading a PL/SQL package that has been *wrapped* with Oracle's
+ "wrap" utility.
+
+ ora_auto_lob
+ If true (the default), fetching retrieves the contents of the CLOB
+ or BLOB column in most circumstances. If false, fetching retrieves
+ the Oracle "LOB Locator" of the CLOB or BLOB value.
+
+ See "LOBS AND LONGS" for more details.
+
+ See also the LOB tests in 05dbi.t of Oracle::OCI for examples of how
+ to use LOB Locators.
+
+ ora_pers_lob
+ If true the "Simple Fetch for CLOBs and BLOBs" method for the "Data
+ Interface for Persistent LOBs" will be used for LOBs rather than the
+ default method "Data Interface for LOB Locators".
+
+ ora_clbk_lob
+ If true the "Piecewise Fetch with Callback" method for the "Data
+ Interface for Persistent LOBs" will be used for LOBs.
+
+ ora_piece_lob
+ If true the "Piecewise Fetch with Polling" method for the "Data
+ Interface for Persistent LOBs" will be used for LOBs.
+
+ ora_piece_size
+ This is the max piece size for the "Piecewise Fetch with Callback"
+ and "Piecewise Fetch with Polling" methods, in chars for CLOBS, and
+ bytes for BLOBS.
+
+ ora_check_sql
+ If 1 (default), force SELECT statements to be described in
+ prepare(). If 0, allow SELECT statements to defer describe until
+ execute().
+
+ See "Prepare Postponed Till Execute" for more information.
+
+ ora_exe_mode
+ This will set the execute mode of the current statement. Presently
+ only one mode is supported;
+
+ OCI_STMT_SCROLLABLE_READONLY - make result set scrollable
+
+ See "SCROLLABLE CURSORS" for more details.
+
+ ora_prefetch_rows
+ Sets the number of rows to be prefetched. If it is not set, then the
+ default value is 1. See "Row Prefetching" for more details.
+
+ ora_prefetch_memory
+ Sets the memory level for rows to be prefetched. The application
+ then fetches as many rows as will fit into that much memory. See
+ "Row Prefetching" for more details.
+
+ ora_row_cache_off
+ By default DBD::Oracle will use a row cache when fetching to cut
+ down the number of round trips to the server. If you do not want to
+ use an array fetch set this value to any value other than 0;
+
+ See "Row Prefetching" for more details.
+
+ Placeholders
+ There are three types of placeholders that can be used in DBD::Oracle.
+
+ The first is the "question mark" type, in which each placeholder is
+ represented by a single question mark character. This is the method
+ recommended by the DBI and is the most portable. Each question mark is
+ internally replaced by a "dollar sign number" in the order in which they
+ appear in the query (important when using "bind_param").
+
+ The second type of placeholder is "named parameters" in the format
+ ":foo" which is the one Oracle prefers.
+
+ $dbh->{RaiseError} = 1; # save having to check each method call
+ $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name");
+ $sth->bind_param(':name', "John%");
+ $sth->execute;
+ DBI::dump_results($sth);
+
+ Note when calling bind_param with named parameters you must include the
+ leading colon. The advantage of this placeholder type is that you can
+ use the same placeholder more than once in the same SQL statement but
+ you only need to bind it once.
+
+ The last placeholder type is a variation of the two above where you name
+ each placeholder :N (where N is a number). Like the named placeholders
+ above you can use the same placeholder multiple times in the SQL but
+ when you call bind_param you only need to pass the N (e.g., for :1 you
+ use bind_param(1,...) and not bind_param(':1',...).
+
+ The different types of placeholders cannot be mixed within a statement,
+ but you may use different ones for each statement handle you have. This
+ is confusing at best, so stick to one style within your program.
+
+ prepare_cached
+ $sth = $dbh->prepare_cached($statement, \%attr);
+
+ Implemented by DBI, no driver-specific impact. This method is most
+ useful if the same query is used over and over as it will cut down round
+ trips to the server.
+
+ do
+ $rv = $dbh->do($statement);
+ $rv = $dbh->do($statement, \%attr);
+ $rv = $dbh->do($statement, \%attr, @bind_values);
+
+ Prepare and execute a single statement. Returns the number of rows
+ affected if the query was successful, returns undef if an error
+ occurred, and returns -1 if the number of rows is unknown or not
+ available. Note that this method will return 0E0 instead of 0 for 'no
+ rows were affected', in order to always return a true value if no error
+ occurred.
+
+ last_insert_id
+ Oracle does not implement auto_increment of serial type columns it uses
+ predefined sequences where the id numbers are either selected before
+ insert, at insert time with a trigger, or as part of the query.
+
+ Below is an example of you to use the latter with the SQL returning
+ clause to get the ID number back on insert with the bind_param_inout
+ method. .
+
+ $dbh->do('CREATE SEQUENCE lii_seq START 1');
+ $dbh->do(q{CREATE TABLE lii (
+ foobar INTEGER NOT NULL UNIQUE,
+ baz VARCHAR)});
+ $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";";
+ $sth = $dbh->prepare($SQL);
+ my $p_new_id='-1';
+ $sth->bind_param_inout(":p_new_id",\$p_new_id,38);
+ $sth->execute();
+ $db->commit();
+
+ commit
+ $rv = $dbh->commit;
+
+ Issues a COMMIT to the server, indicating that the current transaction
+ is finished and that all changes made will be visible to other
+ processes. If AutoCommit is enabled, then a warning is given and no
+ COMMIT is issued. Returns true on success, false on error.
+
+ rollback
+ $rv = $dbh->rollback;
+
+ Issues a ROLLBACK to the server, which discards any changes made in the
+ current transaction. If AutoCommit is enabled, then a warning is given
+ and no ROLLBACK is issued. Returns true on success, and false on error.
+
+ begin_work
+ This method turns on transactions until the next call to "commit" or
+ "rollback", if "AutoCommit" is currently enabled. If it is not enabled,
+ calling begin_work will issue an error. Note that the transaction will
+ not actually begin until the first statement after begin_work is called.
+
+ disconnect
+ $rv = $dbh->disconnect;
+
+ Disconnects from the Oracle database. Any uncommitted changes will be
+ rolled back upon disconnection. It's good policy to always explicitly
+ call commit or rollback at some point before disconnecting, rather than
+ relying on the default rollback behavior.
+
+ If the script exits before disconnect is called (or, more precisely, if
+ the database handle is no longer referenced by anything), then the
+ database handle's DESTROY method will call the rollback() and
+ disconnect() methods automatically. It is best to explicitly disconnect
+ rather than rely on this behavior.
+
+ ping
+ $rv = $dbh->ping;
+
+ This "ping" method is used to check the validity of a database handle.
+ The value returned is either 0, indicating that the connection is no
+ longer valid, or 1, indicating the connection is valid. This function
+ does 1 round trip to the Oracle Server.
+
+ get_info()
+ $value = $dbh->get_info($info_type);
+
+ DBD::Oracle supports "get_info()", but (currently) only a few info
+ types.
+
+ table_info()
+ DBD::Oracle supports attributes for "table_info()".
+
+ In Oracle, the concept of *user* and *schema* is (currently) the same.
+ Because database objects are owned by an user, the owner names in the
+ data dictionary views correspond to schema names. Oracle does not
+ support catalogues so TABLE_CAT is ignored as selection criterion.
+
+ Search patterns are supported for TABLE_SCHEM and TABLE_NAME.
+
+ TABLE_TYPE may contain a comma-separated list of table types. The
+ following table types are supported:
+
+ TABLE
+ VIEW
+ SYNONYM
+ SEQUENCE
+
+ The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME.
+
+ The special enumerations of catalogues, schemas and table types are
+ supported. However, TABLE_CAT is always NULL.
+
+ An identifier is passed *as is*, i.e. as the user provides or Oracle
+ returns it. "table_info()" performs a case-sensitive search. So, a
+ selection criterion should respect upper and lower case. Normally, an
+ identifier is case-insensitive. Oracle stores and returns it in upper
+ case. Sometimes, database objects are created with quoted identifiers
+ (for reserved words, mixed case, special characters, ...). Such an
+ identifier is case-sensitive (if not all upper case). Oracle stores and
+ returns it as given. "table_info()" has no special quote handling,
+ neither adds nor removes quotes.
+
+ primary_key_info()
+ Oracle does not support catalogues so TABLE_CAT is ignored as selection
+ criterion. The TABLE_CAT field of a fetched row is always NULL (undef).
+ See "table_info()" for more detailed information.
+
+ If the primary key constraint was created without an identifier, PK_NAME
+ contains a system generated name with the form SYS_Cn.
+
+ The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ.
+
+ An identifier is passed *as is*, i.e. as the user provides or Oracle
+ returns it. See "table_info()" for more detailed information.
+
+ foreign_key_info()
+ This method (currently) supports the extended behaviour of SQL/CLI, i.e.
+ the result set contains foreign keys that refer to primary and alternate
+ keys. The field UNIQUE_OR_PRIMARY distinguishes these keys.
+
+ Oracle does not support catalogues, so $pk_catalog and $fk_catalog are
+ ignored as selection criteria (in the new style interface). The
+ UK_TABLE_CAT and FK_TABLE_CAT fields of a fetched row are always NULL
+ (undef). See "table_info()" for more detailed information.
+
+ If the primary or foreign key constraints were created without an
+ identifier, UK_NAME or FK_NAME contains a system generated name with the
+ form SYS_Cn.
+
+ The UPDATE_RULE field is always 3 ('NO ACTION'), because Oracle
+ (currently) does not support other actions.
+
+ The DELETE_RULE field may contain wrong values. This is a known Bug
+ (#1271663) in Oracle's data dictionary views. Currently (as of 8.1.7),
+ 'RESTRICT' and 'SET DEFAULT' are not supported, 'CASCADE' is mapped
+ correctly and all other actions (incl. 'SET NULL') appear as 'NO
+ ACTION'.
+
+ The DEFERABILITY field is always NULL, because this columns is not
+ present in the ALL_CONSTRAINTS view of older Oracle releases.
+
+ The result set is ordered by UK_TABLE_SCHEM, UK_TABLE_NAME,
+ FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION.
+
+ An identifier is passed *as is*, i.e. as the user provides or Oracle
+ returns it. See "table_info()" for more detailed information.
+
+ column_info()
+ Oracle does not support catalogues so TABLE_CAT is ignored as selection
+ criterion. The TABLE_CAT field of a fetched row is always NULL (undef).
+ See "table_info()" for more detailed information.
+
+ The CHAR_OCTET_LENGTH field is (currently) always NULL (undef).
+
+ Don't rely on the values of the BUFFER_LENGTH field! Especially the
+ length of FLOATs may be wrong.
+
+ Datatype codes for non-standard types are subject to change.
+
+ Attention! The DATA_DEFAULT (COLUMN_DEF) column is of type LONG so you
+ may have to set LongReadLen on the connection handle before calling
+ column_info if you have a large default column. After DBD::Oracle 1.40
+ LongReadLen is set automatically to 1Mb when calling column_info and
+ reset aftwerwards.
+
+ The result set is ordered by TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION.
+
+ An identifier is passed *as is*, i.e. as the user provides or Oracle
+ returns it. See "table_info()" for more detailed information.
+
+ It is possible with Oracle to make the names of the various DB objects
+ (table,column,index etc) case sensitive.
+
+ alter table bloggind add ("Bla_BLA" NUMBER)
+
+ So in the example the exact case "Bla_BLA" must be used to get it info
+ on the column. While this
+
+ alter table bloggind add (Bla_BLA NUMBER)
+
+ any case can be used to get info on the column.
+
+ statistics_info()
+ Oracle does not support catalogues so TABLE_CAT is ignored as selection
+ criterion. The TABLE_CAT field of a fetched row is always NULL (undef).
+ See "table_info()" for more detailed information.
+
+ The INDEX_QUALIFIER field of a fetched row is always NULL (undef), for
+ the same reason as for TABLE_CAT.
+
+ If an index was created without an identifier (e.g. in the course of a
+ PK creation), INDEX_NAME contains a system generated name with the form
+ SYS_.
+
+ COLUMN_NAME may contain a system generated name (e.g. for function-based
+ indexes).
+
+ For the TYPE column, a simple mapping is used:
+
+ NORMAL btree
+ CLUSTER clustered
+ ... other
+
+ The $quick parameter is currently ignored. The method uses the
+ dictionary with the gathered statistics, thus cannot ensure that the
+ values for CARDINALITY and PAGES are current.
+
+ The result set is ordered by NON_UNIQUE, TYPE, INDEX_QUALIFIER,
+ INDEX_NAME, ORDINAL_POSITION.
+
+ An identifier is passed *as is*, i.e. as the user provides or Oracle
+ returns it. See "table_info()" for more detailed information.
+
+ selectrow_array
+ @row_ary = $dbh->selectrow_array($sql);
+ @row_ary = $dbh->selectrow_array($sql, \%attr);
+ @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values);
+
+ Returns an array of row information after preparing and executing the
+ provided SQL string. The rows are returned by calling "fetchrow_array".
+ The string can also be a statement handle generated by a previous
+ prepare. Note that only the first row of data is returned. If called in
+ a scalar context, only the first column of the first row is returned.
+ Because this is not portable, it is not recommended that you use this
+ method in that way.
+
+ selectrow_arrayref
+ $ary_ref = $dbh->selectrow_arrayref($statement);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
+
+ Exactly the same as "selectrow_array", except that it returns a
+ reference to an array, by internal use of the "fetchrow_arrayref"
+ method.
+
+ selectrow_hashref
+ $hash_ref = $dbh->selectrow_hashref($sql);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values);
+
+ Exactly the same as "selectrow_array", except that it returns a
+ reference to an hash, by internal use of the "fetchrow_hashref" method.
+
+ clone
+ $other_dbh = $dbh->clone();
+
+ Creates a copy of the database handle by connecting with the same
+ parameters as the original handle, then trying to merge the attributes.
+ See the DBI documentation for complete usage.
+
+DATABASE HANDLE ATTRIBUTES
+ AutoCommit (boolean)
+ Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is
+ on, but this may change in the future, so it is highly recommended that
+ you explicitly set it when calling "connect".
+
+ ReadOnly (boolean)
+ $dbh->{ReadOnly} = 1;
+
+ Specifies if the current database connection should be in read-only mode
+ or not.
+
+ Please not that this method is not foolproof: there are still ways to
+ update the database. Consider this a safety net to catch applications
+ that should not be issuing commands such as INSERT, UPDATE, or DELETE.
+
+ This method method requires DBI version 1.55 or better.
+
+ Name (string, read-only)
+ Returns the name of the current database. This is the same as the DSN,
+ without the "dbi:Oracle:" part.
+
+ Username (string, read-only)
+ Returns the name of the user connected to the database.
+
+ Driver (handle, read-only)
+ 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}
+
+ RowCacheSize
+ DBD::Oracle supports both Server pre-fetch and Client side row caching.
+ By default both are turned on to give optimum performance. Most of the
+ time one can just let DBD::Oracle figure out the best optimization.
+
+ Row Caching
+ Row caching occurs on the client side and the object of it is to cut
+ down the number of round trips made to the server when fetching rows. At
+ each fetch a set number of rows will be retrieved from the server and
+ stored locally. Further calls the server are made only when the end of
+ the local buffer(cache) is reached.
+
+ Rows up to the specified top level row count "RowCacheSize" are fetched
+ if it occupies no more than the specified memory usage limit. The
+ default value is 0, which means that memory size is not included in
+ computing the number of rows to prefetch. If the "RowCacheSize" value is
+ set to a negative number then the positive value of RowCacheSize is used
+ to compute the number of rows to prefetch.
+
+ By default "RowCacheSize" is automatically set. If you want to totally
+ turn off prefetching set this to 1.
+
+ For any SQL statement that contains a LOB, Long or Object Type Row
+ Caching will be turned off. However server side caching still works. If
+ you are only selecting a LOB Locator then Row Caching will still work.
+
+ Row Prefetching
+ Row prefetching occurs on the server side and uses the DBI database
+ handle attribute "RowCacheSize" and or the Prepare Attribute
+ 'ora_prefetch_memory'. Tweaking these values may yield improved
+ performance.
+
+ $dbh->{RowCacheSize} = 100;
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000});
+
+ In the above example 10 rows will be prefetched up to a maximum of 10000
+ bytes of data. The Oracle Call Interface Programmer's Guide, suggests a
+ good row cache value for a scrollable cursor is about 20% of expected
+ size of the record set.
+
+ The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes)
+ when it needs to get new rows. This happens on the first fetch that sets
+ the current_positon to any value other than 0. In the above example if
+ we do a OCI_FETCH_FIRST the first 10 rows are loaded into the buffer and
+ DBD::Oracle will not have to go back to the server for more rows. When
+ record 11 is fetched DBD::Oracle fetches and returns this row and the
+ next 9 rows are loaded into the buffer. In this case if you fetch
+ backwards from 10 to 1 no server round trips are made.
+
+ With large record sets it is best not to attempt to go to the last
+ record as this may take some time, A large buffer size might even slow
+ down the fetch. If you must get the number of rows in a large record set
+ you might try using an few large OCI_FETCH_ABSOLUTEs and then an
+ OCI_FETCH_LAST, this might save some time. So if you had a record set of
+ 10000 rows and you set the buffer to 5000 and did a OCI_FETCH_LAST one
+ would fetch the first 5000 rows into the buffer then the next 5000 rows.
+ If one requires only the first few rows there is no need to set a large
+ prefetch value.
+
+ If the ora_prefetch_memory less than 1 or not present then memory size
+ is not included in computing the number of rows to prefetch otherwise
+ the number of rows will be limited to memory size. Likewise if the
+ RowCacheSize is less than 1 it is not included in the computing of the
+ prefetch rows.
+
+ORACLE-SPECIFIC STATEMENT HANDLE METHODS
+ ora_stmt_type
+ Returns the OCI Statement Type number for the SQL of a statement handle.
+
+ ora_stmt_type_name
+ Returns the OCI Statement Type name for the SQL of a statement handle.
+
+DBI STATEMENT HANDLE OBJECT METHODS
+ bind_param
+ $rv = $sth->bind_param($param_num, $bind_value);
+ $rv = $sth->bind_param($param_num, $bind_value, $bind_type);
+ $rv = $sth->bind_param($param_num, $bind_value, \%attr);
+
+ Allows the user to bind a value and/or a data type to a placeholder.
+
+ The value of $param_num is a number if using the '?' or if using ":foo"
+ style placeholders, the complete name (e.g. ":foo") must be given. The
+ $bind_value argument is fairly self-explanatory. A value of "undef" will
+ bind a "NULL" to the placeholder. Using "undef" is useful when you want
+ to change just the type and will be overwriting the value later. (Any
+ value is actually usable, but "undef" is easy and efficient).
+
+ The "\%attr" hash is used to indicate the data type of the placeholder.
+ The default value is "varchar". If you need something else, you must use
+ one of the values provided by DBI or by DBD::Pg. To use a SQL value,
+ modify your "use DBI" statement at the top of your script as follows:
+
+ use DBI qw(:sql_types);
+
+ This will import some constants into your script. You can plug those
+ directly into the "bind_param" call. Some common ones that you will
+ encounter are:
+
+ SQL_INTEGER
+
+ To use Oracle SQL data types, import the list of values like this:
+
+ use DBD::Pg qw(:ora_types);
+
+ You can then set the data types by setting the value of the "ora_type"
+ key in the hash passed to "bind_param". The current list of Oracle data
+ types exported is:
+
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
+
+ Data types are "sticky," in that once a data type is set to a certain
+ placeholder, it will remain for that placeholder, unless it is
+ explicitly set to something else afterwards. If the statement has
+ already been prepared, and you switch the data type to something else,
+ DBD::Oracle will re-prepare the statement for you before doing the next
+ execute.
+
+ Examples:
+
+ use DBI qw(:sql_types);
+ use DBD::Pg qw(:ora_types);
+
+ $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?";
+ $sth = $dbh->prepare($SQL);
+
+ ## Both arguments below are bound to placeholders as "varchar"
+ $sth->execute(123, "Merk");
+
+ ## Reset the datatype for the first placeholder to an integer
+ $sth->bind_param(1, undef, SQL_INTEGER);
+
+ ## The "undef" bound above is not used, since we supply params to execute
+ $sth->execute(123, "Merk");
+
+ ## Set the first placeholder's value and data type
+ $sth->bind_param(1, 234, { pg_type => ORA_NUMBER });
+
+ ## Set the second placeholder's value and data type.
+ ## We don't send a third argument, so the default "varchar" is used
+ $sth->bind_param('$2', "Zool");
+
+ ## We realize that the wrong data type was set above, so we change it:
+ $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER });
+
+ ## We also got the wrong value, so we change that as well.
+ ## Because the data type is sticky, we don't need to change it
+ $sth->bind_param(1, 567);
+
+ ## This executes the statement with 567 (integer) and "Zool" (varchar)
+ $sth->execute();
+
+ These attributes may be used in the "\%attr" parameter of the
+ "bind_param" in DBI or "bind_param_inout" in DBI statement handle
+ methods.
+
+ ora_type
+ Specify the placeholder's datatype using an Oracle datatype. A fatal
+ error is raised if "ora_type" and the DBI "TYPE" attribute are used
+ for the same placeholder. Some of these types are not supported by
+ the current version of DBD::Oracle and will cause a fatal error if
+ used. Constants for the Oracle datatypes may be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+ Potentially useful values when DBD::Oracle was built using OCI 7 and
+ later:
+
+ ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW,
+ ORA_CHAR, ORA_MLSLABEL, ORA_RSET
+
+ Additional values when DBD::Oracle was built using OCI 8 and later:
+
+ ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE
+
+ Additional values when DBD::Oracle was built using OCI 9.2 and
+ later:
+
+ SQLT_CHR, SQLT_BIN
+
+ See "Binding Cursors" for the correct way to use ORA_RSET.
+
+ See "LOBS AND LONGS" for how to use ORA_CLOB and ORA_BLOB.
+
+ See "SYS.DBMS_SQL datatypes" for ORA_VARCHAR2_TABLE,
+ ORA_NUMBER_TABLE.
+
+ See "Data Interface for Persistent LOBs" for the correct way to use
+ SQLT_CHR and SQLT_BIN.
+
+ See "OTHER DATA TYPES" for more information.
+
+ See also "Placeholders and Bind Values" in DBI.
+
+ ora_csform
+ Specify the OCI_ATTR_CHARSET_FORM for the bind value. Valid values
+ are SQLCS_IMPLICIT (1) and SQLCS_NCHAR (2). Both those constants can
+ be imported from the DBD::Oracle module. Rarely needed.
+
+ ora_csid
+ Specify the *integer* OCI_ATTR_CHARSET_ID for the bind value.
+ Character set names can't be used currently.
+
+ ora_maxdata_size
+ Specify the integer OCI_ATTR_MAXDATA_SIZE for the bind value. May be
+ needed if a character set conversion from client to server causes
+ the data to use more space and so fail with a truncation error.
+
+ ora_maxarray_numentries
+ Specify the maximum number of array entries to allocate. Used with
+ ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. Define the maximum number of
+ array entries Oracle can pass back to you in OUT variable of type
+ TABLE OF ... .
+
+ ora_internal_type
+ Specify internal data representation. Currently is supported only
+ for ORA_NUMBER_TABLE.
+
+ Optimizing Results
+ Prepare Postponed Till Execute
+ The DBD::Oracle module can avoid an explicit 'describe' operation prior
+ to the execution of the statement unless the application requests
+ information about the results (such as $sth->{NAME}). This reduces
+ communication with the server and increases performance (reducing the
+ number of PARSE_CALLS inside the server).
+
+ However, it also means that SQL errors are not detected until
+ "execute()" (or $sth->{NAME} etc) is called instead of when "prepare()"
+ is called. Note that if the describe is triggered by the use of
+ $sth->{NAME} or a similar attribute and the describe fails then *an
+ exception is thrown* even if "RaiseError" is false!
+
+ Set "ora_check_sql" to 0 in prepare() to enable this behaviour.
+
+ bind_param_inout
+ $rv = $sth->bind_param_inout($param_num, \$scalar, 0);
+
+ DBD::Oracle fully supports bind_param_inout below are some uses for this
+ method.
+
+ Returning A Value from an INSERT
+ Oracle supports an extended SQL insert syntax which will return one or
+ more of the values inserted. This can be particularly useful for
+ single-pass insertion of values with re-used sequence values (avoiding a
+ separate "select seq.nextval from dual" step).
+
+ $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, :bar)
+ RETURNING id INTO :id
+ });
+ $sth->bind_param(":bar", 42);
+ $sth->bind_param_inout(":id", \my $new_id, 99);
+ $sth->execute;
+ print "The id of the new record is $new_id\n";
+
+ If you have many columns to bind you can use code like this:
+
+ @params = (... column values for record to be inserted ...);
+ $sth->bind_param($_, $params[$_-1]) for (1..@params);
+ $sth->bind_param_inout(@params+1, \my $new_id, 99);
+ $sth->execute;
+
+ If you have many rows to insert you can take advantage of Oracle's built
+ in execute array feature with code like this:
+
+ my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10');
+ my @out_values;
+ my @status;
+ my $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, ?)
+ RETURNING id INTO ?
+ });
+ $sth->bind_param_array(1,\@in_values);
+ $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2});
+ $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting";
+ foreach my $id (@out_values){
+ print 'returned id='.$id.'\n';
+ }
+
+ Which will return all the ids into @out_values.
+
+ Note:
+ This will only work for numbered (?) placeholders,
+ The third parameter of bind_param_inout_array, (0 in the example),
+ "maxlen" is required by DBI but not used by DBD::Oracle
+ The "ora_type" attribute is not needed but only ORA_VARCHAR2 will work.
+
+ Returning A Recordset
+ DBD::Oracle does not currently support binding a PL/SQL table (aka
+ array) as an IN OUT parameter to any Perl data structure. You cannot
+ therefore call a PL/SQL function or procedure from DBI that uses a
+ non-atomic datatype as either a parameter, or a return value. However,
+ if you are using Oracle 9.0.1 or later, you can make use of table (or
+ pipelined) functions.
+
+ For example, assume you have the existing PL/SQL Package :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ --
+ l_Ret taRec ;
+ --
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+ --
+ END Array_Example ;
+ /
+
+ Currently, there is no way to directly call the function
+ Array_Example.Array_Func from DBI. However, by making the following
+ relatively painless additions, its not only possible, but extremely
+ efficient.
+
+ First, you need to create database object types that correspond to the
+ record and table types in the package. From the above example, these
+ would be :
+
+ CREATE OR REPLACE TYPE tArray_Example__taRec
+ AS OBJECT (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE
+ ) ;
+
+ CREATE OR REPLACE TYPE taArray_Example__taRec
+ AS TABLE OF tArray_Example__taRec ;
+
+ Now, assuming the existing function needs to remain unchanged (it is
+ probably being called from other PL/SQL code), we need to add a new
+ function to the package. Here's the new package specification and body :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ l_Ret taRec ;
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS
+ l_Set taRec ;
+ BEGIN
+ l_Set := Array_Func ;
+ FOR i IN l_Set.FIRST .. l_Set.LAST LOOP
+ PIPE ROW (
+ tArray_Example__taRec (
+ l_Set (i).Col1,
+ l_Set (i).Col2,
+ l_Set (i).Col3
+ )
+ ) ;
+ END LOOP ;
+ RETURN ;
+ END ;
+ --
+ END Array_Example ;
+
+ As you can see, the new function is very simple. Now, it is a simple
+ matter of calling the function as a straight-forward SELECT from your
+ DBI code. From the above example, the code would look something like
+ this :
+
+ my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)');
+ $sth->execute;
+ while ( my ($col1, $col2, $col3) = $sth->fetchrow_array {
+ ...
+ }
+
+ SYS.DBMS_SQL datatypes
+ DBD::Oracle has built-in support for SYS.DBMS_SQL.VARCHAR2_TABLE and
+ SYS.DBMS_SQL.NUMBER_TABLE datatypes. The simple example is here:
+
+ my $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl.count();
+ tbl(1) := \'def\';
+ tbl(2) := \'ijk\';
+ :mytable := tbl;
+ END;
+ ';
+
+ my $sth=$dbh->prepare( $statement );
+
+ my @arr=( "abc","efg","hij" );
+
+ $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_VARCHAR2_TABLE,
+ ora_maxarray_numentries => 100
+ } ) ;
+ $sth->bind_param_inout(":cc", \$cc, 100 );
+ $sth->execute();
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+ Note:
+ Take careful note that we use '\\@arr' here because the
+ 'bind_param_inout' will only take a reference to a scalar.
+
+ ORA_VARCHAR2_TABLE
+ SYS.DBMS_SQL.VARCHAR2_TABLE object is always bound to array reference. (
+ in bind_param() and bind_param_inout() ). When you bind array, you need
+ to specify full buffer size for OUT data. So, there are two parameters:
+ *max_len* (specified as 3rd argument of bind_param_inout() ), and
+ *ora_maxarray_numentries*. They define maximum array entry length and
+ maximum rows, that can be passed to Oracle and back to you. In this
+ example we send array with 1 element with length=3, but allocate space
+ for 100 Oracle array entries with maximum length 10 of each. So, you can
+ get no more than 100 array entries with length <= 10.
+
+ If you set *max_len* to zero, maximum array entry length is calculated
+ as maximum length of entry of array bound. If 0 < *max_len* < length(
+ $some_element ), truncation occur.
+
+ If you set *ora_maxarray_numentries* to zero, current (at bind time)
+ bound array length is used as maximum. If 0 < *ora_maxarray_numentries*
+ < scalar(@array), not all array entries are bound.
+
+ ORA_NUMBER_TABLE
+ SYS.DBMS_SQL.NUMBER_TABLE object handling is much alike
+ ORA_VARCHAR2_TABLE. The main difference is internal data representation.
+ Currently 2 types of bind is allowed : as C-integer, or as C-double
+ type. To select one of them, you may specify additional bind parameter
+ *ora_internal_type* as either SQLT_INT or SQLT_FLT for C-integer and
+ C-double types. Integer size is architecture-specific and is usually 32
+ or 64 bit. Double is standard IEEE 754 type.
+
+ *ora_internal_type* defaults to double (SQLT_FLT).
+
+ *max_len* is ignored for OCI_NUMBER_TABLE.
+
+ Currently, you cannot bind full native Oracle NUMBER(38). If you really
+ need, send request to dbi-dev list.
+
+ The usage example is here:
+
+ $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.NUMBER_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl(2);
+ tbl(4) := -1;
+ tbl(5) := -2;
+ :mytable := tbl;
+ END;
+ ';
+
+ $sth=$dbh->prepare( $statement );
+
+ if( ! defined($sth) ){
+ die "Prepare error: ",$dbh->errstr,"\n";
+ }
+
+ @arr=( 1,"2E0","3.5" );
+
+ # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE .
+ if( not $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_NUMBER_TABLE,
+ ora_maxarray_numentries => (scalar(@arr)+2),
+ ora_internal_type => SQLT_FLT
+ } ) ){
+ die "bind :mytable error: ",$dbh->errstr,"\n";
+ }
+ $cc=undef;
+ if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
+ die "bind :cc error: ",$dbh->errstr,"\n";
+ }
+
+ if( not $sth->execute() ){
+ die "Execute failed: ",$dbh->errstr,"\n";
+ }
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+ The result is like:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ '1',
+ '2',
+ '3.5',
+ '-1',
+ '-2'
+ ];
+
+ If you change bind type to SQLT_INT, like:
+
+ ora_internal_type => SQLT_INT
+
+ you get:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ 1,
+ 2,
+ 3,
+ -1,
+ -2
+ ];
+
+ bind_param_inout_array
+ DBD::Oracle supports this undocumented feature of DBI. See "Returning A
+ Value from an INSERT" for an example.
+
+ bind_param_array
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr)
+
+ Binds an array of values to a placeholder, so that each is used in turn
+ by a call to the "execute_array" method.
+
+ execute
+ $rv = $sth->execute(@bind_values);
+
+ Perform whatever processing is necessary to execute the prepared
+ statement.
+
+ execute_array
+ $tuples = $sth->execute_array() or die $sth->errstr;
+ $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 a prepared statement once for each item in a passed-in hashref,
+ or items that were previously bound via the "bind_param_array" method.
+ See the DBI documentation for more details.
+
+ DBD::Oracle takes full advantage of OCI's array interface so inserts and
+ updates using this interface will run very quickly.
+
+ 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);
+
+ Used internally by the "execute_array" method, and rarely used directly.
+ See the DBI documentation for more details.
+
+ fetchrow_arrayref
+ $ary_ref = $sth->fetchrow_arrayref;
+
+ Fetches the next row of data from the statement handle, and returns a
+ reference to an array holding the column values. Any columns that are
+ NULL are returned as undef within the array.
+
+ If there are no more rows or if an error occurs, the this method return
+ undef. You should check "$sth->err" afterwards (or use the "RaiseError"
+ attribute) to discover if the 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 "bind_columns".
+
+ fetchrow_array
+ @ary = $sth->fetchrow_array;
+
+ Similar to the "fetchrow_arrayref" method, but returns a list of column
+ information rather than a reference to a list. Do not use this in a
+ scalar context.
+
+ fetchrow_hashref
+ $hash_ref = $sth->fetchrow_hashref;
+ $hash_ref = $sth->fetchrow_hashref($name);
+
+ Fetches the next row of data and returns a hashref containing the name
+ of the columns as the keys and the data itself as the values. Any NULL
+ value is returned as undef value.
+
+ If there are no more rows or if an error occurs, the this method return
+ undef. You should check "$sth->err" afterwards (or use the "RaiseError"
+ attribute) to discover if the undef returned was due to an error.
+
+ The optional $name argument should be either "NAME", "NAME_lc" or
+ "NAME_uc", and indicates what sort of transformation to make to the keys
+ in the hash. By default Oracle uses upper case.
+
+ fetchall_arrayref
+ $tbl_ary_ref = $sth->fetchall_arrayref();
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice );
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
+
+ Returns a reference to an array of arrays that contains all the
+ remaining rows to be fetched from the statement handle. If there are no
+ more rows, an empty arrayref will be returned. If an error occurs, the
+ data read in so far will be returned. Because of this, you should always
+ check "$sth->err" after calling this method, unless "RaiseError" has
+ been enabled.
+
+ If $slice is an array reference, fetchall_arrayref uses the
+ "fetchrow_arrayref" method 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, fetchall_arrayref acts as
+ if passed an empty array ref.
+
+ If $slice is a hash reference, fetchall_arrayref uses "fetchrow_hashref"
+ to fetch each row as a hash reference.
+
+ See the DBI documentation for a complete discussion.
+
+ fetchall_hashref
+ $hash_ref = $sth->fetchall_hashref( $key_field );
+
+ Returns a hashref containing all rows to be fetched from the statement
+ handle. See the DBI documentation for a full discussion.
+
+ finish
+ $rv = $sth->finish;
+
+ Indicates to DBI that you are finished with the statement handle and are
+ not going to use it again. Only needed when you have not fetched all the
+ possible rows.
+
+ rows
+ $rv = $sth->rows;
+
+ Returns the number of rows affected for updates, deletes and inserts and
+ -1 for selects.
+
+ bind_col
+ $rv = $sth->bind_col($column_number, \$var_to_bind);
+ $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr );
+ $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
+
+ Binds a Perl variable and/or some attributes to an output column of a
+ SELECT statement. Column numbers count up from 1. You do not need to
+ bind output columns in order to fetch data.
+
+ NOTE: DBD::Oracle does not use the $bind_type to determine how to bind
+ the column; it uses what Oracle says the data type is. You can however
+ set the StrictlyTyped/DiscardString attributes and these will take
+ effect as these attributes are applied after the column is retrieved.
+
+ See the DBI documentation for a discussion of the optional parameters
+ "\%attr" and $bind_type
+
+ bind_columns
+ $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
+
+ Calls the "bind_col" method for each column in the SELECT statement,
+ using the supplied list.
+
+ dump_results
+ $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
+
+ Fetches all the rows from the statement handle, calls "DBI::neat_list"
+ for each row, and prints the results to $fh (which defaults to STDOUT).
+ Rows are separated by $lsep (which defaults to a newline). Columns are
+ separated by $fsep (which defaults to a comma). The $maxlen controls how
+ wide the output can be, and defaults to 35.
+
+ This method is designed as a handy utility for prototyping and testing
+ queries. Since it uses "neat_list" to format and edit the string for
+ reading by humans, it is not recommended for data transfer applications.
+
+STATEMENT HANDLE ATTRIBUTES
+ NUM_OF_FIELDS (integer, read-only)
+ Returns the number of columns returned by the current statement. A
+ number will only be returned for SELECT statements for INSERT, UPDATE,
+ and DELETE statements which contain a RETURNING clause. This method
+ returns undef if called before "execute()".
+
+ NUM_OF_PARAMS (integer, read-only)
+ Returns the number of placeholders in the current statement.
+
+ NAME (arrayref, read-only)
+ Returns an arrayref of column names for the current statement. This
+ method will only work for SELECT statements, for SHOW statements, and
+ for INSERT, UPDATE, and DELETE statements which contain a RETURNING
+ clause. This method returns undef if called before "execute()".
+
+ NAME_lc (arrayref, read-only)
+ The same as the "NAME" attribute, except that all column names are
+ forced to lower case.
+
+ NAME_uc (arrayref, read-only)
+ The same as the "NAME" attribute, except that all column names are
+ forced to upper case.
+
+ NAME_hash (hashref, read-only)
+ Similar to the "NAME" attribute, but returns a hashref of column names
+ instead of an arrayref. The names of the columns are the keys of the
+ hash, and the values represent the order in which the columns are
+ returned, starting at 0. This method returns undef if called before
+ "execute()".
+
+ NAME_lc_hash (hashref, read-only)
+ The same as the "NAME_hash" attribute, except that all column names are
+ forced to lower case.
+
+ NAME_uc_hash (hashref, read-only)
+ The same as the "NAME_hash" attribute, except that all column names are
+ forced to lower case.
+
+ TYPE (arrayref, read-only)
+ Returns an arrayref indicating the data type for each column in the
+ statement. This method returns undef if called before "execute()".
+
+ PRECISION (arrayref, read-only)
+ Returns an arrayref of integer values for each column returned by the
+ statement. The number indicates the precision for "NUMERIC" columns, the
+ size in number of characters for "CHAR" and "VARCHAR" columns, and for
+ all other types of columns it returns the number of *bytes*. This method
+ returns undef if called before "execute()".
+
+ SCALE (arrayref, read-only)
+ Returns an arrayref of integer values for each column returned by the
+ statement. The number indicates the scale of the that column. The only
+ type that will return a value is "NUMERIC". This method returns undef if
+ called before "execute()".
+
+ NULLABLE (arrayref, read-only)
+ Returns an arrayref of integer values for each column returned by the
+ statement. The number indicates if the column is nullable or not. 0 =
+ not nullable, 1 = nullable, 2 = unknown. This method returns undef if
+ called before "execute()".
+
+ Database (dbh, read-only)
+ Returns the database handle this statement handle was created from.
+
+ ParamValues (hash ref, read-only)
+ Returns a reference to a hash containing the values currently bound to
+ placeholders. If the "named parameters" type of placeholders are being
+ used (such as ":foo"), then the keys of the hash will be the names of
+ the placeholders (without the colon). If the "dollar sign numbers" type
+ of placeholders are being used, the keys of the hash will be the
+ numbers, without the dollar signs. If the "question mark" type is used,
+ integer numbers will be returned, starting at one and increasing for
+ every placeholder.
+
+ If this method is called before "execute", the literal values passed in
+ are returned. If called after "execute", then the quoted versions of the
+ values are returned.
+
+ ParamTypes (hash ref, read-only)
+ Returns a reference to a hash containing the type names currently bound
+ to placeholders. The keys are the same as returned by the ParamValues
+ method. The values are hashrefs containing a single key value pair, in
+ which the key is either 'TYPE' if the type has a generic SQL equivalent,
+ and 'pg_type' if the type can only be expressed by a Postgres type. The
+ value is the internal number corresponding to the type originally passed
+ in. (Placeholders that have not yet been bound will return undef as the
+ value). This allows the output of ParamTypes to be passed back to the
+ "bind_param" method.
+
+ Statement (string, read-only)
+ Returns the statement string passed to the most recent "prepare" method
+ called in this database handle, even if that method failed. This is
+ especially useful where "RaiseError" is enabled and the exception
+ handler checks $@ and sees that a "prepare" method call failed.
+
+ RowsInCache
+ Returns the number of un-fetched rows in the cache for selects.
+
+SCROLLABLE CURSORS
+ Oracle supports the concept of a 'Scrollable Cursor' which is defined as
+ a 'Result Set' where the rows can be fetched either sequentially or
+ non-sequentially. One can fetch rows forward, backwards, from any given
+ position or the n-th row from the current position in the result set.
+
+ Rows are numbered sequentially starting at one and client-side caching
+ of the partial or entire result set can improve performance by limiting
+ round trips to the server.
+
+ Oracle does not support DML type operations with scrollable cursors so
+ you are limited to simple 'Select' operations only. As well you can not
+ use this functionality with remote mapped queries or if the LONG
+ datatype is part of the select list.
+
+ However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind,
+ and fetch methods.
+
+ Only use scrollable cursors if you really have a good reason to. They do
+ use up considerable more server and client resources and have poorer
+ response times than non-scrolling cursors.
+
+ Enabling Scrollable Cursors
+ To enable this functionality you must first import the 'Fetch
+ Orientation' and the 'Execution Mode' constants by using;
+
+ use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes);
+
+ Next you will have to tell DBD::Oracle that you will be using scrolling
+ by setting the ora_exe_mode attribute on the statement handle to
+ 'OCI_STMT_SCROLLABLE_READONLY' with the prepare method;
+
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+
+ When the statement is executed you will then be able to use
+ 'ora_fetch_scroll' method to get a row or you can still use any of the
+ other fetch methods but with a poorer response time than if you used a
+ non-scrolling cursor. As well scrollable cursors are compatible with any
+ applicable bind methods.
+
+ Scrollable Cursor Methods
+ The following driver-specific methods are used with scrollable cursors.
+
+ ora_scroll_position
+ $position = $sth->ora_scroll_position();
+
+ This method returns the current position (row number) attribute of
+ the result set. Prior to the first fetch this value is 0. This is
+ the only time this value will be 0 after the first fetch the value
+ will be set, so you can use this value to test if any rows have been
+ fetched. The minimum value will always be 1 after the first fetch.
+ The maximum value will always be the total number of rows in the
+ record set.
+
+ ora_fetch_scroll
+ $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset);
+
+ Works the same as "fetchrow_arrayref", excepts one passes in a
+ 'Fetch Orientation' constant and a fetch_offset value which will
+ then determine the row that will be fetched. It returns the row as a
+ list containing the field values. Null fields are returned as
+ *undef* values in the list.
+
+ The valid orientation constant and fetch offset values combination
+ are detailed below
+
+ OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored.
+ OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value
+ is ignored.
+ OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored.
+ OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored.
+ OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset
+ value is ignored.
+
+ OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the
+ fetch offset value.
+
+ OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR.
+
+ The effect that a ora_fetch_scroll method call has on the
+ current_positon attribute is detailed below.
+
+ OCI_FETCH_CURRENT, has no effect on the current_positon attribute.
+ OCI_FETCH_NEXT, increments current_positon attribute by 1
+ OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT
+ OCI_FETCH_FIRST, sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the
+ record set.
+ OCI_FETCH_PRIOR, decrements current_positon attribute by 1.
+ OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change
+ current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in
+ the record set, does not change current_positon attribute, it is
+ equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute +
+ fetch offset value).
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1,
+ does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records
+ in the record set, does not change fetch offset value so it is equivalent
+ to a OCI_FETCH_CURRENT.
+
+ The effects of the differing orientation constants on the first
+ fetch (current_postion attribute at 0) are as follows.
+
+ OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute.
+ OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon
+ attribute to the total number of rows in the record set.
+ OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a
+ OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of
+ records in the record set is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent
+ to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number
+ of records in the record set, is equivalent to a OCI_FETCH_CURRENT.
+
+ Scrollable Cursor Usage
+ Given a simple code like this:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes);
+ my $dbh = DBI->connect($dsn, $dbuser, '');
+ my $SQL = "select id,
+ first_name,
+ last_name
+ from employee";
+ my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+ $sth->execute();
+ my $value;
+
+ and one assumes that the number of rows returned from the query is 20,
+ the code snippets below will illustrate the use of ora_fetch_scroll
+ method;
+
+ Fetching the Last Row
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute to will be 20 after this snippet. This
+ is also a way to get the number of rows in the record set, however,
+ if the record set is large this could take some time.
+
+ Fetching the Current Row
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will still be 20 after this snippet.
+
+ Fetching the First Row
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 1 after this snippet.
+
+ Fetching the Next Row
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 5 after this snippet.
+
+ Fetching the Prior Row
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 1 after this snippet.
+
+ Fetching the 10th Row
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 10 after this snippet.
+
+ Fetching the 10th to 14th Row
+ for(my $i=10;$i<15;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 14 after this snippet.
+
+ Fetching the 14th to 10th Row
+ for(my $i=14;$i>9;$i--){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 10 after this snippet.
+
+ Fetching the 5th Row From the Present Position.
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 15 after this snippet.
+
+ Fetching the 9th Row Prior From the Present Position
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current_positon attribute will be 6 after this snippet.
+
+ Use Finish
+ $sth->finish();
+
+ When using scrollable cursors it is required that you use the
+ $sth->finish() method when you are done with the cursor as this type
+ of cursor has to be explicitly cancelled on the server. If you do
+ not do this you may cause resource problems on your database.
+
+LOBS AND LONGS
+ The key to working with LOBs (CLOB, BLOBs) is to remember the value of
+ an Oracle LOB column is not the content of the LOB. It's a 'LOB Locator'
+ which, after being selected or inserted needs extra processing to read
+ or write the content of the LOB. There are also legacy LONG types (LONG,
+ LONG RAW, VARCHAR2) which are presently deprecated by Oracle but are
+ still in use. These LONG types do not utilize a 'LOB Locator' and also
+ are more limited in functionality than CLOB or BLOB fields.
+
+ DBD::Oracle now offers three interfaces to LOB and LONG data,
+
+ "Data Interface for Persistent LOBs"
+ With this interface DBD::Oracle handles your data directly utilizing
+ regular OCI calls, Oracle itself takes care of the LOB Locator
+ operations in the case of BLOBs and CLOBs treating them exactly as
+ if they were the same as the legacy LONG or LONG RAW types.
+
+ "Data Interface for LOB Locators"
+ With this interface DBD::Oracle handles your data utilizing LOB
+ Locator OCI calls so it only works with CLOB and BLOB datatypes.
+ With this interface DBD::Oracle takes care of the LOB Locator
+ operations for you.
+
+ "LOB Locator Method Interface"
+ This allows the user direct access to the LOB Locator methods, so
+ you have to take case of the LOB Locator operations yourself.
+
+ Generally speaking the interface that you will chose will be dependent
+ on what end you are trying to achieve. All have their benefits and
+ drawbacks.
+
+ One point to remember when working with LOBs (CLOBs, BLOBs) is if your
+ LOB column can be in one of three states;
+
+ NULL
+ The table cell is created, but the cell holds no locator or value.
+ If your LOB field is in this state then there is no LOB Locator that
+ DBD::Oracle can work so if your encounter a
+
+ DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr
+
+ error when working with a LOB.
+
+ You can correct this by using an SQL UPDATE statement to reset the
+ LOB column to a non-NULL (or empty LOB) value with either EMPTY_BLOB
+ or EMPTY_CLOB as in this example;
+
+ UPDATE lob_example
+ SET bindata=EMPTY_BLOB()
+ WHERE bindata IS NULL.
+
+ Empty
+ A LOB instance with a locator exists in the cell, but it has no
+ value. The length of the LOB is zero. In this case DBD::Oracle will
+ return 'undef' for the field.
+
+ Populated
+ A LOB instance with a locator and a value exists in the cell. You
+ actually get the LOB value.
+
+ Data Interface for Persistent LOBs
+ This is the original interface for LONG and LONG RAW datatypes and from
+ Oracle 9iR1 and later the OCI API was extended to work directly with the
+ other LOB datatypes. In other words you can treat all LOB type data
+ (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can
+ perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using
+ the same techniques you would use on other datatypes that store
+ character or binary data. In some cases there are fewer round trips to
+ the server as no 'LOB Locators' are used, normally one can get an entire
+ LOB is a single round trip.
+
+ Simple Fetch for LONGs and LONG RAWs
+ As the name implies this is the simplest way to use this interface.
+ DBD::Oracle just attempts to get your LONG datatypes as a single large
+ piece. There are no special settings, simply set the database handle's
+ 'LongReadLen' attribute to a value that will be the larger than the
+ expected size of the LONG or LONG RAW. If the size of the LONG or LONG
+ RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A
+ Truncation' error. To stop this set the database handle's 'LongTruncOk'
+ attribute to '1'. The maximum value of 'LongReadLen' seems to be
+ dependent on the physical memory limits of the box that Oracle is
+ running on. You have most likely reached this limit if you run into an
+ 'ORA-01062: unable to allocate memory for define buffer' error. One
+ solution is to set the size of 'LongReadLen' to a lower value.
+
+ For example give this table;
+
+ CREATE TABLE test_long (
+ id NUMBER,
+ long1 long)
+
+ this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+ Will select out all of the long1 fields in the table as long as they are
+ all under 2MB in length. A value in long1 longer than this will throw an
+ error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+ before the execute will return all the long1 fields but they will be
+ truncated at 2MBs.
+
+ Using ora_ncs_buff_mtpl
+ When getting CLOBs and NCLOBs in or out of Oracle, the Server will
+ translate from the Server's NCharSet to the Client's. If they happen to
+ be the same or at least compatible then all of these actions are a 1
+ char to 1 char bases. Thus if you set your LongReadLen buffer to
+ 10_000_000 you will get up to 10_000_000 char.
+
+ However if the Server has to translate from one NCharSet to another it
+ will use bytes for conversion. The buffer value is set to 4 *
+ LONG_READ_LEN which was very wasteful as you might only be asking for
+ 10_000_000 bytes but you were actually using 40_000_000 bytes of buffer
+ under the hood. You would still get 10_000_000 bytes (maybe less
+ characters though) but you are using allot more memory that you need.
+
+ You can now customize the size of the buffer by setting the
+ 'ora_ncs_buff_mtpl' either on the connection or statement handle. You
+ can also set this as 'ORA_DBD_NCS_BUFFER' OS environment variable so you
+ will have to go back and change all your code if you are getting into
+ trouble.
+
+ The default value is still set to 4 for backward compatibility. You can
+ lower this value and thus increase the amount of data you can retrieve.
+ If the ora_ncs_buff_mtpl is too small DBD::Oracle will throw and error
+ telling you to increase this buffer by one.
+
+ If the error is not captured then you may get at some random point later
+ on, usually at a finish() or disconnect() or even a fetch() this error;
+
+ ORA-03127: no new operations allowed until the active operation ends
+
+ This is one of the more obscure ORA errors (have some fun and report it
+ to Meta-Link they will scratch their heads for hours)
+
+ If you get this, simply increment the ora_ncs_buff_mtpl by one until it
+ goes away.
+
+ This should greatly increase your ability to select very large CLOBs or
+ NCLOBs, by freeing up a large block of memory.
+
+ You can tune this value by setting ora_oci_success_warn which will
+ display the following
+
+ OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen
+ 20(characters), BufLen 80(characters), Got 28(characters)
+
+ In the case above the query Got 28 characters (well really only 20
+ characters of 28 bytes) so we could use ora_ncs_buff_mtpl=>2 (20*2=40)
+ thus saving 40bytes of memory.
+
+ Simple Fetch for CLOBs and BLOBs
+ To use this interface for CLOBs and LOBs datatypes set the
+ 'ora_pers_lob' attribute of the statement handle to '1' with the prepare
+ method, as well set the database handle's 'LongReadLen' attribute to a
+ value that will be the larger than the expected size of the LOB. If the
+ size of the LOB exceeds the 'LongReadLen' DBD::Oracle will return a
+ 'ORA-24345: A Truncation' error. To stop this set the database handle's
+ 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems
+ to be dependent on the physical memory limits of the box that Oracle is
+ running on in the same way that LONGs and LONG RAWs are.
+
+ For CLOBs and NCLOBs the limit is 64k chars if there is no truncation,
+ this is an internal OCI limit complain to them if you want it changed.
+ However if you CLOB is longer than this and also larger than the
+ 'LongReadLen' than the 'LongReadLen' in chars is returned.
+
+ It seems with BLOBs you are not limited by the 64k.
+
+ For example give this table;
+
+ CREATE TABLE test_lob (id NUMBER,
+ clob1 CLOB,
+ clob2 CLOB,
+ blob1 BLOB,
+ blob2 BLOB)
+
+ this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+ Will select out all of the LOBs in the table as long as they are all
+ under 2MB in length. Longer lobs will throw an error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+ before the execute will return all the lobs but they will be truncated
+ at 2MBs.
+
+ Piecewise Fetch with Callback
+ With a piecewise callback fetch DBD::Oracle sets up a function that will
+ 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW,
+ CLOB, BLOB) piece by piece. To use this interface set the 'ora_clbk_lob'
+ attribute of the statement handle to '1' with the prepare method. Next
+ set the 'ora_piece_size' to the size of the piece that you want to
+ return on the callback. Finally set the database handle's 'LongReadLen'
+ attribute to a value that will be the larger than the expected size of
+ the LOB. Like the "Simple Fetch for LONGs and LONG RAWs" and "Simple
+ Fetch for CLOBs and BLOBs" the if the size of the LOB exceeds the is
+ 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the
+ LOB or set the 'LongReadLen' to a higher value. With this interface the
+ value of 'ora_piece_size' seems to be constrained by the same memory
+ limit as found on the Simple Fetch interface. If you encounter an
+ 'ORA-01062' error try setting the value of 'ora_piece_size' to a smaller
+ value. The value for 'LongReadLen' is dependent on the version and
+ settings of the Oracle DB you are using. In theory it ranges from 8GBs
+ in 9iR1 up to 128 terabytes with 11g but you will also be limited by the
+ physical memory of your PERL instance.
+
+ Using the table from the last example this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+ Will select out all of the LOBs in the table as long as they are all
+ under 20MB in length. If the LOB is longer than 5MB (ora_piece_size)
+ DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces
+ (4*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will
+ throw an error.
+
+ Using the table from the first example (LONG) this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+ Will select all of the long1 fields from table as long as they are is
+ under 20MB in length. If the long1 filed is longer than 5MB
+ (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+ maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields
+ longer than 20MB will throw an error.
+
+ Piecewise Fetch with Polling
+ With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB
+ during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by
+ piece. To use this interface set the 'ora_piece_lob' attribute of the
+ statement handle to '1' with the prepare method. Next set the
+ 'ora_piece_size' to the size of the piece that you want to return on the
+ callback. Finally set the database handle's 'LongReadLen' attribute to a
+ value that will be the larger than the expected size of the LOB. Like
+ the "Piecewise Fetch with Callback" and Simple Fetches if the size of
+ the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk'
+ attribute to truncate the LOB or set the 'LongReadLen' to a higher
+ value. With this interface the value of 'ora_piece_size' seems to be
+ constrained by the same memory limit as found on the "Piecewise Fetch
+ with Callback".
+
+ Using the table from the example above this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+ Will select out all of the LOBs in the table as long as they are all
+ under 20MB in length. If the LOB is longer than 5MB (ora_piece_size)
+ DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces
+ (4*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will
+ throw an error.
+
+ Finally with this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+ Will select all of the long1 fields from table as long as they are is
+ under 20MB in length. If the long1 field is longer than 5MB
+ (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+ maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields
+ longer than 20MB will throw an error.
+
+ Binding for Updates and Inserts for CLOBs and BLOBs
+ To bind for updates and inserts all that is required to use this
+ interface is to set the statement handle's prepare method 'ora_type'
+ attribute to 'SQLT_CHR' in the case of CLOBs and NCLOBs or 'SQLT_BIN' in
+ the case of BLOBs as in this example for an insert;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+ my $in_blob ="0101" for 1 .. 10_000;
+
+ $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)';
+ $sth=$dbh->prepare($SQL );
+ $sth->bind_param(1,3);
+ $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->execute();
+
+ So far the only limit reached with this form of insert is the LOBs must
+ be under 2GB in size.
+
+ Support for Remote LOBs;
+ Starting with Oracle 10gR2 the interface for Persistent LOBs was
+ expanded to support remote LOBs (access over a dblink). Given a database
+ called 'lob_test' that has a 'LINK' defined like this;
+
+ CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test';
+
+ to a remote database called 'test_lobs', the following code will work;
+
+ $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test');
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+ Below are the limitations of Remote LOBs;
+
+ Queries involving more than one database are not supported;
+ so the following returns an error:
+
+ SELECT t1.lobcol,
+ a2.lobcol
+ FROM t1,
+ t2.lobcol@dbs2 a2 W
+ WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol);
+
+ as does:
+
+ SELECT t1.lobcol
+ FROM t1@dbs1
+ UNION ALL
+ SELECT t2.lobcol
+ FROM t2@dbs2;
+
+ DDL commands are not supported;
+ so the following returns an error:
+
+ CREATE VIEW v AS SELECT lob_col FROM tab@dbs;
+
+ Only binds and defines for data going into remote persistent LOBs are
+ supported.
+ so that parameter passing in PL/SQL where CHAR data is bound or
+ defined for remote LOBs is not allowed .
+
+ These statements all produce errors:
+
+ SELECT foo() FROM table1@dbs2;
+
+ SELECT foo()@dbs INTO char_val FROM DUAL;
+
+ SELECT XMLType().getclobval FROM table1@dbs2;
+
+ If the remote object is a view such as
+ CREATE VIEW v AS SELECT foo() FROM ...
+
+ the following would not work:
+
+ SELECT * FROM v@dbs2;
+
+ Limited PL/SQL parameter passing
+ PL/SQL parameter passing is not allowed where the actual argument is
+ a LOB type and the remote argument is one of VARCHAR2, NVARCHAR2,
+ CHAR, NCHAR, or RAW.
+
+ RETURNING INTO does not support implicit conversions between CHAR and
+ CLOB.
+ so the following returns an error:
+
+ SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test
+
+ Locator Data Interface
+ Simple Usage
+ When fetching LOBs with this interface a 'LOB Locator' is created then
+ used to get the lob with the LongReadLen and LongTruncOk attributes. The
+ value for 'LongReadLen' is dependent on the version and settings of the
+ Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128
+ terabytes with 11g but you will also be limited by the physical memory
+ of your PERL instance.
+
+ When inserting or updating LOBs some *major* magic has to be performed
+ behind the scenes to make it transparent. Basically the driver has to
+ insert a 'LOB Locator' and then refetch the newly inserted LOB Locator
+ before being able to write the data into it. However, it works well most
+ of the time, and I've made it as fast as possible, just one extra
+ server-round-trip per insert or update after the first. For the time
+ being, only single-row LOB updates are supported.
+
+ To insert or update a large LOB using a placeholder, DBD::Oracle has to
+ know in advance that it is a LOB type. So you need to say:
+
+ $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB });
+
+ The ORA_CLOB and ORA_BLOB constants can be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+ or use the corresponding integer values (112 and 113).
+
+ One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has to
+ be able to tell which parameters relate to which table fields. In all
+ cases where it can possibly work it out for itself, it does, however, if
+ there are multiple LOB fields of the same type in the table then you
+ need to tell it which field each LOB param relates to:
+
+ $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' });
+
+ There are some limitations inherent in the way DBD::Oracle makes typical
+ LOB operations simple by hiding the LOB Locator processing:
+
+ - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL)
+ - To INSERT a LOB, you need UPDATE privilege.
+
+ The alternative is to disable the automatic LOB Locator processing. If
+ "ora_auto_lob" is 0 in prepare(), you can fetch the LOB Locators and do
+ all the work yourself using the ora_lob_*() methods. See the "Data
+ Interface for LOB Locators" section below.
+
+ LOB support in PL/SQL
+ LOB Locators can be passed to PL/SQL calls by binding them to
+ placeholders with the proper "ora_type". If "ora_auto_lob" is true,
+ output LOB parameters will be automatically returned as strings.
+
+ If the Oracle driver has support for temporary LOBs (Oracle 9i and
+ higher), strings can be bound to input LOB placeholders and will be
+ automatically converted to LOBs.
+
+ Example: # Build a large XML document, bind it as a CLOB, # extract
+ elements through PL/SQL and return as a CLOB
+
+ # $dbh is a connected database handle
+ # output will be large
+
+ local $dbh->{LongReadLen} = 1_000_000;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+
+ my $out_clob;
+
+
+ my $sth = $dbh->prepare(<<PLSQL_END);
+ -- extract 'value' nodes
+ DECLARE
+ x XMLTYPE := XMLTYPE(:in);
+ BEGIN
+ :out := x.extract('/document/value').getClobVal();
+ END;
+
+ PLSQL_END
+
+ # :in param will be converted to a temp lob
+ # :out parameter will be returned as a string.
+
+ $sth->bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } );
+ $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } );
+ $sth->execute;
+
+ If you ever get an
+
+ ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt
+
+ error, while attempting to insert a LOB, this means the Oracle user has
+ insufficient space for LOB you are trying to insert. One solution it to
+ use "alter database datafile 'sss.ggg' resize Mnnn" to increase the
+ available memory for LOBs.
+
+ Persistent & Locator Interface Caveats
+ Now that one has the option of using the Persistent or the Locator
+ interface for LOBs the questions arises which one to use. For starters,
+ if you want to access LOBs over a dblink you will have to use the
+ Persistent interface so that choice is simple. The question of which one
+ to use after that is a little more tricky. It basically boils down to a
+ choice between LOB size and speed.
+
+ The Callback and Polling piecewise fetches are very very slow when
+ compared to the Simple and the Locator fetches but they can handle very
+ large blocks of data. Given a situation where a large LOB is to be read
+ the Locator fetch may time out while either of the piecewise fetches may
+ not.
+
+ With the Simple fetch you are limited by physical memory of your server
+ but it runs a little faster than the Locator, as there are fewer round
+ trips to the server. So if you have small LOBs and need to save a little
+ bandwidth this is the one to use. It you are going after large LOBs then
+ the Locator interface is the one to use.
+
+ If you need to update more than a single row of with LOB data then the
+ Persistent interface can do it while the Locator can't.
+
+ If you encounter a situation where you have to access the legacy LOBs
+ (LONG, LONG RAW) and the values are to large for you system then you can
+ use the Callback or Polling piecewise fetches to get all of the data.
+
+ Not all of the Persistent interface has been implemented yet, the
+ following are not supported;
+
+ 1) Piecewise, polling and callback binds for INSERT and UPDATE operations.
+ 2) Piecewise array binds for SELECT, INSERT and UPDATE operations.
+
+ Most of the time you should just use the "Locator Data Interface" as
+ this is in one that has the best combination of speed and size.
+
+ All this being said if you are doing some critical programming I would
+ use the "Data Interface for LOB Locators" as this gives you very fine
+ grain control of your LOBs, of course the code for this will be somewhat
+ more involved.
+
+ Data Interface for LOB Locators
+ The following driver-specific methods let you manipulate "LOB Locators"
+ directly. To select a LOB locator directly set the if the "ora_auto_lob"
+ attribute to false, or alternatively they can be returned via PL/SQL
+ procedure calls.
+
+ (If using a DBI version earlier than 1.36 they must be called via the
+ func() method. Note that methods called via func() don't honour
+ RaiseError etc, and so it's important to check $dbh->err after each
+ call. It's recommended that you upgrade to DBI 1.38 or later.)
+
+ Note that LOB locators are only valid while the statement handle that
+ created them is valid. When all references to the original statement
+ handle are lost, the handle is destroyed and the locators are freed.
+
+ ora_lob_read
+ $data = $dbh->ora_lob_read($lob_locator, $offset, $length);
+
+ Read a portion of the LOB. $offset starts at 1. Uses the Oracle
+ OCILobRead function.
+
+ NOTE: DBD::Oracle post 1.46 will return undef for any read lob if
+ the length specified in the ora_lob_read is 0. See RT 55028. This
+ avoids the potential problem with empty lobs (created with
+ empty_clob) which return a length of 0 from ora_lob_length and prior
+ to 1.46 a call to ora_lob_read with a 0 length would segfault.
+
+ ora_lob_write
+ $rc = $dbh->ora_lob_write($lob_locator, $offset, $data);
+
+ Write/overwrite a portion of the LOB. $offset starts at 1. Uses the
+ Oracle OCILobWrite function.
+
+ ora_lob_append
+ $rc = $dbh->ora_lob_append($lob_locator, $data);
+
+ Append $data to the LOB. Uses the Oracle OCILobWriteAppend function.
+
+ ora_lob_trim
+ $rc = $dbh->ora_lob_trim($lob_locator, $length);
+
+ Trims the length of the LOB to $length. Uses the Oracle OCILobTrim
+ function.
+
+ ora_lob_length
+ $length = $dbh->ora_lob_length($lob_locator);
+
+ Returns the length of the LOB. Uses the Oracle OCILobGetLength
+ function.
+
+ ora_lob_is_init
+ $is_init = $dbh->ora_lob_is_init($lob_locator);
+
+ Returns true(1) if the Lob Locator is initialized false(0) if it is
+ not, or 'undef' if there is an error. Uses the Oracle
+ OCILobLocatorIsInit function.
+
+ ora_lob_chunk_size
+ $chunk_size = $dbh->ora_lob_chunk_size($lob_locator);
+
+ Returns the chunk size of the LOB. Uses the Oracle
+ OCILobGetChunkSize function.
+
+ For optimal performance, Oracle recommends reading from and writing
+ to a LOB in batches using a multiple of the LOB chunk size. In
+ Oracle 10g and before, when all defaults are in place, this chunk
+ size defaults to 8k (8192).
+
+ LOB Locator Method Examples
+ *Note:* Make sure you first read the note in the section above about
+ multi-byte character set issues with these methods.
+
+ The following examples demonstrate the usage of LOB Locators to read,
+ write, and append data, and to query the size of large data.
+
+ The following examples assume a table containing two large object
+ columns, one binary and one character, with a primary key column,
+ defined as follows:
+
+ CREATE TABLE lob_example (
+ lob_id INTEGER PRIMARY KEY,
+ bindata BLOB,
+ chardata CLOB
+ )
+
+ It also assumes a sequence for use in generating unique lob_id field
+ values, defined as follows:
+
+ CREATE SEQUENCE lob_example_seq
+
+ Example: Inserting a new row with large data
+ Unless enough memory is available to store and bind the entire LOB data
+ for insert all at once, the LOB columns must be written interactively,
+ piece by piece. In the case of a new row, this is performed by first
+ inserting a row, with empty values in the LOB columns, then modifying
+ the row by writing the large data interactively to the LOB columns using
+ their LOB locators as handles.
+
+ The insert statement must create token values in the LOB columns. Here,
+ we use the empty string for both the binary and character large object
+ columns 'bindata' and 'chardata'.
+
+ After the INSERT statement, a SELECT statement is used to acquire LOB
+ locators to the 'bindata' and 'chardata' fields of the newly inserted
+ row. Because these LOB locators are subsequently written, they must be
+ acquired from a select statement containing the clause 'FOR UPDATE' (LOB
+ locators are only valid within the transaction that fetched them, so
+ can't be used effectively if AutoCommit is enabled).
+
+ my $lob_id = $dbh->selectrow_array( <<" SQL" );
+ SELECT lob_example_seq.nextval FROM DUAL
+ SQL
+
+ my $sth = $dbh->prepare( <<" SQL" );
+ INSERT INTO lob_example
+ ( lob_id, bindata, chardata )
+ VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() )
+ SQL
+ $sth->execute( $lob_id );
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata, chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator, $char_locator ) = $sth->fetchrow_array();
+ $sth->finish();
+
+ open BIN_FH, "/binary/data/source" or die;
+ open CHAR_FH, "/character/data/source" or die;
+ my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator );
+
+ # BEGIN WRITING BIN_DATA COLUMN
+ my $offset = 1; # Offsets start at 1, not 0
+ my $length = 0;
+ my $buffer = '';
+ while( $length = read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $bin_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+ # BEGIN WRITING CHAR_DATA COLUMN
+ $chunk_size = $dbh->ora_lob_chunk_size( $char_locator );
+ $offset = 1; # Offsets start at 1, not 0
+ $length = 0;
+ $buffer = '';
+ while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $char_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+ In this example we demonstrate the use of ora_lob_write() interactively
+ to append data to the columns 'bin_data' and 'char_data'. Had we used
+ ora_lob_append(), we could have saved ourselves the trouble of keeping
+ track of the offset into the lobs. The snippet of code beneath the
+ comment 'BEGIN WRITING BIN_DATA COLUMN' could look as follows:
+
+ my $buffer = '';
+ while ( read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_append( $bin_locator, $buffer );
+ }
+
+ The scalar variables $offset and $length are no longer needed, because
+ ora_lob_append() keeps track of the offset for us.
+
+ Example: Updating an existing row with large data
+ In this example, we demonstrate a technique for overwriting a portion of
+ a blob field with new binary data. The blob data before and after the
+ section overwritten remains unchanged. Hence, this technique could be
+ used for updating fixed length subfields embedded in a binary field.
+
+ my $lob_id = 5; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator ) = $sth->fetchrow_array();
+
+ my $offset = 100234;
+ my $data = "This string will overwrite a portion of the blob";
+ $dbh->ora_lob_write( $bin_locator, $offset, $data );
+
+ After running this code, the row where lob_id = 5 will contain, starting
+ at position 100234 in the bin_data column, the string "This string will
+ overwrite a portion of the blob".
+
+ Example: Streaming character data from the database
+ In this example, we demonstrate a technique for streaming data from the
+ database to a file handle, in this case STDOUT. This allows more data to
+ be read in and written out than could be stored in memory at a given
+ time.
+
+ my $lob_id = 17; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ SQL
+ $sth->execute( $lob_id );
+ my ( $char_locator ) = $sth->fetchrow_array();
+
+ my $chunk_size = 1034; # Arbitrary chunk size, for example
+ my $offset = 1; # Offsets start at 1, not 0
+ while(1) {
+ my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size );
+ last unless length $data;
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+ Notice that the select statement does not contain the phrase "FOR
+ UPDATE". Because we are only reading from the LOB Locator returned, and
+ not modifying the LOB it refers to, the select statement does not
+ require the "FOR UPDATE" clause.
+
+ A word of caution when using the data returned from an ora_lob_read in a
+ conditional statement. for example if the code below;
+
+ while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) {
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+ was used with a chunk size of 4096 against a blob that requires more
+ than 1 chunk to return the data and the last chunk is one byte long and
+ contains a zero (ASCII 48) you will miss this last byte as $data will
+ contain 0 which PERL will see as false and not print it out.
+
+ Example: Truncating existing large data
+ In this example, we truncate the data already present in a large object
+ column in the database. Specifically, for each row in the table, we
+ truncate the 'bindata' value to half its previous length.
+
+ After acquiring a LOB Locator for the column, we query its length, then
+ we trim the length by half. Because we modify the large objects with the
+ call to ora_lob_trim(), we must select the LOB locators 'FOR UPDATE'.
+
+ my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ FOR UPATE
+ SQL
+ $sth->execute();
+ while( my ( $bin_locator ) = $sth->fetchrow_array() ) {
+ my $binlength = $dbh->ora_lob_length( $bin_locator );
+ if( $binlength > 0 ) {
+ $dbh->ora_lob_trim( $bin_locator, $binlength/2 );
+ }
+ }
+
+SPACES AND PADDING
+ Trailing Spaces
+ Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder
+ values and uses Nonpadded Comparison Semantics with the result. This
+ causes trouble if the spaces are needed for comparison with a CHAR value
+ or to prevent the value from becoming '' which Oracle treats as NULL.
+ Look for Blank-padded Comparison Semantics and Nonpadded Comparison
+ Semantics in Oracle's SQL Reference or Server SQL Reference for more
+ details.
+
+ To preserve trailing spaces in placeholder values for Oracle clients
+ that use OCI 8, either change the default placeholder type with
+ "ora_ph_type" or the placeholder type for a particular call to "bind" in
+ DBI or "bind_param_inout" in DBI with "ora_type" or "TYPE". Using
+ ORA_CHAR with ora_type or "SQL_CHAR" with "TYPE" allows the placeholder
+ to be used with Padded Comparison Semantics if the value it is being
+ compared to is a CHAR, NCHAR, or literal.
+
+ Please remember that using spaces as a value or at the end of a value
+ makes visually distinguishing values with different numbers of spaces
+ difficult and should be avoided.
+
+ Oracle Clients that use OCI 9.2 do not strip trailing spaces.
+
+ Padded Char Fields
+ Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder
+ values to the size of the CHAR. As the default placeholder type value in
+ DBD::Oracle is ORA_VARCHAR2 to access this behaviour you will have to
+ change the default placeholder type with "ora_ph_type" or placeholder
+ type for a particular call with "bind" in DBI or "bind_param_inout" in
+ DBI with "ORA_CHAR".
+
+UNICODE
+ DBD::Oracle now supports Unicode UTF-8. There are, however, a number of
+ issues you should be aware of, so please read all this section
+ carefully.
+
+ In this section we'll discuss "Perl and Unicode", then "Oracle and
+ Unicode", and finally "DBD::Oracle and Unicode".
+
+ Information about Unicode in general can be found at:
+ <http://www.unicode.org/>. It is well worth reading because there are
+ many misconceptions about Unicode and you may be holding some of them.
+
+ Perl and Unicode
+ Perl began implementing Unicode with version 5.6, but the implementation
+ did not mature until version 5.8 and later. If you plan to use Unicode
+ you are *strongly* urged to use Perl 5.8.2 or later and to *carefully*
+ read the Perl documentation on Unicode:
+
+ perldoc perluniintro # in Perl 5.8 or later
+ perldoc perlunicode
+
+ And then read it again.
+
+ Perl's internal Unicode format is UTF-8 which corresponds to the Oracle
+ character set called AL32UTF8.
+
+ Oracle and Unicode
+ Oracle supports many characters sets, including several different forms
+ of Unicode. These include:
+
+ AL16UTF16 => valid for NCHAR columns (CSID=2000)
+ UTF8 => valid for NCHAR columns (CSID=871), deprecated
+ AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873)
+
+ When you create an Oracle database, you must specify the DATABASE
+ character set (used for DDL, DML and CHAR datatypes) and the NATIONAL
+ character set (used for NCHAR and NCLOB types). The character sets used
+ in your database can be found using:
+
+ $hash_ref = $dbh->ora_nls_parameters()
+ $database_charset = $hash_ref->{NLS_CHARACTERSET};
+ $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET};
+
+ The Oracle 9.2 and later default for the national character set is
+ AL16UTF16. The default for the database character set is often US7ASCII.
+ Although many experienced DBAs will consider an 8bit character set like
+ WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle other
+ than US7ASCII, requires that the NLS_LANG environment variable be set.
+ See the "Oracle UTF8 is not UTF-8" section below.
+
+ You are strongly urged to read the Oracle Internationalization
+ documentation specifically with respect the choices and trade offs for
+ creating a databases for use with international character sets.
+
+ Oracle uses the NLS_LANG environment variable to indicate what character
+ set is being used on the client. When fetching data Oracle will convert
+ from whatever the database character set is to the client character set
+ specified by NLS_LANG. Similarly, when sending data to the database
+ Oracle will convert from the character set specified by NLS_LANG to the
+ database character set.
+
+ The NLS_NCHAR environment variable can be used to define a different
+ character set for 'national' (NCHAR) character types.
+
+ Both UTF8 and AL32UTF8 can be used in NLS_LANG and NLS_NCHAR. For
+ example:
+
+ NLS_LANG=AMERICAN_AMERICA.UTF8
+ NLS_LANG=AMERICAN_AMERICA.AL32UTF8
+ NLS_NCHAR=UTF8
+ NLS_NCHAR=AL32UTF8
+
+ Oracle UTF8 is not UTF-8
+ AL32UTF8 should be used in preference to UTF8 if it works for you, which
+ it should for Oracle 9.2 or later. If you're using an old version of
+ Oracle that doesn't support AL32UTF8 then you should avoid using any
+ Unicode characters that require surrogates, in other words characters
+ beyond the Unicode BMP (Basic Multilingual Plane).
+
+ That's because the character set that Oracle calls "UTF8" doesn't
+ conform to the UTF-8 standard in its handling of surrogate characters.
+ Technically the encoding that Oracle calls "UTF8" is known as "CESU-8".
+ Here are a couple of extracts from
+ <http://www.unicode.org/reports/tr26/>:
+
+ CESU-8 is useful in 8-bit processing environments where binary
+ collation with UTF-16 is required. It is designed and recommended
+ for use only within products requiring this UTF-16 binary collation
+ equivalence. It is not intended nor recommended for open interchange.
+
+ As a very small percentage of characters in a typical data stream
+ are expected to be supplementary characters, there is a strong
+ possibility that CESU-8 data may be misinterpreted as UTF-8.
+ Therefore, all use of CESU-8 outside closed implementations is
+ strongly discouraged, such as the emittance of CESU-8 in output
+ files, markup language or other open transmission forms.
+
+ Oracle uses this internally because it collates (sorts) in the same
+ order as UTF16, which is the basis of Oracle's internal collation
+ definitions.
+
+ Rather than change UTF8 for clients Oracle chose to define a new
+ character set called "AL32UTF8" which does conform to the UTF-8
+ standard. (The AL32UTF8 character set can't be used on the server
+ because it would break collation.)
+
+ Because of that, for the rest of this document we'll use "AL32UTF8". If
+ you're using an Oracle version below 9.2 you'll need to use "UTF8" until
+ you upgrade.
+
+ DBD::Oracle and Unicode
+ DBD::Oracle Unicode support has been implemented for Oracle versions 9
+ or greater, and Perl version 5.6 or greater (though we *strongly*
+ suggest that you use Perl 5.8.2 or later).
+
+ You can check which Oracle version your DBD::Oracle was built with by
+ importing the "ORA_OCI" constant from DBD::Oracle.
+
+ Fetching Data
+
+ Any data returned from Oracle to DBD::Oracle in the AL32UTF8 character
+ set will be marked as UTF-8 to ensure correct handling by Perl.
+
+ For Oracle to return data in the AL32UTF8 character set the NLS_LANG or
+ NLS_NCHAR environment variable *must* be set as described in the
+ previous section.
+
+ When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle
+ will set the Perl UTF-8 flag on the returned data if either NLS_NCHAR is
+ AL32UTF8, or NLS_NCHAR is not set and NLS_LANG is AL32UTF8.
+
+ When fetching other character data from Oracle, DBD::Oracle will set the
+ Perl UTF-8 flag on the returned data if NLS_LANG is AL32UTF8.
+
+ Sending Data using Placeholders
+
+ Data bound to a placeholder is assumed to be in the default client
+ character set (specified by NLS_LANG) except for a few special cases.
+ These are listed here with the highest precedence first:
+
+ If the "ora_csid" attribute is given to bind_param() then that is passed
+ to Oracle and takes precedence.
+
+ If the value is a Perl Unicode string (UTF-8) then DBD::Oracle ensures
+ that Oracle uses the Unicode character set, regardless of the NLS_LANG
+ and NLS_NCHAR settings.
+
+ If the placeholder is for inserting an NCLOB then the client NLS_NCHAR
+ character set is used. (That's useful but inconsistent with the other
+ behaviour so may change. Best to be explicit by using the "ora_csform"
+ attribute.)
+
+ If the "ora_csform" attribute is given to bind_param() then that
+ determines if the value should be assumed to be in the default
+ (NLS_LANG) or NCHAR (NLS_NCHAR) client character set.
+
+ use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR );
+ ...
+ $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR });
+
+ or
+
+ $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders
+
+ Binding with bind_param_array and execute_array is also UTF-8 compatible
+ in the same way. If you attempt to insert UTF-8 data into a non UTF-8
+ Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert will
+ still happen but a error code of 0 will be returned with the following
+ warning;
+
+ DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data.
+ The Query charset id=1, name=US7ASCII
+
+ The warning will report the parameter number and the NCHAR setting that
+ the query is running.
+
+ Sending Data using SQL
+
+ Oracle assumes the SQL statement is in the default client character set
+ (as specified by NLS_LANG). So Unicode strings containing non-ASCII
+ characters should not be used unless the default client character set is
+ AL32UTF8.
+
+ DBD::Oracle and Other Character Sets and Encodings
+ The only multi-byte Oracle character set supported by DBD::Oracle is
+ "AL32UTF8" (and "UTF8"). Single-byte character sets should work well.
+
+OBJECT & COLLECTION DATA TYPES
+ Oracle databases allow for the creation of object oriented like
+ user-defined types. There are two types of objects, Embedded--an object
+ stored in a column of a regular table and REF--an object that uses the
+ REF retrieval mechanism.
+
+ DBD::Oracle supports only the 'selection' of embedded objects of the
+ following types OBJECT, VARRAY and TABLE in any combination. Support is
+ seamless and recursive, meaning you need only supply a simple SQL
+ statement to get all the values in an embedded object. You can either
+ get the values as an array of scalars or they can be returned into a
+ DBD::Oracle::Object.
+
+ Array example, given this type and table;
+
+ CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30);
+
+ CREATE TABLE "CONTACT"
+ ( "COMPANYNAME" VARCHAR2(40),
+ "ADDRESS" VARCHAR2(100),
+ "PHONE_NUMBERS" "PHONE_NUMBERS"
+ )
+
+ The code to access all the data in the table could be something like
+ this;
+
+ my $sth = $dbh->prepare('SELECT * FROM CONTACT');
+ $sth->execute;
+ while ( my ($company, $address, $phone) = $sth->fetchrow()) {
+ print "Company: ".$company."\n";
+ print "Address: ".$address."\n";
+ print "Phone #: ";
+
+ foreach my $items (@$phone){
+ print $items.", ";
+ }
+ print "\n";
+ }
+
+ Note that values in PHONE_NUMBERS are returned as an array reference
+ '@$phone'.
+
+ As stated before DBD::Oracle will automatically drill into the embedded
+ object and extract all of the data as reference arrays of scalars. The
+ example below has OBJECT type embedded in a TABLE type embedded in an
+ SQL TABLE;
+
+ CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER;
+
+ CREATE OR REPLACE TYPE STUDENT AS OBJECT(
+ NAME VARCHAR2(60),
+ SOME_GRADES GRADELIST);
+
+ CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT;
+
+ CREATE TABLE GROUPS(
+ GRP_ID NUMBER(4),
+ GRP_NAME VARCHAR2(10),
+ STUDENTS STUDENTS_T)
+ NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB
+ (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB);
+
+ The following code will access all of the embedded data;
+
+ $SQL='select grp_id,grp_name,students as my_students_test from groups';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){
+ print "Group ID#".$grp_id." Group Name =".$grp_name."\n";
+ foreach my $student (@$students){
+ print "Name:".$student->[0]."\n";
+ print "Marks:";
+ foreach my $grades (@$student->[1]){
+ foreach my $marks (@$grades){
+ print $marks.",";
+ }
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+
+ Object example, given this object and table;
+
+ CREATE OR REPLACE TYPE Person AS OBJECT (
+ name VARCHAR2(20),
+ age INTEGER)
+ ) NOT FINAL;
+
+ CREATE TYPE Employee UNDER Person (
+ salary NUMERIC(8,2)
+ );
+
+ CREATE TABLE people (id INTEGER, obj Person);
+
+ INSERT INTO people VALUES (1, Person('Black', 25));
+ INSERT INTO people VALUES (2, Employee('Smith', 44, 5000));
+
+ The following code will access the data;
+
+ $dbh{'ora_objects'} =>1;
+
+ $sth = $dbh->prepare("select * from people order by id");
+ $sth->execute();
+
+ # object are fetched as instance of DBD::Oracle::Object
+ my ($id1, $obj1) = $sth->fetchrow();
+ my ($id2, $obj2) = $sth->fetchrow();
+
+ # get full type-name of object
+ print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed
+ print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed
+
+ # get attribute NAME from object
+ print $obj1->attr('NAME')."3\n"; # 'Black' is printed
+ print $obj2->attr('NAME')."3\n"; # 'Smith' is printed
+
+ # get all atributes as hash reference
+ my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25}
+ my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44,
+ # 'SALARY' => 5000 }
+
+ # get all attributes (names and values) as array
+ my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25)
+ my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44,
+ # 'SALARY', 5000 )
+
+ So far DBD::Oracle has been tested on a table with 20 embedded Objects,
+ Varrays and Tables nested to 10 levels.
+
+ Any NULL values found in the embedded object will be returned as
+ 'undef'.
+
+OTHER DATA TYPES
+ DBD::Oracle does not *explicitly* support most Oracle datatypes. It
+ simply asks Oracle to return them as strings and Oracle does so. Mostly.
+ Similarly when binding placeholder values DBD::Oracle binds them as
+ strings and Oracle converts them to the appropriate type, such as DATE,
+ when used.
+
+ Some of these automatic conversions to and from strings use NLS settings
+ to control the formatting for output and the parsing for input. The most
+ common example is the DATE type. The default NLS format for DATE might
+ be DD-MON-YYYY and so when a DATE type is fetched that's how Oracle will
+ format the date. NLS settings also control the default parsing of
+ strings into DATE values. An error will be generated if the contents of
+ the string don't match the NLS format. If you're dealing in dates which
+ don't match the default NLS format then you can either change the
+ default NLS format or, more commonly, use TO_CHAR(field, "format") and
+ TO_DATE(?, "format") to explicitly specify formats for converting to and
+ from strings.
+
+ A slightly more subtle problem can occur with NUMBER types. The default
+ NLS settings might format numbers with a fullstop (""."") to separate
+ thousands and a comma ("","") as the decimal point. Perl will generate
+ warnings and use incorrect values when numbers, returned and formatted
+ as strings in this way by Oracle, are used in a numeric context. You
+ could explicitly convert each numeric value using the TO_CHAR(...)
+ function but that gets tedious very quickly. The best fix is to change
+ the NLS settings. That can be done for an individual connection by
+ doing:
+
+ $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'");
+
+ There are some types, like BOOLEAN, that Oracle does not automatically
+ convert to or from strings (pity). These need to be converted explicitly
+ using SQL or PL/SQL functions.
+
+ Examples:
+
+ # DATE values
+ my $sth0 = $dbh->prepare( <<SQL_END );
+ SELECT username, TO_CHAR( created, ? )
+ FROM all_users
+ WHERE created >= TO_DATE( ?, ? )
+ SQL_END
+ $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' );
+
+ # BOOLEAN values
+ my $sth2 = $dbh->prepare( <<PLSQL_END );
+ DECLARE
+ b0 BOOLEAN;
+ b1 BOOLEAN;
+ o0 VARCHAR2(32);
+ o1 VARCHAR2(32);
+
+ FUNCTION to_bool( i VARCHAR2 ) RETURN BOOLEAN IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i = 'F' OR i = '0' THEN RETURN FALSE;
+ ELSE RETURN TRUE;
+ END IF;
+ END;
+ FUNCTION from_bool( i BOOLEAN ) RETURN NUMBER IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i THEN RETURN 1;
+ ELSE RETURN 0;
+ END IF;
+ END;
+ BEGIN
+ -- Converting values to BOOLEAN
+ b0 := to_bool( :i0 );
+ b1 := to_bool( :i1 );
+
+ -- Converting values from BOOLEAN
+ :o0 := from_bool( b0 );
+ :o1 := from_bool( b1 );
+ END;
+ PLSQL_END
+ my ( $i0, $i1, $o0, $o1 ) = ( "", "Something else" );
+ $sth2->bind_param( ":i0", $i0 );
+ $sth2->bind_param( ":i1", $i1 );
+ $sth2->bind_param_inout( ":o0", \$o0, 32 );
+ $sth2->bind_param_inout( ":o1", \$o1, 32 );
+ $sth2->execute();
+ foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) {
+ $_ = "(undef)" if ! defined $_;
+ }
+ print "$i0 to $o0, $i1 to $o1\n";
+ # Result is : "'' to '(undef)', 'Something else' to '1'"
+
+ Support for Insert of XMLType (ORA_XMLTYPE)
+ Inserting large XML data sets into tables with XMLType fields is now
+ supported by DBD::Oracle. The only special requirement is the use of
+ bind_param() with an attribute hash parameter that specifies ora_type as
+ ORA_XMLTYPE. For example with a table like this;
+
+ create table books (book_id number, book_xml XMLType);
+
+ one can insert data using this code
+
+ $SQL='insert into books values (1,:p_xml)';
+ $xml= '<Books>
+ <Book id=1>
+ <Title>Programming the Perl DBI</Title>
+ <Subtitle>The Cheetah Book</Subtitle>
+ <Authors>
+ <Author>T. Bunce</Author>
+ <Author>Alligator Descartes</Author>
+ </Authors>
+
+ </Book>
+ <Book id=10000>...
+ </Books>';
+ my $sth =$dbh-> prepare($SQL);
+ $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE });
+ $sth-> execute();
+
+ In the above case we will assume that $xml has 10000 Book nodes and is
+ over 32k in size and is well formed XML. This will also work for XML
+ that is smaller than 32k as well. Attempting to insert malformed XML
+ will cause an error.
+
+ Binding Cursors
+ Cursors can be returned from PL/SQL blocks, either from stored functions
+ (or procedures with OUT parameters) or from direct "OPEN" statements, as
+ shown below:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types);
+ my $dbh = DBI->connect(...);
+ my $sth1 = $dbh->prepare(q{
+ BEGIN OPEN :cursor FOR
+ SELECT table_name, tablespace_name
+ FROM user_tables WHERE tablespace_name = :space;
+ END;
+ });
+ $sth1->bind_param(":space", "USERS");
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+ The only special requirement is the use of "bind_param_inout()" with an
+ attribute hash parameter that specifies "ora_type" as "ORA_RSET". If you
+ don't do that you'll get an error from the "execute()" like: "ORA-06550:
+ line X, column Y: PLS-00306: wrong number or types of arguments in call
+ to ...".
+
+ Here's an alternative form using a function that returns a cursor. This
+ example uses the pre-defined weak (or generic) REF CURSOR type
+ SYS_REFCURSOR. This is an Oracle 9 feature.
+
+ # Create the function that returns a cursor
+ $dbh->do(q{
+ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR
+ AS l_cursor SYS_REFCURSOR;
+ BEGIN
+ OPEN l_cursor FOR select ename, empno from emp
+ ORDER BY ename;
+ RETURN l_cursor;
+ END;
+ });
+
+ # Use the function that returns a cursor
+ my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+ A cursor obtained from PL/SQL as above may be passed back to PL/SQL by
+ binding for input, as shown in this example, which explicitly closes a
+ cursor:
+
+ my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;");
+ $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } );
+ $sth3->execute;
+
+ It is not normally necessary to close a cursor explicitly in this way.
+ Oracle will close the cursor automatically at the first client-server
+ interaction after the cursor statement handle is destroyed. An explicit
+ close may be desirable if the reference to the cursor handle from the
+ PL/SQL statement handle delays the destruction of the cursor handle for
+ too long. This reference remains until the PL/SQL handle is re-bound,
+ re-executed or destroyed.
+
+ NOTE: From DBD::Oracle 1.57 functions or procedures returning
+ SYS_REFCURSORs which have not been opened (are still in the initialised
+ state) will return undef for the cursor statement handle e.g., in the
+ example above if the sp_ListEmp function simply returned l_cursor
+ instead of opening it. This means you can have a function/procedure
+ which can elect to open the cursor or not, Before this change if you
+ called a function/procedure which returned a SYS_REFCURSOR which was not
+ opened DBD::Oracle would error in the execute for a OCIAttrGet on the
+ uninitialised cursor.
+
+ See the "curref.pl" script in the Oracle.ex directory in the DBD::Oracle
+ source distribution for a complete working example.
+
+ Fetching Nested Cursors
+ Oracle supports the use of select list expressions of type REF CURSOR.
+ These may be explicit cursor expressions - "CURSOR(SELECT ...)", or
+ calls to PL/SQL functions which return REF CURSOR values. The values of
+ these expressions are known as nested cursors.
+
+ The value returned to a Perl program when a nested cursor is fetched is
+ a statement handle. This statement handle is ready to be fetched from.
+ It should not (indeed, must not) be executed.
+
+ Oracle imposes a restriction on the order of fetching when nested
+ cursors are used. Suppose $sth1 is a handle for a select statement
+ involving nested cursors, and $sth2 is a nested cursor handle fetched
+ from $sth1. $sth2 can only be fetched from while $sth1 is still active,
+ and the row containing $sth2 is still current in $sth1. Any attempt to
+ fetch another row from $sth1 renders all nested cursor handles
+ previously fetched from $sth1 defunct.
+
+ Fetching from such a defunct handle results in an error with the message
+ "ERROR nested cursor is defunct (parent row is no longer current)".
+
+ This means that the "fetchall..." or "selectall..." methods are not
+ useful for queries returning nested cursors. By the time such a method
+ returns, all the nested cursor handles it has fetched will be defunct.
+
+ It is necessary to use an explicit fetch loop, and to do all the
+ fetching of nested cursors within the loop, as the following example
+ shows:
+
+ use DBI;
+ my $dbh = DBI->connect(...);
+ my $sth = $dbh->prepare(q{
+ SELECT dname, CURSOR(
+ SELECT ename FROM emp
+ WHERE emp.deptno = dept.deptno
+ ORDER BY ename
+ ) FROM dept ORDER BY dname
+ });
+ $sth->execute;
+ while ( my ($dname, $nested) = $sth->fetchrow_array ) {
+ print "$dname\n";
+ while ( my ($ename) = $nested->fetchrow_array ) {
+ print " $ename\n";
+ }
+ }
+
+ The cursor returned by the function "sp_ListEmp" defined in the previous
+ section can be fetched as a nested cursor as follows:
+
+ my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual});
+ $sth->execute;
+ my ($nested) = $sth->fetchrow_array;
+ while ( my @row = $nested->fetchrow_array ) { ... }
+
+ Pre-fetching Nested Cursors
+ By default, DBD::Oracle pre-fetches rows in order to reduce the number
+ of round trips to the server. For queries which do not involve nested
+ cursors, the number of pre-fetched rows is controlled by the DBI
+ database handle attribute "RowCacheSize" (q.v.).
+
+ In Oracle, server side open cursors are a controlled resource, limited
+ in number, on a per session basis, to the value of the initialization
+ parameter "OPEN_CURSORS". Nested cursors count towards this limit. Each
+ nested cursor in the current row counts 1, as does each nested cursor in
+ a pre-fetched row. Defunct nested cursors do not count.
+
+ An Oracle specific database handle attribute, "ora_max_nested_cursors",
+ further controls pre-fetching for queries involving nested cursors. For
+ each statement handle, the total number of nested cursors in pre-fetched
+ rows is limited to the value of this parameter. The default value is 0,
+ which disables pre-fetching for queries involving nested cursors.
+
+PL/SQL Examples
+ Most of these PL/SQL examples come from: Eric Bartley
+ <bartley@cc.purdue.edu>.
+
+ /*
+ * PL/SQL to create package with stored procedures invoked by
+ * Perl examples. Execute using sqlplus.
+ *
+ * Use of "... OR REPLACE" prevents failure in the event that the
+ * package already exists.
+ */
+
+ CREATE OR REPLACE PACKAGE plsql_example
+ IS
+ PROCEDURE proc_np;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ );
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ );
+
+ FUNCTION func_np
+ RETURN VARCHAR2;
+
+ END plsql_example;
+ /
+
+ CREATE OR REPLACE PACKAGE BODY plsql_example
+ IS
+ PROCEDURE proc_np
+ IS
+ whoami VARCHAR2(20) := NULL;
+ BEGIN
+ SELECT USER INTO whoami FROM DUAL;
+ END;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ )
+ IS
+ BEGIN
+ RAISE_APPLICATION_ERROR(err_code, 'This is a test.');
+ END;
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ )
+ IS
+ BEGIN
+ is_odd := MOD(test_num, 2);
+ END;
+
+ FUNCTION func_np
+ RETURN VARCHAR2
+ IS
+ ret_val VARCHAR2(20);
+ BEGIN
+ SELECT USER INTO ret_val FROM DUAL;
+ RETURN ret_val;
+ END;
+
+ END plsql_example;
+ /
+ /* End PL/SQL for example package creation. */
+
+ use DBI;
+
+ my($db, $csr, $ret_val);
+
+ $db = DBI->connect('dbi:Oracle:database','user','password')
+ or die "Unable to connect: $DBI::errstr";
+
+ # So we don't have to check every DBI call we set RaiseError.
+ # See the DBI docs now if you're not familiar with RaiseError.
+ $db->{RaiseError} = 1;
+
+ # Example 1 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Calling a PLSQL procedure that takes no parameters. This shows you the
+ # basic's of what you need to execute a PLSQL procedure. Just wrap your
+ # procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
+ #
+ # p.s. If you've used SQL*Plus's exec command all it does is wrap the
+ # command in a BEGIN END; block for you.
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_NP;
+ END;
+ });
+ $csr->execute;
+
+
+ # Example 2 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Now we call a procedure that has 1 IN parameter. Here we use bind_param
+ # to bind out parameter to the prepared statement just like you might
+ # do for an INSERT, UPDATE, DELETE, or SELECT statement.
+ #
+ # I could have used positional placeholders (e.g. :1, :2, etc.) or
+ # ODBC style placeholders (e.g. ?), but I prefer Oracle's named
+ # placeholders (but few DBI drivers support them so they're not portable).
+
+ my $err_code = -20001;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN(:err_code);
+ END;
+ });
+
+ $csr->bind_param(":err_code", $err_code);
+
+ # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
+ # Because we set RaiseError, the DBI will croak (die) so we catch that with eval.
+ eval {
+ $csr->execute;
+ };
+ print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n";
+
+
+ # Example 3 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Building on the last example, I've added 1 IN OUT parameter. We still
+ # use a placeholders in the call to prepare, the difference is that
+ # we now call bind_param_inout to bind the value to the place holder.
+ #
+ # Note that the third parameter to bind_param_inout is the maximum size
+ # of the variable. You normally make this slightly larger than necessary.
+ # But note that the Perl variable will have that much memory assigned to
+ # it even if the actual value returned is shorter.
+
+ my $test_num = 5;
+ my $is_odd;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd);
+ END;
+ });
+
+ # The value of $test_num is _copied_ here
+ $csr->bind_param(":test_num", $test_num);
+
+ $csr->bind_param_inout(":is_odd", \$is_odd, 1);
+
+ # The execute will automagically update the value of $is_odd
+ $csr->execute;
+
+ print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n";
+
+
+ # Example 4 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # What about the return value of a PLSQL function? Well treat it the same
+ # as you would a call to a function from SQL*Plus. We add a placeholder
+ # for the return value and bind it with a call to bind_param_inout so
+ # we can access it's value after execute.
+
+ my $whoami = "";
+
+ $csr = $db->prepare(q{
+ BEGIN
+ :whoami := PLSQL_EXAMPLE.FUNC_NP;
+ END;
+ });
+
+ $csr->bind_param_inout(":whoami", \$whoami, 20);
+ $csr->execute;
+ print "Your database user name is $whoami\n";
+
+ $db->disconnect;
+
+ You can find more examples in the t/plsql.t file in the DBD::Oracle
+ source directory.
+
+ Oracle 9.2 appears to have a bug where a variable bound with
+ bind_param_inout() that isn't assigned to by the executed PL/SQL block
+ may contain garbage. See
+ <http://www.mail-archive.com/dbi-users@perl.org/msg18835.html>
+
+ Avoid Using "SQL Call"
+ Avoid using the "SQL Call" statement with DBD:Oracle as you might find
+ that DBD::Oracle will not raise an exception in some case. Specifically
+ if you use "SQL Call" to run a procedure all "No data found" exceptions
+ will be quietly ignored and returned as null. According to Oracle
+ support this is part of the same mechanism where;
+
+ select (select * from dual where 0=1) from dual
+
+ returns a null value rather than an exception.
+
+CONTRIBUTING
+ If you'd like DBD::Oracle to do something new or different the best way
+ to make that happen is to do it yourself and email to dbi-dev@perl.org a
+ patch of the source code (using 'diff' - see below) that shows the
+ changes.
+
+ How to create a patch using Subversion
+ The DBD::Oracle source code is maintained using Subversion (a
+ replacement for CVS, see <http://subversion.tigris.org/>). To access the
+ source you'll need to install a Subversion client. Then, to get the
+ source code, do:
+
+ svn checkout http://svn.perl.org/modules/dbd-oracle/trunk
+
+ If it prompts for a username and password use your perl.org account if
+ you have one, else just 'guest' and 'guest'. The source code will be in
+ a new subdirectory called "trunk".
+
+ To keep informed about changes to the source you can send an empty email
+ to dbd-oracle-changes-subscribe@perl.org after which you'll get an email
+ with the change log message and diff of each change checked-in to the
+ source.
+
+ After making your changes you can generate a patch file, but before you
+ do, make sure your source is still upto date using:
+
+ svn update
+
+ If you get any conflicts reported you'll need to fix them first. Then
+ generate the patch file from within the "trunk" directory using:
+
+ svn diff > foo.patch
+
+ Read the patch file, as a sanity check, and then email it to
+ dbi-dev@perl.org.
+
+ How to create a patch without Subversion
+ Unpack a fresh copy of the distribution:
+
+ tar xfz DBD-Oracle-1.40.tar.gz
+
+ Rename the newly created top level directory:
+
+ mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo
+
+ Edit the contents of DBD-Oracle-1.40.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 *another* copy of the original distribution you started with:
+
+ tar xfz DBD-Oracle-1.40.tar.gz
+
+ Then create a patch file by performing a recursive "diff" on the two top
+ level directories:
+
+ diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.your_foo.patch
+
+ 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.
+
+ GitHub repository
+ A git mirror of the subversion is also available at
+ `https://github.com/yanick/DBD-Oracle`.
+
+WHICH VERSION OF DBD::ORACLE IS FOR ME?
+ From version 1.25 onwards DBD::Oracle only support Oracle clients 9.2 or
+ greater. Support for ProC connections was dropped in 1.29.
+
+ If you are still stuck with an older version of Oracle or its client you
+ might want to look at the table below.
+
+ +---------------------+-----------------------------------------------------+
+ | | Oracle Version |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 0.1~16 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.17 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.18 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.19 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.20 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.21~1.24 | N | N | N | N | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.25+ | N | N | N | N | N | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+
+ As there are dozens of different versions of Oracle's clients this list
+ does not include all of them, just the major released versions of
+ Oracle.
+
+ Note that one can still connect to any Oracle version with the older
+ DBD::Oracle versions the only problem you will have is that some of the
+ newer OCI and Oracle features available in later DBD::Oracle releases
+ will not be available to you.
+
+ So to make a short story a little longer:
+
+ 1 If you are using Oracle 7 or early 8 DB and you can manage to get a
+ 9 client and you can use any DBD::Oracle version.
+
+ 2 If you have to use an Oracle 7 client then DBD::Oracle 1.17 should
+ work
+
+ 3 Same thing for 8 up to R2, use 1.17, if you are lucky and have the
+ right patch-set you might go with 1.18.
+
+ 4 For 8iR3 you can use any of the DBD::Oracle versions up to 1.21.
+ Again this depends on your patch-set, If you run into trouble go
+ with 1.19
+
+ 5 After 9.2 you can use any version you want.
+
+ 6 It seems that the 10g client can only connect to 9 and 11 DBs while
+ the 9 can go back to 7 and even get to 10. I am not sure what the
+ 11g client can connect to.
+
+BUGS AND LIMITATIONS
+ There is a known problem with the 11.2g Oracle client and the
+ "DBMS_LOB.GETLENGTH()" PL/SQL function. See
+ <https://rt.cpan.org/Public/Bug/Display.html?id=69350> for the details.
+
+SEE ALSO
+ DBI http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in
+ the DBD::Oracle source distribution including the examples in the
+ Oracle.ex directory
+
+ DBD::Oracle Tutorial
+ http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-ora
+ cle.html
+
+ Oracle Instant Client
+ http://www.oracle.com/technology/tech/oci/instantclient/index.html
+
+ Oracle on Linux
+ http://www.ixora.com.au/
+
+ Free Oracle Tools and Links
+ ora_explain supplied and installed with DBD::Oracle.
+
+ http://www.orafaq.com/
+
+ http://vonnieda.org/oracletool/
+
+ Commercial Oracle Tools and Links
+ Assorted tools and references for general information. No
+ recommendation implied.
+
+ http://www.platinum.com
+
+ http://www.SoftTreeTech.com
+
+ Also PL/Vision from RevealNet and Steven Feuerstein, and "Q" from
+ Savant Corporation.
+
+AUTHORS
+ DBI by Tim Bunce <http://www.tim.bunce.name>.
+
+ The original "DBD::Oracle" was by Tim Bunce. Maintained as of release
+ 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the
+ auspice of the Pythian Group (<http://www.pythian.com>).
+
+ACKNOWLEDGEMENTS
+ A great many people have helped with DBD::Oracle over the 17 years
+ between 1994 and 2011. Far too many to name, but we thank them all. Many
+ are named in the Changes file.
+
+COPYRIGHT
+ The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland.
+ The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The
+ Pythian Group). Canada. The DBD::Oracle module is Copyright (c) 2011
+ John Scoles. Canada.
+
+ The DBD::Oracle module is free open source software; you can
+ redistribute it and/or modify it under the same terms as Perl 5.
+
+AUTHORS
+ * Tim Bunce <timb@cpan.org>
+
+ * John Scoles <byterock@cpan.org>
+
+ * Yanick Champoux <yanick@cpan.org>
+
+ * Martin J. Evans <mjevans@cpan.org>
+
+COPYRIGHT AND LICENSE
+ This software is copyright (c) 1994 by Tim Bunce.
+
+ This is free software; you can redistribute it and/or modify it under
+ the same terms as the Perl 5 programming language system itself.
-
-*** HOW TO REPORT PROBLEMS
-
-Please don't post problems to comp.lang.perl.* 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 by sending a message to dbi-users-help@perl.org
-
-Please post details of any problems (or changes you needed to make) to
-dbi-users@perl.org and CC them to me at Tim.Bunce@pobox.com. But note...
-
-** IT IS IMPORTANT TO INCLUDE *ALL* THE FOLLOWING INFORMATION:
-
-1. A complete log of all steps of the build, e.g.:
-
- (do a make realclean first)
- perl Makefile.PL -v (note the -v for verbose)
- make
- make test
- make test TEST_VERBOSE=1 (only if any of the t/* tests fail)
-
- Make sure to include the 'stderr' output. The best way to do this is
- to use the "script" command (man script). If that's not available
- then (assuming you're not using csh) do "command > command.log 2>&1"
- The "2>&1" is required (after the stdout redirect) to redirect stderr
- to the same place.
-
-2. Full details of which version of Oracle you're using (if it
- wasn't automatically found and printed by "perl Makefile.PL")
-
-3. The output of perl -V (that's a capital V, not lowercase)
-
-4. If you get errors like "undefined symbol", "symbol not found",
- "undefined reference", "Text relocation remains" or any similar
- error then include the output of "perl Makefile.PL -s XXX"
- where XXX is the name of one of the symbols.
- Please don't send the entire output of this command,
- just any obviously 'interesting' parts (if there are any).
- See also the LINKTYPE=static notes above.
-
-5. If you get a core dump, rebuild DBD::Oracle with debugging
- enabled by executing: perl Makefile.PL -g (note the -g option)
- then rerun the code to get a new core dump file, finally use a
- debugger (gdb, sdb, dbx, adb etc) to get a stack trace from it.
- NOTE: I may not be able to help you much without a stack trace!
- It is worth fetching and building the GNU GDB debugger (4.15) if
- you don't have a good debugger on your system. If desparate try:
- make perl; ./perl script; echo '$c' | adb ./perl core
-
-6. If the stack trace mentions XS_DynaLoader_dl_load_file then rerun
- make test after setting the environment variable PERL_DL_DEBUG to 2.
-
-7. If your installation succeeds, but your script does not behave
- as you expect, the problem is most likely on your end. 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.
-
-It is important to check that you are using the latest version before
-posting. If you're not then I'm *very* likely to simply say "upgrade to
-the latest". You would do yourself a favour by upgrading beforehand.
-
-Please remember that I'm _very_ busy. Try to help yourself first,
-then try to help me help you by following these guidelines carefully.
-And remember, please don't mail me directly - use the dbi-users
-mailing list.
-
-Regards,
-Tim.
-
-===============================================================================
-Examples and other info:
-
-README.help -- READ IT FIRST IF YOU HAVE ANY PROBLEMS AT ALL!
-README.win32 -- building DBD::Oracle under MS Windows
-README.wingcc -- building DBD::Oracle under MS Windows with gcc
-README.clients -- building/using DBD::Oracle on minimally configured systems
-README.login -- help for login problems
-README.longs -- examples dealing with LONG types (blobs)
-README.utf8 -- Perl 5.6.0, Oracle, and UTF-8
-
-DBI 'home page': http://dbi.perl.org
-
-Old archive site for Perl DB information:
- ftp://ftp.demon.co.uk/pub/perl/db/
-Mailing list archive: /DBI/perldb-interest/
-Perl 4 Oraperl (v2.4) /perl4/oraperl/
-
-ftp://ftp.bf.rmit.edu.au/pub/Oracle/sources/...
-
-Jeff Stander's stuff stands out for Oraperl:
-Directories of interest might be
- /pub/Oracle/sources
- /pub/Oracle/sources/jstander
- /pub/Oracle/sources/jstander/distrib
- /pub/Oracle/sources/jstander/tsmlib
- /pub/Oracle/sources/jstander/wdbex
- /pub/Oracle/sources/web/scripts
- /pub/Oracle/sources/dba
- /pub/Oracle/sources/dba/imp2sql7
- /pub/Oracle/sources/Lonnroth
- /pub/Oracle/sources/harrison
-
-Send stuff for the archive in
- [.{cpio|tar|zip}][.{gz|Z|zip}].uu
- format if by mail to me (orafaq@bf.rmit.edu.au)
- And drop the .uu if using ftp, putting file(s) in
- ftp://ftp.bf.rmit.edu.au/incoming/Oracle
-
-http://www.bf.rmit.edu.au/~orafaq/perlish.html
-ftp://ftp.bf.rmit.edu.au/pub/perl/db
-ftp://ftp.bf.rmit.edu.au/pub/Oracle
-ftp://ftp.bf.rmit.edu.au/pub/Oracle/sources
-ftp://ftp.bf.rmit.edu.au/pub/Oracle/OS/MS/NT/ntoraperl.zip
-
-DBI and DBD::Oracle are very portable. If Perl and Oracle run on a platform
-then the chances are that DBD::Oracle will as well.
-
-===============================================================================
-
-See the large README.help file for lots of hints and advice about building and
-runtime issues.
-
-End.
@@ -1,274 +0,0 @@
-This file contains some random notes relating to minimal Oracle
-configurations for building and/or using DBD::Oracle / Oraperl.
-
--------------------------------------------------------------------------------
-With recent versions of Oracle (specifically >= 7.3) you may be
-able to build DBD::Oracle without Pro*C installed by using the Oracle
-supplied oracle.mk file:
-
- perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/oracle.mk
-
-(The oracle.mk file might also be found in $ORACLE_HOME/rdbms/public/)
-
--------------------------------------------------------------------------------
-From: James Cooper <pixel@coe.missouri.edu>
-
-> [...], what do I need in addition to perl5 to access an Oracle database
-> on another system from a unix box (Solaris 2.5) that doesn't have an
-> oracle database running on it ?
->
-> In other words are their some oracle shared objects, etc. I need ?
-
-I don't have experience with Solaris, but on IRIX 5.3, I simply installed
-SQL*Net ($ORACLE_HOME/network/admin/*) and the OCI libraries which are in
-$ORACLE_HOME/lib. You'll also need the header files from
-$ORACLE_HOME/sqllib/public/*.h and $ORACLE_HOME/rdbms/demo/*.h (you won't
-need them all, but you can get rid of them after DBD::Oracle compiles).
-
-[You'll probably need at least ocommon in addition to network. But if you
-use the Oracle installer (as you always should) it'll probably install
-ocommon for you.]
-
-So just put that stuff on your client box and install DBI and DBD::Oracle
-there. Once DBD::Oracle is installed you can remove the OCI libraries and
-headers (make sure to keep SQL*Net!)
-
-Other than that, getting it working isn't too hard. If you're not
-familiar with SQL*Net, let me know. I'm no expert, but I know the basics.
-The main thing is to have a good tnsnames.ora file in
-$ORACLE_HOME/network/admin
-
--------------------------------------------------------------------------------
-From: Jon Meek <meekj@Cyanamid.COM>
-
-For my compilation of DBD-Oracle/Solaris2.5/Oracle7.2.x(x=2, I think), I
-just pulled the required files in the rdbms directory from the Oracle CD.
-The files I needed were:
-
-$ ls -lR
-drwxr-xr-x 2 oracle apbr 512 May 15 17:43 demo/
-drwxr-xr-x 2 oracle apbr 512 May 15 16:20 lib/
-drwxr-xr-x 2 oracle apbr 512 May 15 16:18 mesg/
-drwxr-xr-x 2 oracle apbr 512 May 15 17:38 public/
-
-./demo:
--r--r--r-- 1 oracle apbr 4509 Jun 29 1995 ociapr.h
--r--r--r-- 1 oracle apbr 5187 Jun 29 1995 ocidfn.h
--rw-rw-r-- 1 oracle apbr 6659 Jun 29 1995 oratypes.h
-
-./lib:
--rw-r--r-- 1 oracle apbr 1132 Jul 6 1995 clntsh.mk
--rwxr-xr-x 1 oracle apbr 5623 Jul 17 1995 genclntsh.sh*
--rw-r--r-- 1 oracle apbr 15211 Jul 5 1995 oracle.mk
--rw-r--r-- 2 oracle apbr 3137 May 15 16:20 osntab.s
--rw-r--r-- 2 oracle apbr 3137 May 15 16:20 osntabst.s
--rw-r--r-- 1 oracle apbr 9 May 15 16:19 psoliblist
--rw-r--r-- 1 oracle apbr 39 May 15 16:21 sysliblist
-
-./mesg:
--r--r--r-- 1 oracle apbr 183296 Jul 11 1995 oraus.msb
--r--r--r-- 1 oracle apbr 878114 Jul 11 1995 oraus.msg
-
-./public:
--r--r--r-- 1 oracle apbr 5187 Jun 29 1995 ocidfn.h
-
-Jon
-
--------------------------------------------------------------------------------
-Jon Meek <meekj@pt.Cyanamid.COM> Tue, 18 Feb 1997
-
-This was for Oracle 7.2.2.3.0 (client side for DBD:Oracle build) and
-SQL*net v2. I have heard that sqlnet.ora might not be needed.
-
-ls -lR oracle
-oracle:
-total 2
-drwxr-xr-x 3 meekj apbr 512 Nov 3 11:46 network/
-
-oracle/network:
-total 2
-drwxr-xr-x 2 meekj apbr 512 Nov 3 11:46 admin/
-
-oracle/network/admin:
-total 6
--rw-r--r-- 1 meekj apbr 309 Nov 3 11:46 sqlnet.ora
--rw-r--r-- 1 meekj apbr 1989 Nov 3 11:46 tnsnames.ora
-
--------------------------------------------------------------------------------
-
-From: Lack Mr G M <gml4410@ggr.co.uk>
-Date: Thu, 23 Jan 1997 18:24:03 +0000
-
- I noticed the appended in the README.clients file of the DBD-Oracle
-distribution. My experience is somewhat different (and simpler).
-
- On Irix5.3 (ie. what this user was using) I built DBI and DBD-Oracle
-on a system with Oracle and Pro*C installed. I tested it on another
-system (where I knew an oracle id). I installed it from a third (which
-had write rights to the master copies of the NFS mounted directories),
-but this didn't have Oracle installed.
-
- Having done this all of my systems (even those without a hint of
-oracle on them) could access remote Oracle servers by setting TWO_TASK
-appropriately. SQL*Net didn't seem to come into it.
-
- The dynamically-loadable library created (auto/DBD/Oracle/Oracle.so)
-contains no reference to any dynamic Oracle library.
-
- Exactly the same happened for my Solaris systems.
-
- From: James Cooper <pixel@coe.missouri.edu>
- > [...], what do I need in addition to perl5 to access an Oracle database
- > on another system from a unix box (Solaris 2.5) that doesn't have an
- > oracle database running on it ?
- >
- > In other words are their some oracle shared objects, etc. I need ?
-
-I don't have experience with Solaris, but on IRIX 5.3, I simply installed
-SQL*Net ($ORACLE_HOME/network/admin/*) and the OCI libraries which are in
-$ORACLE_HOME/lib. You'll also need the header files from
-$ORACLE_HOME/sqllib/public/*.h and $ORACLE_HOME/rdbms/demo/*.h (you won't
-need them all, but you can get rid of them after DBD::Oracle compiles).
-
-So just put that stuff on your client box and install DBI and DBD::Oracle
-there. Once DBD::Oracle is installed you can remove the OCI libraries and
-headers (make sure to keep SQL*Net!)
-
--------------------------------------------------------------------------------
-OS/Oracle version: Solaris 2 and Oracle 7.3
-
-Problem: DBD::Oracle works on the database machine, but not from remote
-machines (via TCP). SQL*Plus, however, does work from the remote machines.
-
-Cause: $ORACLE_HOME/ocommon/nls/admin/data/lx1boot.nlb is missing
-
-Solution: Make sure $ORACLE_HOME/ocommon is available on the remote machine.
-
-This was the first time I had used DBD::Oracle with Oracle 7.3.2. Oracle
-7.1 has a somewhat different directory structure, and seems to store files
-in different places relative to $ORACLE_HOME. So I just hadn't NFS
-exported all the files I needed to. I figured that as long as SQL*Plus
-was happy, I had all the necessary files to run DBD::Oracle (since that
-was always the case with 7.1). But I was wrong.
-
-James Cooper <pixel@organic.com>
-
--------------------------------------------------------------------------------
-Subject: Re: Oracle Licencing...
-Date: Thu, 15 May 1997 11:54:09 -0700
-From: Mark Dedlow <dedlow@voro.lbl.gov>
-
-Please forgive the continuation of this somewhat off-topic issue,
-but I wanted to correct/update my previous statement, and it's
-probably of interest to many DBD-Oracle users.
-
-> > In general, as I understand it, Oracle doesn't license the client runtime
-> > libraries directly, rather they get you for SQL*NET. It is typically
-> > about $100 per node. You have to have that licensed on any machine
-> > that runs DBD-Oracle.
-
-Oracle recently changed policy. sqlnet now comes with RDBMS licenses.
-If you have named RDBMS licenses, you can install sqlnet on as many
-client machines as you have named licenses for the server. If you
-have concurrent RDBMS licenses, you can install sqlnet on as many
-client machines as you like, and only use concurrently as many
-as you have concurrent server RDBMS licenses.
-
-OCI, Pro*C, et. al. only requires you to have a development license,
-per developer. The compiled apps can be distributed unlimited.
-The client where the client app resides must be licensed to use
-sqlnet, by the above terms, i.e. by virtue of what the licenses on
-the server are that the client is connecting to.
-
-This means one could legitimately distribute DBD-Oracle in compiled form.
-Probably not recommended :-)
-
-But is does mean one can compile DBD-Oracle and distribute it internally
-to your org without more licensing, as long as the targets have sqlnet.
-
-Obviously, this is not a legal ruling. I don't work for Oracle.
-But this is what my sales rep tells me as of today.
-
-Mark
--------------------------------------------------------------------------------
-
-From: Wintermute <wntrmute@gte.net>
-
-Ok, you may think me daft for this but I just figured out what was
-necessary in using DBI/DBD:Oracle on a machine that needs to access a
-remote Oracle database.
-
-What the docs tell you is that you just need enough of Oracle installed
-to compile it. They don't say that you need to keep that "just enough"
-around for the DBI to work properly!!
-
-So here's my predicament so that others might benefit from my bumbling.
-
-I needed to install Perl, DBI, and DBD:Oracle on a machine running a
-Fast Track web server (hostname Leviathan) that is to access a remote
-Oracle database (henceforth called Yog-Sothoth (appropriate for the
-beast that it is)). Leviathan doesn't have enough space for the 500M
-install that Oracle 7 for Solaris 2.5.1 wants so I had to figure out a
-way to get things done. Here's a brief list of the steps I took for
-Leviathan.
-
-1. Got the GCC binary dist for Solaris 2.6 and installed
-2. Got Perl 5.004_01 source/compiled/installed
-3. Got the DBI .90 compiled/installed
-4. Got DBD:Oracle...
-
- (and here's where it gets interesting).
-
- I exported the /opt/oracle7 directory from Yog-Sothoth to
-Leviathan in
-order to compile DBD:Oracle, then umount'ed it afterwards. Tried 'make
-test' after it had compiled and watched it flounder and fail. For the
-life of me I couldn't figure out why this could be so, so I went back
-and adjusted my TWO_TASK/ORACLE_USERID env vars.
- No luck.
- Wash/Rinse/Repeat.
- Still no luck.
-I started to get desperate about this time, so instead of screwing with
-it anymore I installed the module under the Perl heirarchy just to be
-done for the moment with it (figuring that the 'make test' script could
-be fallible). I neglected to mention that the errors I was getting were
-coming from the Oracle database on the remote machine, so I knew it
-worked in part, just not well enough to hold the connection for some
-reason.
-
-After having no luck with my own Perl connect script I tried remounting
-the nfs volume with Oracle on it and setting ORACLE_HOME to it. When I
-ran that very same Perl script it WORKED! Well sort of. None of the
-short connection methods worked, I was forced to use the long method of
-connecting IE: name/password@dbname(DESCRIPTION=(ADDRESS=(...etc.etc.
-
-So here I am figuring that I'm doing something right, but there's
-something I'm missing. Well it turns out that it's not me, it's the
-machine that's missing it. If you are going to be using the DBD:Oracle
-driver with DBI, you'll need more than just it after compile time,
-you'll need some Oracle files as well.
-
-(BTW I'm running Oracle 7.3.2.2.0)
-
-You'll need everything in /var/opt/oracle (on the machine that houses
-Oracle), as well as $ORACLE_HOME/ocommon/nls. Why National Language
-Support is needed I'll never know. ocommon/nls has to reside under the
-directory your $ORACLE_HOME points to, and it's best to leave
-/var/opt/oracle/'s path alone.
-
-When I made these adjustments on the Oracle'less box and tried the 'make
-
-test' again, it ran through without a hitch. I'll be doing some more
-intensive things with it from here on out and if anything changes I'll
-let you all know, however this seems odd that nothing is mentioned in
-the documentation about what residual files need to be around after
-compiling the DBD:Oracle for it to work successfully.
-
-Like I said, don't flame me for being stupid, but I just had to get this
-story off my chest since I've been puzzling over it all day and I feel
-that other people may want to do the same thing as I did, and will run
-into the same problems.
-
--- Wintermute
-
--------------------------------------------------------------------------------
@@ -1,193 +0,0 @@
-explain
-=======
-
-DISCLAIMER & COPYRIGHT
-----------------------
-
-Copyright (c) 1998 Alan Burlison
-
-You may distribute under the terms of either the GNU General Public License
-or the Artistic License, as specified in the Perl README file, with the
-exception that it cannot be placed on a CD-ROM or similar media for commercial
-distribution without the prior approval of the author.
-
-This code is provided with no warranty of any kind, and is used entirely at
-your own risk.
-
-This code was written by the author as a private individual, and is in no way
-endorsed or warrantied by Sun Microsystems.
-
-WHAT IS IT?
------------
-explain is a GUI-based tool that enables easier visualisation of Oracle Query
-plans. A query plan is the access path that Oracle will use to satisfy a SQL
-query. The Oracle query optimiser is responsible for deciding on the optimal
-path to use. Needless to say, understanding such plans requires a fairly
-sophisticated knowledge of Oracle architecture and internals.
-
-explain allows a user to interactively edit a SQL statemant and view the
-resulting query plan with the click of a single button. The effects of
-modifying the SQL or of adding hints can be rapidly established.
-
-explain allows the user to grab all the SQL currently cached by Oracle. The SQL
-capture can be filtered and sorted by different criterea, e.g. all SQL matching
-a pattern, order by number of executions etc.
-
-explain is written using Perl, DBI/DBD::Oracle and Tk.
-
-PREREQUISITES
--------------
-1. Oracle 7 or Oracle 8, with SQL*Net if appropriate
-2. Perl 5.004_04 or later
-3. DBI version 0.93 or later
-4. DBD::Oracle 0.49 or later
-5. Tk 800.005 or later
-6. Tk-Tree 3.00401 or later
-
-Items 2 through 6 can be obtained from any CPAN mirror.
-
-INSTALLATION
-------------
-1. Check you have all the prequisites installed and working.
-2. Check the #! line in the script points to where your Perl interpreter is
- installed.
-3. Copy the "explain" script to somewhere on your path.
-4. Make sure the "explain" script is executable.
-5. Make sure you have run the script $ORACLE_HOME/rdbms/admin/utlxplan.sql
- from a SQL*Plus session. This script creates the PLAN_TABLE that is used
- by Oracle when explaining query plans.
-
-HOW TO USE
-----------
-
-Type "explain" at the shell prompt. A window will appear with a menu bar and
-three frames, labelled "Query Plan", "Query Step Details" and "SQL Editor". At
-the bottom of the window is a single button labelled "Explain". A login dialog
-will also appear, into which you should enter the database username, password
-and database instance name (SID). The parameters you enter are passed to the
-DBI->connect() method, so if you have any problems refer to the DBI and
-DBD::Oracle documentation.
-
-Optionally you may supply up to two command-line arguments. If the first
-argument is of the form username/password@database, explain will use this to
-log in to Oracle, otherwise if it is a filename it will be loaded into the SQL
-editor. If two arguments are supplied, the second one will be assumed to be a
-filename.
-
-Examples:
- explain scott/tiger@DB query.sql
- explain / query.sql (assumes OPS$ user authentication)
- explain query.sql
-
-
-Explain functionality
----------------------
-
-The menu bar has one pulldown menu, "File", which allows you to login to Oracle,
-Grab the contents of the Oracle SQL cache, Load SLQ from files, Save SQL to
-files and to Exit the program.
-
-The "SQL Editor" frame allows the editing of a SQL statement. This should be
-just a single statement - multiple statements are not allowed. Refer to the
-documentation for the Tk text widget for a description of the editing keys
-available. Text may be loaded and saved by using the "File" pulldown menu.
-
-Once you have entered a SQL statement, the "Explain" button at the bottom of
-the window will generate the query plan for the statement. A tree
-representation of the plan will appear in the "Query Plan" frame. Individual
-"legs" of the plan may be expanded and collapsed by clicking on the "+' and "-"
-boxes on the plan tree. The tree is drawn so that the "innermost" or "first"
-query steps are indented most deeply. The connecting lines show the
-"parent-child" relationships between the query steps. For a comprehensive
-explanation of the meaning of query plans you should refer to the relevant
-Oracle documentation.
-
-Single-clicking on a plan step in the Query Plan pane will display more
-detailed information on that query step in the Query Step Details frame. This
-information includes Oracle's estimates of cost, cardinality and bytes
-returned. The exact information displayed depends on the Oracle version.
-Again, for detailed information on the meaning of these fields, refer to the
-Oracle documentation.
-
-Double-clicking on a plan step that refers to either a table or an index will
-pop up a dialog box showing the definitiaon of the table or index in a format
-similar to that of the SQL*Plus 'desc' command.
-
-Grab functionality
------------------
-
-The explain window has an option on the "File" menu labelled "Grab SQL ...".
-Selecting this will popup a new top-level window containing a menu bar and
-three frames, labelled "SQL Cache", "SQL Statement Statistics" and "SQL
-Selection Criterea". At the bottom of the window is a single button labelled
-"Grab".
-
-The menu bar has one pulldown menu, "File", which allows you to Save the
-contents of the SQL Cache frame and Close the Grab window.
-
-The "SQL Cache" frame shows the statements currently in the Oracle SQL cache.
-Text may be saved by using the "File" pulldown menu.
-
-The "SQL Selection Criterea" frame allows you to specify which SQL statements
-you are interested in, and how you want them sorted. The pattern used to select
-statements is a normal perl regexp. Once you have defined the selection
-criterea, clicking the "Grab" button will read all the matching statements from
-the SQL cache and display them in the top frame.
-
-Single-clicking on a statement in the SQL Cache pane will display more
-detailed information on that statement in the Sql Statement Statistics frame,
-including the number of times the statement has been executed and the numbers
-of rows processed by the statement.
-
-Double-clicking on a statement will copy it into the SQL editor in the Explain
-window, so that the query plan for the statement can be examined.
-
-SUPPORT
--------
-
-Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
-
-
-CHANGES
-=======
-
-Version 0.51 beta 09/08/98
----------------------------
-
-Integrated into DBD::Oracle release 0.54.
-
-Version 0.5 beta 02/06/98
---------------------------
-Changes made to work with Tk800.005.
-Fixed bug with grab due to Oracle's inconsistent storage of the hash_value
-column in v$sqlarea and v$sqltext_with_newlines.
-Disallowed multiple concurrent login/save/open dialogs.
-Fixed double-posting of login dialog on startup.
-Tried to make it less Oracle version dependent.
-
-Version 0.4 beta 27/02/98
---------------------------
-Grab functionality added, to allow interrogation of Oracle's SQL cache
-Bind variables used wherever possible to prevent unnecessary reparses of the
-SQL generated by explain
-Extra error checking
-Various code cleanups & restructuring
-More extensive commenting of the source
-
-Version 0.3 beta 19/02/98
---------------------------
-Changed to use new Tk FileSelect instead of older FileDialog.
-Added facility to supply user/pass@database & SQL filename on the command-line.
-Thanks to Eric Zylberstejn <ezylbers@capgemini.fr> for the patch + suggestions.
-Added check on login to Oracle for a PLAN_TABLE in the user's schema.
-
-Version 0.2 beta 05/02/98
---------------------------
-Changed to work with both Oracle 7 and 8 statistics.
-Pop-up table & index description dialogs added.
-First public version.
-
-Version 0.1 beta 27/01/98
---------------------------
-Initial version.
-Not publically released.
@@ -1,398 +0,0 @@
-===============================================================================
-Platform or Oracle Version specific notes, hints, tips etc:
-
-Note that although some of these refer to specific systems and versions the
-same or similar problems may exist on other systems or versions.
-
-Most of this mess is due to Oracle's fondness for changing the
-build/link process for OCI applications between versions.
-
--------------------------------------------------------------------------------
-If you get compiler errors refering to Perl's own header files
-(.../CORE/*.h) then there is something wrong with your installation.
-It is 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.
-
--------------------------------------------------------------------------------
-Assorted runtime problems...
-
-Ensure that the version of Oracle you are talking to is the same one
-you used to build your DBD::Oracle module.
-
-Try building perl with 'usemymalloc' disabled.
-Try building perl with 'threads' enabled (esp for Oracle >= 8.1.6).
-
-Try removing "-lthread" from $ORACLE_HOME/lib/ldflags and/or
-$ORACLE_HOME/lib/sysliblist just for the duration of the DBD::Oracle build
-(but I can't really recommend this approach as it may cause subtle
-problems later)
-
--------------------------------------------------------------------------------
-Bad free() warnings:
-
-These are generally caused by problems in Oracle's own library code.
-You can use this code to hide them:
-
- $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /^Bad free/ }
-
-If you're using an old perl version (below 5.004) then upgrading will
-probably fix the warnings (since later versions can disable that warning)
-and is highly recommended anyway.
-
-Alternatively you can rebuild Perl without perl's own malloc and/or
-upgrade Oracle to a more recent version that doesn't have the problem.
-
--------------------------------------------------------------------------------
-Can't find libclntsh.so at run time:
-
-Dave Moellenhoff <dmoellen@clarify.com>: libclntsh.so is the shared
-library composed of all the other Oracle libs you used to have to
-statically link. Oracle didn't start providing it until 7.2 and later.
-libclntsh.so should be in $ORACLE_HOME/lib. If it's missing, try
-running $ORACLE_HOME/rdbms/lib/genclntsh.sh and it should create it.
-($ORACLE_HOME/lib/genclntsh.sh for Oracle 8 and later.)
-
-Also: Never copy libclntsh.so to a different machine or Oracle version.
-If DBD::Oracle was built on a machine with a different path to libclntsh.so
-then you'll need to set set an environment variable, typically
-LD_LIBRARY_PATH, to include the directory containing libclntsh.so.
-
-But: LD_LIBRARY_PATH is typically ignored if the script is running set-uid
-(which is common in some httpd/CGI configurations). In this case
-either rebuild with LD_RUN_PATH set to include the path to libclntsh
-or create a symbolic link so that libclntsh is available via the same
-path as it was when the module was built. (On Solaris the command
-"ldd -s Oracle.so" can be used to see how the linker is searching for it.)
-
-
--------------------------------------------------------------------------------
-Error while trying to retrieve text for error ...:
-
-From Lou Henefeld <LHenefeld@gnn.com>: We discovered that we needed
-some files from the $ORACLE_HOME/ocommon/nls/admin/data directory:
- lx00001.nlb, lx10001.nlb, lx1boot.nlb, lx20001.nlb
-If your national language is different from ours (American English),
-you will probably need different nls data files.
-
-
--------------------------------------------------------------------------------
-ORA-01019: unable to allocate memory in the user side
-
-From Ethan Tuttle <etuttle@ipro.com>: My experience: ORA-01019 errors
-occur when using Oracle 7.3.x shared libraries on a machine that
-doesn't have all necessary Oracle files in $ORACLE_HOME.
-
-It used to be with 7.2 libraries that all one needed was the tnsnames.ora
-file for a DBD-Oracle client to connect. Not so with 7.3.x. I'm not sure
-exactly which additional files are needed on the client machine.
-
-Furthermore, from what I can tell, the path to ORACLE_HOME is resolved and
-compiled into either libclntsh.so or the DBD-Oracle. Thus, copying a
-minimal ORACLE_HOME onto a client machine won't work unless the path to
-ORACLE_HOME is the same on the client machine as it is on the machine
-where DBD-Oracle was compiled.
-
-ORA-01019 can also be caused by corrupt Oracle config files such as
-/etc/oratab.
-
-ORA-01019 can also be caused by using a different version of the
-message catalogs ($ORACLE_HOME/ocommon/nls/admin/data) to that used
-when DBD::Oracle was compiled.
-
-Also try building with oracle.mk if your DBD::Oracle defaulted to proc.mk.
-
--------------------------------------------------------------------------------
-SCO - For general help enabling dynamic loding under SCO 5
-
- http://www2.arkansas.net/~jcoy/perl5/
-
--------------------------------------------------------------------------------
-AIX - warnings like these when building perl are not usually a problem:
-
-ld: 0711-415 WARNING: Symbol Perl_sighandler is already exported.
-ld: 0711-319 WARNING: Exported symbol not defined: Perl_abs_amg
-
-When building on AIX check to make sure that all of bos.adt (13 pieces)
-and all of bos.compat (11 pieces) are installed.
-
-Thanks to Mike Moran <mhm@austin.ibm.com> for this information.
-
--------------------------------------------------------------------------------
-AIX 4 - core dump on login and similar problems
-
-set
- cc='xlc_r'
-in config.sh. Rebuild everything, and make sure xlc_r is used everywhere.
-set environment
- ORACCENV='cc=xlc_r'; export ORACCENV
-to enforce this in oraxlc
-
-Thanks to Goran Thyni <goran@bildbasen.kiruna.se> for this information.
-
--------------------------------------------------------------------------------
-AIX - core dump on disconnect (SIGILL signal)
-
-Try setting BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance.
-See 'Hang during "repetitive connect/open/close/disconnect" test' below.
-
--------------------------------------------------------------------------------
-HP-UX: General
-
-Read README.hpux. Then read it again.
-
-HP's bundled C compiler is dumb. Very dumb. You're almost bound to have
-problems if you use it - you'll certainly need to do a 'static link'
-(see elsewhere). It is recommended that you use HP's ANSI C compiler
-(which costs) or fetch and build the free GNU GCC compiler (v2.7.2.2 or later).
-
-Note that using shared libraries on HP-UX 10.10 (and others?) requires
-patch 441647. With thanks to John Liptak <jliptak@coefmd3.uswc.uswest.com>.
-
--------------------------------------------------------------------------------
-HP-UX: Terry Greenlaw <z50816@mip.lasc.lockheed.com>
-
-I traced a problem with "ld: Invalid loader fixup needed" to the file
-libocic.a. On HP-UX 9 it contains position-dependant code and cannot be
-used to generate dynamic load libraries. The only shared library that
-Oracle ships under HP-UX is liboracle.sl which replaces libxa.a,
-libsql.a, libora.a, libcvg.a, and libnlsrtl.a. The OCI stuff still
-appears to only link statically under HU-UX 9.x [10.x seems okay].
-
-You'll need to build DBD::Oracle statically linked into the perl binary.
-See the static linking notes below.
-
-If you get an error like: Bad magic number for shared library: Oracle.a
-You'll need to build DBD::Oracle statically linked into the perl binary.
-
-HP-UX 10 and Oracle 7.2.x do work together when creating dynamic libraries.
-The problem was older Oracle libraries were built without the +z flag to cc,
-and were therefore position-dependent libraries that can't be linked
-dynamically. Newer Oracle releases don't have this problem and it may be
-possible to even use the newer Oracle libraries under HP-UX 9. Oracle 7.3
-will ONLY work under HP-UX 10, however.
-
-HP-UX 10 and Oracle 7.3.x seem to have problems. You'll probably need
-to build DBD::Oracle statically linked (see below). The problem seems
-to be related to Oracle's own shared library code trying to do a
-dynamic load (from lxfgno() in libnlsrtl3.a or libclntsh.sl). If you
-get core dumps on login try uncommenting the /* #define signed */ line
-in dbdimp.h as a long-shot. Please let me know if this fixes it for you
-(but I doubt it will).
-
--------------------------------------------------------------------------------
-For platforms which require static linking.
-
-You'll need to build DBD::Oracle statically linked and then link it
-into a perl binary:
-
- perl Makefile.PL LINKTYPE=static
- make
- make perl (makes a perl binary in current directory)
- make test FULLPERL=./perl (run tests using the new perl binary)
- make install
-
-You will probably need to have already built and installed a static
-version of the DBI in order that it be automatically included when
-you do the 'make perl' above.
-
-Remember that you must use this new perl binary to access Oracle.
-
--------------------------------------------------------------------------------
-Error: Can't find loadable object for module DBD::Oracle in @INC ...
-
-You probably built DBD::Oracle for static linking rather than dynamic
-linking. See 'For platforms which require static linking' above for
-more info. If your platform supports dynamic linking then try to work
-out why DBD::Oracle got built for static linking.
-
--------------------------------------------------------------------------------
-Error: Syntax warnings/errors relating to 'signed'
-
-Remove the /* and */ surrounding the '/* #define signed */' line in dbdimp.h
-
--------------------------------------------------------------------------------
-ORA-00900: invalid SQL statement "begin ... end"
-
-You probably don't have PL/SQL Oracle properly/fully installed.
-
--------------------------------------------------------------------------------
-Connection/Login slow. Takes a long time and may coredump
-
-Oracle bug number: 227321 related to changing the environment before
-connecting to oracle. Reported to be fixed in 7.1.6 (or by patch 353611).
-
-To work around this bug, do not set any environment variables in your
-oraperl script before you call ora_login, and when you do call
-ora_login, the first argument must be the empty string. This means
-that you have to be sure that your environment variables ORACLE_SID
-and ORACLE_HOME are set properly before you execute any oraperl
-script. It is probably also possible to pass the SID to ora_login as
-part of the username (for example, ora_login("", "SCOTT/TIGER@PROD",
-"")), although I have not tested this.
-This workaround is based on information from Kevin Stock.
-
-Also check $ORACLE_HOME/otrace/admin. If it contains big *.dat files
-then you may have otrace enabled. Try setting EPC_DISABLED=TRUE
-in the environment of the database and listener before they're started.
-Oracle 7.3.2.2.0 sets this to FALSE by default, which turns on tracing
-of all SQL statements, and will cause very slow connects once that
-trace file gets big. You can also add (ENVS='EPC_DISABLED=TRUE') to
-the SID_DESC part of listener.ora entries. (With thanks to Johan
-Verbrugghen jverbrug@be.oracle.com)
-
--------------------------------------------------------------------------------
-Connection/Login takes a long time
-
-Try connect('', 'user/passwd@tnsname', ''). See README.login and item above.
-
--------------------------------------------------------------------------------
-Error: ORA-00604: error occurred at recursive SQL level (DBD: login failed)
-
-This can happen if TWO_TASK is defined but you connect using ORACLE_SID.
-
--------------------------------------------------------------------------------
-Error: ld: Undefined symbols _environ _dlopen _dlclose ...
-Environment: SunOS 4.1.3, Oracle 7.1.6 Steve Livingston <mouche@hometown.com>
-
-If you get link errors like: ld: Undefined symbols _environ _dlopen _dlclose ...
-and the link command line includes '-L/usr/5lib -lc' then comment out the
-'CLIBS= $(OTHERLIBS) -L/usr/5lib -lc' line in the Makefile.
-
--------------------------------------------------------------------------------
-Error: fatal: relocation error: symbol not found: main
-Environment: Solaris, GCC
-
-Do not use GNU as or GNU ld on Solaris. Delete or rename them, they are
-just bad news. In the words of John D Groenveld <groenvel@cse.psu.edu>:
-Run, dont walk, to your console and 'mv /opt/gnu/bin/as /opt/gnu/bin/gas;
-mv /opt/gnu/bin/ld /opt/gnu/bin/gld'. You can add -v to the gcc command
-in the Makefile to see what GCC is using.
-
--------------------------------------------------------------------------------
-Error: relocation error:symbol not found:setitimer
-Environment: SVR4, stephen.zander@mckesson.com
-
-Error: can't load ./blib/arch/auto/DBD/Oracle/Oracle.so for module DBD::Oracle:
-DynamicLinker:/usr/local/bin/perl:relocation error:symbol not found:setitimer
-Fix: Try adding the '-lc' to $ORACLE_HOME/rdbms/lib/sysliblist (just
-make sure it's not on a new line).
-
--------------------------------------------------------------------------------
-Error: Undefined symbols __cg92_used at link time.
-Environment: Solaris, GCC
-
-Fix: If you're compiling Oracle applications with gcc on Solaris you need to
-link with a file called $ORACLE_HOME/lib/__fstd.o. If you compile with the
-SparcWorks compiler you need to add the command line option on -xcg92
-to resolve these symbol problems cleanly.
-
-Alligator Descartes <descarte@hermetica.com>
-
--------------------------------------------------------------------------------
-Environment: SunOS 4.1.3, Oracle 7.1.3 John Carlson <carlson@tis.llnl.gov>
-
-Problem: oraperl and DBD::Oracle fail to link. Some messing around with
-the library order makes the link succeed. Now I get a "Bad free()" when
-ora_logoff is called.
-
-Solution:
-In my case, this was caused by a faulty oracle install. The install grabbed
-the wrong version of mergelib (The X11R6 one) instead of the one in
-$ORACLE_HOME/bin. Try a more limited path and reinstall Oracle again.
-
--------------------------------------------------------------------------------
-Environment: SGI IRIX
-
-From Dennis Box <dbox@fndapl.fnal.gov>:
-
-Details instructions are available from http://misdev.fnal.gov/~dbox/n32/
-(To build IRIX n32 format using the Oracle n32 toolkit.)
-
-From Mark Duffield <duffield@ariad.com>: (possibly now out of date)
-
-Oracle only supports "-32" and "-mips2" compilation flags, not "-n32".
-Configure and build perl with -32 flag (see perl hints/irix_6.sh file
-in the perl distribution).
-Rebuild DBI (which will now use the -32 flag).
-Rebuild DBD::Oracle (which will now use the -32 flag).
-
-Since IRIX depends on the perl executable in /usr/sbin, you'll have to
-keep it around along with the one you just built. Some care will need
-to be taken to make sure that you are getting the right perl, either
-through explicitly running the perl you want, or with a file header in
-your perl file. The file header is probably the better solution of the two.
-
-In summary, until Oracle provides support for either the "-n32" or the "-64"
-compiler switches, you'll have to have a perl, DBI, and DBD-Oracle which are
-compiled and linked "-32". I understand that Oracle is working on a 64bit
-versions of V7.3.3 for SGI (or MIPS ABI as they call it), but I don't have
-any firm dates.
-
-You may also need to use perl Makefile.PL -p.
-
--------------------------------------------------------------------------------
-Environment: 64-bit platforms (DEC Alpha, OSF, SGI/IRIX64 v6.4)
-
-Problem: 0 ORA-00000: normal, successful completion
-
-Solution: Add '#define A_OSF' to Oracle.h above '#include <oratypes.h>' and
-complain to Oracle about bugs in their header files on 64 bit systems.
-
--------------------------------------------------------------------------------
-Link errors or test core dumps
-
-Try each of these in turn (follow each with a make && make test):
- perl Makefile.PL -nob
- perl Makefile.PL -c
- perl Makefile.PL -l
- perl Makefile.PL -n LIBCLNTSH
-let me know if any of these help.
-
--------------------------------------------------------------------------------
-Some runtime problems might be related to perl's malloc.
-
-This is a long shot. If all else fails and perl -V:usemymalloc says
-usemymalloc='y' then try rebuilding perl using Configure -Uusemymalloc.
-If this does fix it for you then please let me know.
-
-===============================================================================
-Hang during "repetitive connect/open/close/disconnect" test:
-
-From: "Alexi S. Lookin" <aslookin@alfabank.ru>
-
-In short, this problem was solved after addition of parameter
-BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance.
-
-Browsed Net8 doc (A67440-01 Net8 Admin Guide for Oracle 8.1.5,
-Feb.1999) and found some mention of inadequate bequeath behaviour when
-disconnecting bequeath session, and some solution for this problem at
-page 10-15 (may vary at any other release) :
-
-"p.10-15
-Child Process Termination
-
-Since the client application spawns a server process internally through
-the Bequeath protocol as a child process, the client application
-becomes responsible for cleaning up the child process when it
-completes. When the server process completes its connection
-responsibilities, it becomes a defunct process. Signal handlers are
-responsible for cleaning up these defunct processes. Alternatively, you
-may configure your client SQLNET.ORA file to pass this process to the
-UNIX init process by disabling signal handlers.
-
-Use the Net8 Assistant to configure a client to disable the UNIX signal
-handler. The SQLNET.ORA parameter set to disable is as follows:
- bequeath_detach=yes
-
-This parameter causes all child processes to be passed over to the UNIX
-init process (pid = 1). The init process automatically checks for
-"defunct" child processes and terminates them.
-
-Bequeath automatically chooses to use a signal handler in tracking
-child process status changes. If your application does not use any
-signal handling, then this default does not affect you."
-
-===============================================================================
-
-End.
@@ -0,0 +1,292 @@
+===============================================================================
+Platform or Oracle Version specific notes, hints, tips etc:
+
+Note that although some of these refer to specific systems and versions the
+same or similar problems may exist on other systems or versions.
+
+Most of this mess is due to Oracle's fondness for changing the
+build/link process for OCI applications between versions.
+
+
+-------------------------------------------------------------------------------
+AIX 4 - core dump on login and similar problems
+
+set
+ cc='xlc_r'
+in config.sh. Rebuild everything, and make sure xlc_r is used everywhere.
+set environment
+ ORACCENV='cc=xlc_r'; export ORACCENV
+to enforce this in oraxlc
+
+Thanks to Goran Thyni <goran@bildbasen.kiruna.se> for this information.
+
+-------------------------------------------------------------------------------
+AIX - core dump on disconnect (SIGILL signal)
+
+Try setting BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance.
+See 'Hang during "repetitive connect/open/close/disconnect" test' below.
+
+-------------------------------------------------------------------------------
+HP-UX: General
+
+Read README.hpux.txt. Then read it again.
+
+HP's bundled C compiler is dumb. Very dumb. You're almost bound to have
+problems if you use it - you'll certainly need to do a 'static link'
+(see elsewhere). It is recommended that you use HP's ANSI C compiler
+(which costs) or fetch and build the free GNU GCC compiler (v2.7.2.2 or later).
+
+Note that using shared libraries on HP-UX 10.10 (and others?) requires
+patch 441647. With thanks to John Liptak <jliptak@coefmd3.uswc.uswest.com>.
+
+-------------------------------------------------------------------------------
+HP-UX: Terry Greenlaw <z50816@mip.lasc.lockheed.com>
+
+I traced a problem with "ld: Invalid loader fixup needed" to the file
+libocic.a. On HP-UX 9 it contains position-dependant code and cannot be
+used to generate dynamic load libraries. The only shared library that
+Oracle ships under HP-UX is liboracle.sl which replaces libxa.a,
+libsql.a, libora.a, libcvg.a, and libnlsrtl.a. The OCI stuff still
+appears to only link statically under HU-UX 9.x [10.x seems okay].
+
+You'll need to build DBD::Oracle statically linked into the perl binary.
+See the static linking notes below.
+
+If you get an error like: Bad magic number for shared library: Oracle.a
+You'll need to build DBD::Oracle statically linked into the perl binary.
+
+HP-UX 10 and Oracle 7.2.x do work together when creating dynamic libraries.
+The problem was older Oracle libraries were built without the +z flag to cc,
+and were therefore position-dependent libraries that can't be linked
+dynamically. Newer Oracle releases don't have this problem and it may be
+possible to even use the newer Oracle libraries under HP-UX 9. Oracle 7.3
+will ONLY work under HP-UX 10, however.
+
+HP-UX 10 and Oracle 7.3.x seem to have problems. You'll probably need
+to build DBD::Oracle statically linked (see below). The problem seems
+to be related to Oracle's own shared library code trying to do a
+dynamic load (from lxfgno() in libnlsrtl3.a or libclntsh.sl). If you
+get core dumps on login try uncommenting the /* #define signed */ line
+in dbdimp.h as a long-shot. Please let me know if this fixes it for you
+(but I doubt it will).
+
+-------------------------------------------------------------------------------
+For platforms which require static linking.
+
+You'll need to build DBD::Oracle statically linked and then link it
+into a perl binary:
+
+ perl Makefile.PL LINKTYPE=static
+ make
+ make perl (makes a perl binary in current directory)
+ make test FULLPERL=./perl (run tests using the new perl binary)
+ make install
+
+You will probably need to have already built and installed a static
+version of the DBI in order that it be automatically included when
+you do the 'make perl' above.
+
+Remember that you must use this new perl binary to access Oracle.
+
+-------------------------------------------------------------------------------
+Error: Can't find loadable object for module DBD::Oracle in @INC ...
+
+You probably built DBD::Oracle for static linking rather than dynamic
+linking. See 'For platforms which require static linking' above for
+more info. If your platform supports dynamic linking then try to work
+out why DBD::Oracle got built for static linking.
+
+-------------------------------------------------------------------------------
+Error: Syntax warnings/errors relating to 'signed'
+
+Remove the /* and */ surrounding the '/* #define signed */' line in dbdimp.h
+
+-------------------------------------------------------------------------------
+ORA-00900: invalid SQL statement "begin ... end"
+
+You probably don't have PL/SQL Oracle properly/fully installed.
+
+-------------------------------------------------------------------------------
+Connection/Login slow. Takes a long time and may coredump
+
+Oracle bug number: 227321 related to changing the environment before
+connecting to oracle. Reported to be fixed in 7.1.6 (or by patch 353611).
+
+To work around this bug, do not set any environment variables in your
+oraperl script before you call ora_login, and when you do call
+ora_login, the first argument must be the empty string. This means
+that you have to be sure that your environment variables ORACLE_SID
+and ORACLE_HOME are set properly before you execute any oraperl
+script. It is probably also possible to pass the SID to ora_login as
+part of the username (for example, ora_login("", "SCOTT/TIGER@PROD",
+"")), although I have not tested this.
+This workaround is based on information from Kevin Stock.
+
+Also check $ORACLE_HOME/otrace/admin. If it contains big *.dat files
+then you may have otrace enabled. Try setting EPC_DISABLED=TRUE
+in the environment of the database and listener before they're started.
+Oracle 7.3.2.2.0 sets this to FALSE by default, which turns on tracing
+of all SQL statements, and will cause very slow connects once that
+trace file gets big. You can also add (ENVS='EPC_DISABLED=TRUE') to
+the SID_DESC part of listener.ora entries. (With thanks to Johan
+Verbrugghen jverbrug@be.oracle.com)
+
+-------------------------------------------------------------------------------
+Connection/Login takes a long time
+
+Try connect('', 'user/passwd@tnsname', ''). See README.login.txt and
+item above.
+
+-------------------------------------------------------------------------------
+Error: ORA-00604: error occurred at recursive SQL level (DBD: login failed)
+
+This can happen if TWO_TASK is defined but you connect using ORACLE_SID.
+
+-------------------------------------------------------------------------------
+Error: ld: Undefined symbols _environ _dlopen _dlclose ...
+Environment: SunOS 4.1.3, Oracle 7.1.6 Steve Livingston <mouche@hometown.com>
+
+If you get link errors like: ld: Undefined symbols _environ _dlopen _dlclose ...
+and the link command line includes '-L/usr/5lib -lc' then comment out the
+'CLIBS= $(OTHERLIBS) -L/usr/5lib -lc' line in the Makefile.
+
+-------------------------------------------------------------------------------
+Error: fatal: relocation error: symbol not found: main
+Environment: Solaris, GCC
+
+Do not use GNU as or GNU ld on Solaris. Delete or rename them, they are
+just bad news. In the words of John D Groenveld <groenvel@cse.psu.edu>:
+Run, dont walk, to your console and 'mv /opt/gnu/bin/as /opt/gnu/bin/gas;
+mv /opt/gnu/bin/ld /opt/gnu/bin/gld'. You can add -v to the gcc command
+in the Makefile to see what GCC is using.
+
+-------------------------------------------------------------------------------
+Error: relocation error:symbol not found:setitimer
+Environment: SVR4, stephen.zander@mckesson.com
+
+Error: can't load ./blib/arch/auto/DBD/Oracle/Oracle.so for module DBD::Oracle:
+DynamicLinker:/usr/local/bin/perl:relocation error:symbol not found:setitimer
+Fix: Try adding the '-lc' to $ORACLE_HOME/rdbms/lib/sysliblist (just
+make sure it's not on a new line).
+
+-------------------------------------------------------------------------------
+Error: relocation error:symbol not found:mutex_init
+Environment: UnixWare 7.x, earle.nietzel@es.unisys.com
+
+On the UnixWare 7.x platform the compiler flag -Kthread is commonly used
+when compiling for mulithread however in this case you should use -lthread.
+The compiler will complain that you should be using -Kthread and not
+-lthread, you should ignore these messages. Besure to check this compiler
+flag in $ORACLE_HOME/lib/sysliblist also.
+
+-------------------------------------------------------------------------------
+Error: Undefined symbols __cg92_used at link time.
+Environment: Solaris, GCC
+
+Fix: If you're compiling Oracle applications with gcc on Solaris you need to
+link with a file called $ORACLE_HOME/lib/__fstd.o. If you compile with the
+SparcWorks compiler you need to add the command line option on -xcg92
+to resolve these symbol problems cleanly.
+
+Alligator Descartes <descarte@hermetica.com>
+
+-------------------------------------------------------------------------------
+Environment: SunOS 4.1.3, Oracle 7.1.3 John Carlson <carlson@tis.llnl.gov>
+
+Problem: oraperl and DBD::Oracle fail to link. Some messing around with
+the library order makes the link succeed. Now I get a "Bad free()" when
+ora_logoff is called.
+
+Solution:
+In my case, this was caused by a faulty oracle install. The install grabbed
+the wrong version of mergelib (The X11R6 one) instead of the one in
+$ORACLE_HOME/bin. Try a more limited path and reinstall Oracle again.
+
+-------------------------------------------------------------------------------
+Environment: SGI IRIX
+
+From Dennis Box <dbox@fndapl.fnal.gov>:
+
+Details instructions are available from http://misdev.fnal.gov/~dbox/n32/
+(To build IRIX n32 format using the Oracle n32 toolkit.)
+
+From Mark Duffield <duffield@ariad.com>: (possibly now out of date)
+
+Oracle only supports "-32" and "-mips2" compilation flags, not "-n32".
+Configure and build perl with -32 flag (see perl hints/irix_6.sh file
+in the perl distribution).
+Rebuild DBI (which will now use the -32 flag).
+Rebuild DBD::Oracle (which will now use the -32 flag).
+
+Since IRIX depends on the perl executable in /usr/sbin, you'll have to
+keep it around along with the one you just built. Some care will need
+to be taken to make sure that you are getting the right perl, either
+through explicitly running the perl you want, or with a file header in
+your perl file. The file header is probably the better solution of the two.
+
+In summary, until Oracle provides support for either the "-n32" or the "-64"
+compiler switches, you'll have to have a perl, DBI, and DBD-Oracle which are
+compiled and linked "-32". I understand that Oracle is working on a 64bit
+versions of V7.3.3 for SGI (or MIPS ABI as they call it), but I don't have
+any firm dates.
+
+You may also need to use perl Makefile.PL -p.
+
+-------------------------------------------------------------------------------
+Environment: 64-bit platforms (DEC Alpha, OSF, SGI/IRIX64 v6.4)
+
+Problem: 0 ORA-00000: normal, successful completion
+
+Solution: Add '#define A_OSF' to Oracle.h above '#include <oratypes.h>' and
+complain to Oracle about bugs in their header files on 64 bit systems.
+
+-------------------------------------------------------------------------------
+Link errors or test core dumps
+
+Try each of these in turn (follow each with a make && make test):
+ perl Makefile.PL -nob
+ perl Makefile.PL -c
+ perl Makefile.PL -l
+ perl Makefile.PL -n LIBCLNTSH
+let me know if any of these help.
+
+===============================================================================
+Hang during "repetitive connect/open/close/disconnect" test:
+
+From: "Alexi S. Lookin" <aslookin@alfabank.ru>
+
+In short, this problem was solved after addition of parameter
+BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance.
+
+Browsed Net8 doc (A67440-01 Net8 Admin Guide for Oracle 8.1.5,
+Feb.1999) and found some mention of inadequate bequeath behaviour when
+disconnecting bequeath session, and some solution for this problem at
+page 10-15 (may vary at any other release) :
+
+"p.10-15
+Child Process Termination
+
+Since the client application spawns a server process internally through
+the Bequeath protocol as a child process, the client application
+becomes responsible for cleaning up the child process when it
+completes. When the server process completes its connection
+responsibilities, it becomes a defunct process. Signal handlers are
+responsible for cleaning up these defunct processes. Alternatively, you
+may configure your client SQLNET.ORA file to pass this process to the
+UNIX init process by disabling signal handlers.
+
+Use the Net8 Assistant to configure a client to disable the UNIX signal
+handler. The SQLNET.ORA parameter set to disable is as follows:
+ bequeath_detach=yes
+
+This parameter causes all child processes to be passed over to the UNIX
+init process (pid = 1). The init process automatically checks for
+"defunct" child processes and terminates them.
+
+Bequeath automatically chooses to use a signal handler in tracking
+child process status changes. If your application does not use any
+signal handling, then this default does not affect you."
+
+===============================================================================
+
+End.
@@ -1,1298 +0,0 @@
-=head1 INTRODUCTION
-
-Building a working dynamically linked version of the Oracle DBD driver
-on HP-UX (11.00) has been a challenge for many. For months after taking
-a new job, where HP-UX was the standard database server environment, I
-had only been able to build a statically linked version of Perl and the
-DBD-Oracle module on HP-UX 11.00.
-
-Then Roger Foskett posted instructions for what turned out to be dynamic
-build. Rogers's post got me farther than I had previously gotten. In fact,
-after resolving some undefined symbol errors, I succeeded where for I had
-previously despaired of finding the time to hack out the right
-incantation.
-
-This F<README.hpux> describes the combined knowledge of a number of
-folks who invested many hours discovering a working set of build options.
-The instructions in this file, which include building Perl from
-source, will produce a working dynamically linked DBD-Oracle that can
-be used with mod_perl and Apache.
-
-See Appendices for exact build configurations used by me an others.
-
-=head1 First things First
-
-The reason you are even reading this file is because you want to connect
-to an Oracle database from your perl program using the DBD::Oracle DBI
-driver. So before you start, install (at least
-the Oracle client software) (SQL*Net, Pro*C, SQL*Plus) upon the machine you
-intend to install Perl/DBI/DBD-Oracle. You B<do not>, I repeat, I<do not> need
-to build a database on this machine.
-
-After you have installed the Oracle client software, B<test it!>. Make sure you
-can connect to the target database using SQL*Plus (or any other Oracle
-supplied tool). The (gory) details of the install are beyond the scope of
-this document, some information can be found in the section
-L<Compiling on a Client Machine>, or see your friendly Oracle DBA.
-
-=head1 Build your own Perl
-
-HP's default Perl is no good (and antique).
-
-By default, HP-UX 11.00 delivered Perl 5.00503 until September 2001.
-Others tell me that the default is a threaded GNUpro build of 5.6.1.
-This is not what I found on our systems, and it probably depends on which
-packages you install. In any case, this version of Perl delivered by
-HP will in all likelihood not work. Before you check, be sure to prevent
-the perl4 located in /usr/contrib/bin from being the first Perl version
-found in your $PATH.
-
-As of application release September 2001, HP-UX 11.00 is shipped with
-Perl-5.6.1 in /opt/perl. The first occurrence is on CD 5012-7954. The
-build is a portable hppa-1.1 multithread build that supports large files
-compiled with gcc-2.9-hppa-991112. When you have a modern system with a
-hppa-2.0 architecture (PA8xxx processor) and/or the HP C-ANSI-C compiler
-consider building your own Perl, which will surely outperform this
-version.
-
-If you are reading this, you have probably discovered that something did
-not work. To get a working version of the DBD-Oracle driver, we have to start
-with a Perl that as been built with the correct compiler flags and shared
-libraries. This means that you must build your own version of Perl from
-source.
-
-See L<Appendix A> for a copy of a makefile used by me to build
-Perl on HP-UX and all other platforms on which he works (Sun and Red Hat).
-
-The instructions below have been used for building a dynamically linked
-working DBD-Oracle driver that works with mod_perl and Apache. These
-instructions are based on Perl 5.6.0 and 5.6.1, and 5.8.0.
-To this author's knowledge, they have not be tested on earlier versions of Perl.
-
-Note that is important to build a B<non>-threaded Perl, but linked with
--lcl and -lpthread. Since Oracle on HP uses libpthread, everything that
-dynamically loads it (such as DBD-Oracle) must be built/linked
-with '-lpthread -lcl'. (When used with Apache, it and any associated
-modules must also be built this way - otherwise all it does is core
-dump when loading DBD::Oracle).
-
-A good link that explains thread local storage problems is
-http://my1.itrc.hp.com/cm/QuestionAnswer/1,1150,0x0d0a6d96588ad4118fef0090279cd0f9!0,00.html
-
-One more note, it would appear that the README.hpux in the Perl 5.8.0
-directory, is somewhat out of date (and is in the process of being updated
-by H.Merijn Brand, who points out that Perl I<is> 64bit compliant when
-the -Duse64bitall flag is used to Configure. While Perl will be built
-in a pure LP64 environment via the +DD64 flag is used, the +DA2.0w flag
-is preferred, and when an incantation can be concocted that eliminates
-the noisy warnings the produces at link time, this will probably become
-the default. Older 64bit versions of GCC, are known to be unable to
-build a good LP64 perl. And these flags will cause gcc to barf.
-
-=head1 Compilers
-
-=head2 HP Softbench Compiler
-
-Both Roger Foskett, I and most others have been using the HP Softbench
-C compiler normally installed in:
-
- /opt/softbench/bin/cc.
-
-While the DBD-Oracle F<Makefile.PL> checks for some of the
-conditions which, when met, we know will produce a working build,
-there are many variations of Oracle installations and
-features. Not all of these can be tested by any one of us,
-if you discover a way to make a variation which did not previously
-work, please submit patches to the Makefile.PL to Tim Bunce, and
-patches to this README to me, and I will incorporate them into the
-next README.
-
-The instructions herein, have compiled, linked cleanly, and tested
-cleanly using the HP softbench compiler, and Oracle 8.0.5 (32bit), and
-Oracle 8.1.6, 8.1.7 (64 bit). Oracle 8.1.5 will probably work as well.
-
-Oracle 8.1.7.4 (32bit) with DBI-1.35 and DBD-Oracle-1.13 has been proven
-to work on HP-UX 11.00 (64bit) with Perl 5.6.1, Perl 5.8.0, and Perl 5.9.0,
-using the guidelines in this document for both HP-C-ANSI-C and gcc-3.2.
-
-=head2 gcc Compiler
-
-For along time many folks have asked, how they could build a DBD-Oracle
-perl using the gcc compiler, and while some had claimed to have done it,
-none were forth coming with precise (and repeatable) instructions for
-doing so.
-
-Recently, Waldemar Zurowski and Michael Schuh sent useful information
-about builds of Perl with DBD-Oracle using gcc on HP-UX. Both were able
-to get working executables, and their explanations shed much light on
-the issues.
-
-Waldemar's build is described in L<Appendix B>, and Michael's is
-described in L<Appendix C>.
-
-While I have not reproduced either of these configurations, I
-believe the information is complete enough (particularly in the
-aggregate) to be helpful to others who might wish to replicate it.
-
-If someone would be willing to submit a makefile equivalent to
-the makefile in Appendix A, which uses gcc to build Perl and the
-DBI/DBD-Oracle interfaces, I will be happy to include it in the next
-README.
-
-=head2 Just tell me the recipe...
-
-If you are using the softbench compiler, just copy and modify my makefile.
-A copy of this makefile, which I use to build Perl and the DBI interfaces
-(and all other modules I use for that matter) on all platforms (HP, SUN
-and Red Hat) can be found in L<Appendix A>. If you want to skip reading
-the rest of this screed, try copying the makefile into a directory where
-you have all your compressed tar balls, editing the macros at the top,
-and running make.
-
-It you are plan to give gcc a go, consider making modifications
-to this makefile, and sending it back to me, as a GCC example.
-
-=head2 Configure (doing it manually)
-
-Once you have downloaded and unpacked the Perl sources (version 5.6.1
-assumed here), you must configure Perl. For those of you new to building
-Perl from source, the Configure program will ask you a series of questions
-about how to build Perl. You may supply default answers to the questions
-when you invoke the Configure program by command line flags.
-
-We want to build a Perl that understands large files (over 2GB),
-and that is incompatible with v5.005 Perl scripts (compiling with v5.005
-compatibility causes mod_perl to complain about malloc pollution). At the
-command prompt type:
-
- cd perl-5.6.1/
- ./Configure -Ubincompat5005 -Duselargefiles
-
-As described in the section "Building the right Perl", there are some
-modifications you must make during the Configure process... so,
-when asked the question:
-
- What libraries to use? - Answer by prepending (i.e. at the beginning): -lcl -lpthread
-
- For example:
- What libraries to use? [-lnsl -lnm -lndbm -lmalloc -ldld -lm -lc -lndir -lcrypt -lsec] -lcl -lpthread -lnsl -lnm -lndbm -lmalloc -ldld -lm -lc -lndir -lcrypt -lsec
-
-H.Merijn Brand notes that the above can be accomplished by adding the
-following to the ./Configure command line:
-
- -A prepend:libswanted='cl pthread '
-
-Do not forget the space before the trailing quote. Also note that this
-does not (yet) work with 64bit versions of GCC.
-
-I use this in my standard build now. (See L<Appendix A>)
-
-When asked:
-
- Any additional cc flags? - Answer by prepending: +z
-
- For example:
- Any additional cc flags? [-D_HP-UX_SOURCE -Aa] +z -D_HP-UX_SOURCE -Aa
-
-Lastly, and this is optional, when asked:
-
- Do you want to install Perl as /usr/bin/perl? [y] n
-
- You may or may not want to install directly in /usr/bin/perl,
- many persons on HP install Perl in /opt/perl<version>/bin/perl and
- put a symbolic link to /usr/bin/perl. Furthermore, you can supply
- the answer to this question by adding an additional switch to the
- invocation of Configure such as: Configure -Dprefix=/opt/perl
-
-After you have answered the above questions, accept the default values for all
-of the remaining questions. You may press <Enter> for each remaining
-question, or you may enter "& -d" (good idea) at the next question and
-the Configure will go into auto-pilot and use the Perl supplied defaults.
-
-BTW: If you add -lcl and -lpthread to the end of the list it will not
-work. I wasted a day and a half trying to figure out why I had lost the
-recipe, before I realized that this was the problem. The symptom will
-be that
-
- make test
-
-of Perl itself will fail to load dynamic libraries.
-
-You can check in the generated 'config.sh' that the options you selected
-are correct. If not, modify config.sh and then re-run ./Configure with
-the '-d' option to process the config.sh file.
-
-=item Build & Install
-
-
- make
- make test
- make install
-
-If you are going to build mod_perl and Apache it has been suggested
-that you modify Config.pm to the change the HP-UX ldflags & ccdlflags in
-F</your/install/prefix/lib/5.6.0/PA-RISC2.0/Config.pm> as follows:
-
- ccdlflags=''
- cccdlflags='+z'
- ldflags=' -L/usr/local/lib'
-
-This is not necessary if you are not using mod_perl and Apache.
-
-=head1 Build and Install DBI
-
-
- cd DBI-1.35/
- Perl Makefile.PL
- make
- make test
- make install
-
-=head1 Build and Install DBD-Oracle-1.07 and later
-
-It is critical to setup your Oracle environmental variables. Many people
-do this incorrectly and spend days trying to get a working version of
-DBD-Oracle. Below are examples of a local database and a remote database
-(i.e. the database is on a different machine than your Perl/DBI/DBD
-installation) environmental variable setup.
-
-Example (local database):
-
- export ORACLE_USERID=<validuser/validpasswd>
- export ORACLE_HOME=<path to oracle>
- export ORACLE_SID=<a valid instance>
- export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP
- export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both)
-
-Example (remote database):
-
- export ORACLE_USERID=<validuser/validpasswd>
- export ORACLE_HOME=<path to oracle>
- export ORACLE_SID=@<valid tnsnames.ora entry>
- export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP
- export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both)
-
-The standard mantra now works out of the box on HP-UX:
-
- cd DBD-1.07/ #or more recent version
- perl Makefile.PL
- make
- make test
- make install # if all went smoothly
-
-And with DBD-1.14 and later the following can be used:
-
- cd DBD-1.14 / #or more recent version
- perl Makefile.PL -l #-l uses the "new modern method" of constructing the Makefile
- make
- make test
- make install # if all went smoothly
-
-
-If you have trouble, see the L<Trouble Shooting> instructions below, for hints
-of what might be wrong... and send me a note, describing your
-configuration, and what you did to fix it.
-
-=head1 Trouble Shooting
-
-=head2 "Unresolved symbol"
-
-In general, find the symbols, edit the Makefile, and make test.
-
-You'll have to modify the recipe accordingly, in my case the symbol
-"LhtStrCreate" was unresolved. (Authors Note: thanks patch suggestions
-by Jay Strauss this situation which occurs with Oracle 8.1.6 should
-now be handled in Makefile.PL.)
-
-1) Find the symbols.
-
- a) The following ksh/bash code (courtesy of Roger) will search
- from $ORACLE_HOME and below for Symbols in files in lib directories.
- Save the following to a file called "findSymbol".
-
- >>>> CUT HERE <<<<<
- cd $ORACLE_HOME
-
- echo "\nThis takes a while, grepping a lot of stuff"
- echo " ignore the \"no symbols\" warnings\n"
-
- sym=$1; shift;
- libs="*.sl"
-
- for lib in $(find . -name $libs -print); do
- if nm -p $lib | grep -q $sym; then
- echo "found \"$sym\" in $lib"
- fi
- done
- >>>>> CUT HERE <<<<
-
- b) Run it (replace "LhtStrCreate" with your "Unresolved symbol"). For
- example, at my installation, findSymbols produced the following output:
-
- # chmod 755 findSymbols
- # ./findSymbol LhtStrCreate
-
- found "LhtStrCreate" in ./lib/libagtsh.sl
- found "LhtStrCreate" in ./lib/libclntsh.sl
- found "LhtStrCreate" in ./lib/libwtc8.sl
-
-2) Edit the Makefile
-
-In the previous step your unresolved symbol was found in one or more
-library files. You will need to edit the OTHERLDFLAGS makefile macro,
-and add the missing libraries.
-
-When you add those library files to OTHERLDFLAGS you must convert the
-name from the actual name to the notation that OTHERLDFLAGS uses.
-
- libclntsh.sl becomes => -lclntsh
- libagtsh.sl becomes => -lagtsh
- libwtc8.sl becomes => -lwtc8
-
-That is, you replace the "lib" in the name to "-l" and remove the ".sl"
-
-You can edit the Makefile in 2 ways:
-
- a) Do this:
-
- cat Makefile | sed 's/\(OTHERLDFLAGS.*$\)/\1 -lclntsh/' > Makefile.tmp
- mv Makefile.tmp Makefile
-
- b) Using vi, emacs... edit the file, find OTHERLDFLAGS, and add the
- above "-l" entries to the end of the line.
-
- For example the line:
- OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr
-
- Becomes:
- OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr -lclntsh
-
-3) make test
-
-Perform a make test, if symbols are still unresolved repeat the editing of
-the Makefile and make test again.
-
-=head1 DBD-Oracle-1.06
-
-You are strongly urged to upgrade. However here is what you may
-need to know to get it or work, if you insist on using an earlier
-version.
-
-Check the output that above command produces, to verify that
-
- -Wl,+n
- -W1,+s
-
-is b<NOT> present. and that
-
- -lqsmashr
-
-B<is> present.
-
-If the version of Makefile.PL does not include the patch produced at the time
-of this README.hpux, then the above conditions will likely not be met.
-You can fix this as follows:
-
- cat Makefile | sed 's/-Wl,+[sn]//' > Makefile.tmp
- mv Makefile.tmp Makefile
-
-
-=head1 Building on a Oracle Client Machine
-
-If you need to build or deliver the DBD-Oracle interface on or to
-a machine upon which the Oracle database has not been installed
-you need take the following into consideration:
-
-=over
-
-=item 1) Oracle files are needed for DBD::Oracle to compile
-
-=item 2) Oracle files are needed for the compiled DBD to connect
-
-=item 3) ORACLE_HOME environment variable must be set
-
-=item 4) SHLIB_PATH environment variable must be set
-
-=back
-
-=head2 Compiling on a Client Machine
-
-This may seem obvious to some, but the Oracle software has to be
-present to compile and run DBD-Oracle. The best way to compile and
-install on a client machine, is to use the oracle installer
-to install the oracle (client) software locally. Install SQL*Net, Pro*C
-and SQL*Plus. After this some tests with SQL*Net (tnsping at a minimum)
-are an good idea. Make sure you can connect to your remote database,
-and everything works with Oracle before you start bashing your head into
-the wall trying to get DBD-Oracle to work.
-
-If you do not have the Oracle installer handy, the following hack has been
-known to work:
-
-Either open an NFS share from the oracle installation directory on the
-machine that has Oracle and point both of the above-mentioned env vars to
-that share, or alternatively copy the following four directories from your
-Oracle installation over to the machine on which you are compiling the DBD:
-
-drwxr-xr-x 3 oracle dba 3072 Jul 3 09:36 lib
-drwxr-xr-x 13 oracle dba 512 Jul 3 09:38 network
-drwxr-xr-x 7 oracle dba 512 Jul 2 19:25 plsql
-drwxr-xr-x 12 oracle dba 512 Jul 3 09:38 rdbms
-
-then point the above-mentioned env vars to the containing directory (good
-place to put them, if copying locally, might be /usr/lib/oracle,
-/usr/local/lib/oracle, or /opt/oracle/lib )
-
-In any case, the compiler needs to be able to find files in the above four
-directories from Oracle in order to get all the source code needed to
-compile properly.
-
-=head2 Required Runtime environment
-
-Again, use the Oracle installer to install the Oracle Client on the machine
-where your scripts will be running. If the Oracle installer is not available,
-the following hack should suffice:
-
-For running the compiled DBD in Perl and connecting, you need only the
-files in the 'lib' folder mentioned above, either connecting to them through
-an NFS share on the Oracle machine, or having copied them directly onto the
-local machine, say, in /usr/lib/oracle . Make sure the env variable for
-ORACLE_HOME = /usr/lib/oracle and LD_LIBRARY_PATH includes /usr/lib/oracle .
-You can set the env var in your perl script by typing
-
-$ENV{'ORACLE_HOME'} = '/usr/lib/oracle';
-
-=head1 Apache and mod_perl
-
-B<Nota Bene:> these instructions are now more than a year and a half old,
-you may have to tinker.
-
-If you are not building this version of Perl for Apache you can go on
-to build what ever other modules you require. The following instructions
-describe how these modules were built with the Perl/DBD-Oracle built above:
-The following is what worked for Roger Foskett:
-
-
-=head1 Apache Web server
-
- cd apache_1.3.14/
- LDFLAGS_SHLIB_EXPORT="" \
- LDFLAGS="-lm -lpthread -lcl" \
- CC=/usr/bin/cc \
- CFLAGS="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" \
- ./configure \
- --prefix=/opt/www/apache \
- --enable-shared=max \
- --disable-rule=EXPAT \
- --enable-module=info \
- --enable-rule=SHARED_CORE
-
-The Expat XML parser is disabled as it conflicts with the Perl
-XML-Parser module causing core dumps. -lcl is needed to ensure that Apache does
-not coredump complaining about thread local storage
-
- make
- make install
-
-Once installed, ensure that the generated httpd.conf is properly
-configured, change the relevant lines to below (the default user/group
-caused problems on HP (the user 'www' may need to be created)
-
- User www
- Group other
- port 80
-
-=head2 mod_perl
-
- cd mod_perl-1.24_01/
- perl Makefile.PL \
- NO_HTTPD=1 \
- USE_APXS=1 \
- WITH_APXS=/opt/www/apache/bin/apxs \
- EVERYTHING=1
- make
- make install
-
-=head2 htdig intranet search engine
-
- cd htdig-3.1.5/
- CC='cc' CPP='aCC' \
- ./configure \
- --prefix=/opt/www/htdig \
- --with-cgi-bin-dir=/opt/www/htdig/cgi-bin \
- --with-image-dir=/opt/www/htdig/images
-
-=head1 CONTRIBUTORS
-
-The following folks contributed to this README:
-
- Lincoln A. Baxter <lbaxter@fleetcc.com>
- or labaxter@comcast.net>
- Jay Strauss <me@heyjay.com>
- Roger Foskett <Roger.Foskett@icl.com.Fix.This>
- Weiguo Sun <wesun@cisco.com.Fix.This>
- Tony Foiani <anthony_foiani@non.hp.com.Fix.This>
- Hugh J. Hitchcock <hugh@hitchco.com.Fix.This>
- Heiko Herms <Heiko.Herms.extern@HypoVereinsbank.de.Fix.This>
- Waldemar Zurowski <bilbek0@poczta.onet.pl.Fix.This>
- Michael Schuh <Michael.Schuh@airborne.com.Fix.This>
- H.Merijn Brand <h.m.brand@hccnet.nl.Fix.This>
-
-And probably others unknown to me.
-
-=head1 AUTHOR
-
- Lincoln A. Baxter
- Application Development and Support, Fleet Credit Card Services
- lbaxter@fleetcc.com or labaxter@comcast.net
-
-=head1 Appendix A (Lincoln's makefile)
-
-The following is the text of the makefile I use to build Perl on all platforms
-I run on. If you paste this to a text file, remember to remove leading blanks from
-the target lines, and replace leading blanks on the rule lines with TAB characters.
-
-
- # makefile for rebuilding perl and all the modules we have built
- # or for rebuilding individual modules
- SHELL=/usr/bin/ksh
- CPAN_VERSION=5.6.1
- FCCS_VERSION=fccs-03
- #needed for compatibility with ../build.mk:
- TOOL=perl
- PERL_VERSION=$(TOOL)-$(CPAN_VERSION)
- TOP=/opt/oss
- PERLDIR=$(PERL_VERSION)-$(FCCS_VERSION)
- PERL_ROOT=$(TOP)/pkg
- PREFIX=$(PERL_ROOT)/$(PERLDIR)
- #needed for compatibility with ../biuld.mk:
- VERSION=$(CPAN_VERSION)-$(FCCS_VERSION)
-
- MQS=MQSeries-1.14
- DBDORA=DBD-Oracle-1.12
- DBI=DBI-1.20
- EXPAT_VER=-1.95.2
- MQSERVER='PERL_CHANNEL/TCP/dsas105(1414)'
-
- MODULES=\
- libnet-1.0703 \
- Storable-0.7.2 \
- Time-HiRes-01.20 \
- Net-Daemon-0.35 \
- Digest-MD5-2.16 \
- Digest-SHA1-2.01 \
- Digest-HMAC-1.01 \
- MIME-Base64-2.12 \
- Net-DNS-0.19 \
- Mail-CheckUser-1.13 \
- Proc-Daemon-0.02 \
- Proc-Simple-1.14 \
- Openview-Message-0.01 \
- Business-CreditCard-0.26 \
- Data-UUID-0.06
-
- XML_PARSER=XML-Parser-2.31
- XML_MODULES= \
- XML-Simple-1.05 \
- XML-Generator-0.8
- #this does not behave same as 0.8
- #XML-Generator-0.91
-
- all: testOracleVar
- @banner ALL_PERL
- @echo "using perl PATH=$(PREFIX)/bin"
- ( export PATH=$(PREFIX)/bin:$$PATH && make perl )
- ( export PATH=$(PREFIX)/bin:$$PATH && make all_modules )
-
- print_macros:
- @echo TOOL=$(TOOL)
- @echo CPAN_VERSION=$(CPAN_VERSION)
- @echo PERL_VERSION=$(PERL_VERSION)
- @echo FCCS_VERSION=$(FCCS_VERSION)
- @echo PREFIX=$(PREFIX)
- @echo VERSION=$(VERSION)
- @echo PERLDIR=$(PERLDIR)
- @echo PERL_ROOT=$(PERL_ROOT)
-
- all_modules: modules xmlparser xml_modules dbi dbd mqs
-
- modules : testPath
- rm -rf $(MODULES)
- for m in $(MODULES); do \
- make module MODULE=$$m PREFIX=$(PREFIX) ; \
- done
-
- xml_modules : testPath
- rm -rf $(XML_MODULES)
- for m in $(XML_MODULES); do \
- make module MODULE=$$m PREFIX=$(PREFIX) ; \
- done
-
- dbi : testPath
- make module MODULE=DBI-1.20 PREFIX=$(PREFIX)
-
- dbd : testPath testOracleVar dbi touch.d/$(DBDORA).tch
-
- touch.d:
- mkdir touch.d
-
- xmlparser: touch.d/$(XML_PARSER).tch
- touch.d/$(XML_PARSER).tch : $(XML_PARSER).tar.gz
- tar -zxvf $(XML_PARSER).tar.gz
- ( cd $(XML_PARSER) && \
- perl Makefile.PL EXPATLIBPATH=$(TOP)/lib \
- EXPATINCPATH=$(TOP)/include && \
- make && \
- make test && \
- make install )
- rm -rf $(XML_PARSER)
- touch $@
-
- #chmod +w CONFIG;
- mqs_config:
- ( cd $(MQS); \
- mv CONFIG CONFIG.orig; \
- cp ../$$(uname).MQS.CONFIG CONFIG \
- )
-
- mqs_target:
- ( export MQSERVER=$(MQSERVER); \
- cd $(MQS) ;\
- make $(MQS_TARGET) \
- )
-
- mqs_build:
- ( export MQSERVER=$(MQSERVER); \
- cd $(MQS) ;\
- cp ../$$(uname).MQS.CONFIG ./CONFIG; \
- perl Makefile.PL; \
- make ; \
- )
-
- mqs : testPath /opt/mqm touch.d/$(MQS).tch
- touch.d/$(MQS).tch:
- @banner $(MQS)
- rm -rf $(MQS)
- gunzip -c $(MQS).tar.gz | tar -xvf -
- touch $(MQS)/.LICENSE.ACCEPTED
- make -s mqs_config
- make -s mqs_build
- make -s mqs_target MQS_TARGET=test
- make -s mqs_target MQS_TARGET=install
- touch $@
-
-
- touch.d/$(DBDORA).tch: testOracleVar
- @banner $(DBDORA)
- test ! -z "$(ORACLE_HOME)"
- -rm -rf $(DBDORA)
- gunzip -c $(DBDORA).tar.gz | tar -xf -
- cd $(DBDORA) ;\
- perl Makefile.PL; \
- make ; \
- make test ; \
- make install
- touch touch.d/$(DBDORA).tch
-
-
- perl : testVar $(PERL_VERSION) touch.d/$(PERL_VERSION).tch
-
- touch.d/$(PERL_VERSION).tch:
- @banner perl
- @if ls $(PREFIX) >/dev/null 2>&1 ; \
- then \
- echo "Error: Cannot install to an existing directory" ;\
- echo "Error: Please delete or move $(PREFIX)" ;\
- exit 1;\
- fi
- - cd $(PERL_VERSION); make distclean;
- cd $(PERL_VERSION); \
- ./Configure -Dprefix=$(PREFIX) -Ubincompat5005 -Uuselargefiles \
- -A eval:libswanted='\"cl pthread $$libswanted\" ' -des; \
- make ; \
- make test; \
- make install
- touch touch.d/$(PERL_VERSION).tch
-
- realclean distclean: clean_tch
- -rm -rf $(PERL_VERSION)
-
- clean : clean_tch
- clean_tch :
- -rm -f touch.d/*.tch
-
- module : touch.d/$(MODULE).tch
-
- touch.d/$(MODULE).tch :
- @banner $(MODULE)
- -rm -rf $(MODULE)
- gunzip -c $(MODULE).tar.gz | tar -xf -
- cd $(MODULE); \
- perl Makefile.PL </dev/null; \
- make test ; \
- if test -r Skipit_Makefile.aperl; then \
- make -f Makefile.aperl inst_perl MAP_TARGET=perl; \
- fi ;\
- make install
- rm -rf $(MODULE)
- touch touch.d/$(MODULE).tch
-
- $(PERL_VERSION):
- @if ls $(PREFIX) >/dev/null 2>&1 ; \
- then \
- echo "Error: Cannot install to an existing directory" ;\
- echo "Error: Please delete or move $(PREFIX)" ;\
- exit 1;\
- fi
- gunzip -c $(PERL_VERSION).tar.gz |tar xf -
- @echo "untar of perl is done"
-
- testVars : testVar testPath testOracleVar
-
- testVar: touch.d
- @echo "******** Building to: $(PREFIX) *********"
-
- testOracleVar:
- @if test -z "$$ORACLE_HOME" ; \
- then \
- echo " Please set \"export ORACLE_HOME=<value>\"" ;\
- exit 1; \
- else \
- echo ORACLE_HOME=$(ORACLE_HOME); \
- fi
- @if test -z "$$ORACLE_USERID" ; \
- then \
- echo " Please set \"export ORACLE_USERID=<username/password@dbname>\"" ;\
- exit 1; \
- else \
- echo ORACLE_USERID=$(ORACLE_USERID); \
- fi
-
- testPath:
- @if echo $$PATH | egrep -q '^$(PREFIX)/bin:'; then \
- echo PATH is OK; \
- else \
- echo "ERROR: You must have $(PREFIX)/bin first in your path as follows:" ;\
- echo " export PATH=$(PREFIX)/bin:\$$PATH" ;\
- exit 1; \
- fi
-
-
-
-=head1 Appendix B (gcc build info from Waldemar Zurowski)
-
-This is pretty much verbatim the build information I received from Waldemar Zurowski
-on building Perl and DBD-Oracle using gcc on HP. Note that this build was on
-a PA-RISC1.1 machine. Differences for building on PA-RISC2.0 would be welcome and
-incorporated into the next README.
-
-=head2 Host
-
- HP-UX hostname B.11.11 U 9000/800 XXXXXXXXX unlimited-user license
-
-=head2 Oracle
-
- Oracle 8.1.7
-
-=head2 Parameters to build Perl
-
- ./Configure -des -Uinstallusrbinperl -Uusethreads -Uuseithreads
- -Duselargefiles -Dcc=gcc -Darchname=PA-RISC1.1 -Dprefix=/opt/perl-non-thread
- -Dlibs='-lcl -lpthread -L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads
- -ljava -lnsl -lnm -lndbm -ldld -lm -lc -lndir -lcrypt -lsec'
-
--L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads -ljava, was added
-because DBD::Oracle wants to link with it (probably due to Oracle's own
-build rules picked up by Makefile.PL)
-
-Set environment variable LDOPTS to '+s' (see ld(1)). This holds
-extra parameters to HP-UX's ld command, as I don't use GNU ld (does anybody?).
-This allows you to build an executable, which when run would search for
-dynamic linked libraries using SHLIB_PATH (for 32-bit executable)
-and LD_LIBRARY_PATH (for 64-bit executable). Obviously LDOPTS is
-needed only when building Perl _and_ DBI + DBD::Oracle.
-
-Then, after building Perl + DBI + DBD::Oracle and moving it
-into production environment it was enough to add to SHLIB_PATH
-${ORACLE_HOME}/lib and ${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads,
-for example:
-
-SHLIB_PATH=${ORACLE_HOME}/lib:${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads:
-$SHLIB_PATH
-
-Please note output of ldd command:
-
- $ ldd -s ./perl
- [...]
- find library=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl;
- required by ./perl
- search path=/home/ora817/lib:/home/ora817/JRE/lib/PA_RISC/native_threads
- (SHLIB_PATH)
- trying path=/home/ora817/lib/libjava.sl
- trying path=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl
- /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl =>
- /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl
- [...]
-
-All of this mess is necessary because of weakness of shl_load(3X),
-explained in current README.hpux and in some discussion forums at HP.com
-site. I have learned, that HP issued patch PHSS_24304 for HP-UX 11.11
-and PHSS_24303 for HP-UX 11.00, which introduced variable LD_PRELOAD.
-I haven't tried it yet, but it seems promising that it would allow you
-to completely avoid building your own Perl binary, as it would be enough
-to set LD_PRELOAD to libjava.sl (for example) and all 'Cannot load XXXlibrary'
-during building of DBD::Oracle should be gone.
-
-The documentation says, that setting this variable should have the same
-effect as linking binary with this library. Also please note, that this
-variable is used only when binary is not setuid nor setgid binary (for
-obvious security reasons).
-
-It seems, that the best way to find out if you already have this patch
-applied, is to check if 'man 5 dld.sl' says anything about LD_PRELOAD
-environment variable.
-
-Best regards,
-
-Waldemar Zurowski
-
-Authors Note: Search for references to LD_PRELOAD else where in this
-document. Using LD_PRELOAD is probably a fragile solution at best. Better
-to do what Waldemar actually did, which is to include libjava in the extra
-link options.
-
-=head1 Appendix C (Miscellaneous links which might be useful)
-
-Michael Schuh writes:
-
-It was a bit by trial and error and a bit more by following your
-suggestions (and mapping them to gcc) that I got something that worked.
-
-One of the most significant "mappings" was to take your suggestion under
-"Configure" to add "+z" to the ccflags variable and to change that to
-"-fPIC" (which, I learned from the gcc man page, is different than
-"-fpic" - I'm not sure if this is a significant difference, and, no, I
-don't want to experiment!).
-
-I suspect that your hint about adding -lcl and -lpthread were crucial,
-but (after doing so) I never encountered any problems that were related
-to them.
-
-One thing that I did was create a shell script to set some variables,
-as the initial environment for root on the target system didn't work
-very well. Here is that script, trimmed to remove a bunch of echo
-statements, etc.:
-
- # -------------------------------------------------------------------
- # root.env - sets some environment variables the way I want them...
- #
- # Mike Schuh, June 2002, July 2002
-
- export CC=/usr/local/bin/gcc
-
- export INSTALL=./install-sh
-
- . appl_setup DDD
-
- export ORACLE_SID="SSS"
- export ORACLE_USERID="XXX/YYY"
-
- export PATH=/usr/local/bin:/usr/sbin:/usr/bin:/usr/ccs/bin:/opt/perl5/bin:/usr/c
- ontrib/bin:/opt/nettladm/bin:/opt/fc/bin:/opt/fcms/bin:/opt/pd/bin:/usr/bin/X11:
- /usr/contrib/bin/X11:/opt/hparray/bin:/opt/resmon/bin:/usr/sbin/diag/contrib:/op
- t/pred/bin:/opt/gnome/bin:/sbin
-
- # end of root.env
-
-The appl_setup sets some Oracle variables (specific to our installation),
-which I then override for the database that I am working on. The script
-(which I source) also unse some variables specific to other applications
-(e.g., Tivoli), mostly to unclutter my debugging. The INSTALL variable
-is related to building libgdbm.
-
-Here is the output of perl -V:
-
- $ perl -V
- Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
- Platform:
- osname=hpux, osvers=11.00, archname=PA-RISC1.1
- uname='hp-ux SYSTEMNAME b.11.00 a 9000800 2002134832 two-user license '
- config_args='-Ubincompat5005 -Dcc=gcc -Duselargefiles'
- hint=previous, useposix=true, d_sigaction=define
- usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
- useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
- use64bitint=undef use64bitall=undef uselongdouble=undef
- Compiler:
- cc='gcc', ccflags ='-D_HPUX_SOURCE -L/lib/pa1.1 -DUINT32_MAX_BROKEN -fno-strict-aliasing -I/usr/local/include -fPIC',
- optimize='-O',
- cppflags='-D_HPUX_SOURCE -L/lib/pa1.1 -DUINT32_MAX_BROKEN -fno-strict-aliasing -I/usr/local/include -fPIC'
- ccversion='', gccversion='3.0.4', gccosandvers='hpux11.00'
- intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
- d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
- ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
- alignbytes=8, usemymalloc=y, prototype=define
- Linker and Libraries:
- ld='ld', ldflags =' -L/usr/local/lib'
- libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib
- libs=-lcl -lpthread -lnsl -lnm -lndbm -lgdbm -ldld -lm -lc -lndir -lcrypt -lsec
- perllibs=-lcl -lpthread -lnsl -lnm -ldld -lm -lc -lndir -lcrypt -lsec
- libc=, so=sl, useshrplib=false, libperl=libperl.a
- Dynamic Linking:
- dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-B,deferred '
- cccdlflags='-fPIC', lddlflags='-b -L/usr/local/lib'
-
- Characteristics of this binary (from libperl):
- Compile-time options: USE_LARGE_FILES
- Built under hpux
- Compiled at Jul 18 2002 15:28:03
- @INC:
- /usr/local/lib/perl5/5.6.1/PA-RISC1.1
- /usr/local/lib/perl5/5.6.1
- /usr/local/lib/perl5/site_perl/5.6.1/PA-RISC1.1
- /usr/local/lib/perl5/site_perl/5.6.1
- /usr/local/lib/perl5/site_perl
- .
-
-
-=head1 Appendix D (Miscellaneous links which might be useful)
-
-=head2 https://www.beepz.com/personal/merijn/ or http://www.cmve.net/~merijn/
-
-H.Merijn Brand has placed reasonably recent Perl binary distributions
-here that already include the DBI that was current when the build was
-created. These builds are created using the most recent version of gcc
-available at that time. The gcc used to create the build, including the
-matching binutils and gdb are available from the same page. These Perl
-binaries are I<Oracle prepared>, meaning that the libraries that Oracle
-requires are linked in.
-
-Thanks to Tony Foiani for these references:
-
-=head2 http://marc.theaimsgroup.com/?l=perl-dbi&m=96040350416305&w=2
-
-This link discusses older version of the DBI/DBD interface, so most of
-the code examples are probably no longer relevant. This was written
-by Jeff Okamoto at HP (the author of the README.hpux in the Perl
-sources). And has some useful insights.
-
-=head2 http://www.sas.com/service/techsup/unotes/SN/001/001875.html
-
-This is a not from from the SAS support people documenting the LhtStrInsert()
-and LhtStrCreate() undefined symbols errors, and how to fix them in the
-Oracle makefiles.
-
-=head2 http://www.mail-archive.com/dbi-users%40isc.org/msg13967.html
-
-My employer's web sniffer does not allow me browse this link (www.mail) in the
-URL. So I have no idea how helpful this might be. It might even be a link
-to my own posts.
-
-=head1 Appendix E (Perl Configuration Dumps)
-
-The following to sections provide full dumps of perl -V for three
-versions of Perl that were successfully built and linked on
-HP-UX 11.00.
-
-=head2 Lincoln Baxter's DBD-Oracle-1.07 Configuration
-
- Platform:
- osname=hpux, osvers=11.11, archname=PA-RISC2.0
- uname='hp-ux dhas116 b.11.11 u 9000800 1509760598 unlimited-user license '
- config_args='-Dprefix=/opt/perl/5.6.1-fccs-02 -Ubincompat5005 -Uuselargefiles \
- -A eval:libswanted=\"cl pthread $libswanted\" -des'
- hint=recommended, useposix=true, d_sigaction=define
- usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
- useperlio=undef d_sfio=undef uselargefiles=undef usesocks=undef
- use64bitint=undef use64bitall=undef uselongdouble=undef
- Compiler:
- cc='cc', ccflags ='-D_HP-UX_SOURCE -Aa',
- optimize='-O',
- cppflags='-D_HP-UX_SOURCE -Aa'
- ccversion='B.11.11.02', gccversion='', gccosandvers=''
- intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
- d_longlong=undef, longlongsize=, d_longdbl=define, longdblsize=16
- ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
- alignbytes=8, usemymalloc=y, prototype=define
- Linker and Libraries:
- ld='ld', ldflags =' -Wl,+vnocompatwarnings -L/usr/local/lib -L/opt/gnu/lib'
- libpth=/usr/local/lib /opt/gnu/lib /lib /usr/lib /usr/ccs/lib
- libs=-lcl -lpthread -lnsl -lnm -lndbm -ldld -lm -lc -lndir -lcrypt -lsec
- perllibs=-lcl -lpthread -lnsl -lnm -ldld -lm -lc -lndir -lcrypt -lsec
- libc=/lib/libc.sl, so=sl, useshrplib=false, libperl=libperl.a
- Dynamic Linking:
- dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-B,deferred '
- cccdlflags='+z', lddlflags='-b +vnocompatwarnings -L/usr/local/lib -L/opt/gnu/lib'
-
-
- Characteristics of this binary (from libperl):
- Compile-time options:
- Built under hpux
- Compiled at Feb 26 2002 22:05:51
- %ENV:
- PERL5LIB="/home/baxtlinc/local/lib:/home/baxtlinc/perl/lib"
- @INC:
- /home/baxtlinc/local/lib
- /home/baxtlinc/perl/lib
- /opt/perl/5.6.1-fccs-02/lib/5.6.1/PA-RISC2.0
- /opt/perl/5.6.1-fccs-02/lib/5.6.1
- /opt/perl/5.6.1-fccs-02/lib/site_perl/5.6.1/PA-RISC2.0
- /opt/perl/5.6.1-fccs-02/lib/site_perl/5.6.1
- /opt/perl/5.6.1-fccs-02/lib/site_perl
-
-
-=head2 Lincoln Baxter's DBD-Oracle-1.06 Configuration
-
- Platform:
- osname=hpux, osvers=11.00, archname=PA-RISC2.0
- uname='hp-ux dhdb108 b.11.00 u 9000800 612309363 unlimited-user license '
- config_args='-Dprefix=/temp_data/baxtlinc/perl -Ubincompat5005'
- hint=previous, useposix=true, d_sigaction=define
- usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
- useperlio=undef d_sfio=undef uselargefiles=define
- use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
- Compiler:
- cc='cc', optimize='-O', gccversion=
- cppflags='-D_HP-UX_SOURCE -I/usr/local/include +z -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -Ae'
- ccflags ='-D_HP-UX_SOURCE -I/usr/local/include +z -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -Ae'
- stdchar='unsigned char', d_stdstdio=define, usevfork=false
- intsize=4, longsize=4, ptrsize=4, doublesize=8
- d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
- ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
- alignbytes=8, usemymalloc=y, prototype=define
- Linker and Libraries:
- ld='ld', ldflags =' -Wl,+vnocompatwarnings'
- libpth=/lib /usr/lib /usr/ccs/lib
- libs=-lnsl -lnm -lndbm -ldld -lm -lc -lndir -lcrypt -lsec -lcl -lpthread
- libc=, so=sl, useshrplib=true, libperl=libperl.sl
- Dynamic Linking:
- dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-B,deferred '
- cccdlflags='+z', lddlflags='-b +vnocompatwarnings'
-
- Characteristics of this binary (from libperl):
- Compile-time options: USE_LARGE_FILES
- Built under hpux
- Compiled at Jan 9 2001 17:36:00
- @INC:
- /temp_data/baxtlinc/perl/lib/5.6.0/PA-RISC2.0
- /temp_data/baxtlinc/perl/lib/5.6.0
- /temp_data/baxtlinc/perl/lib/site_perl/5.6.0/PA-RISC2.0
- /temp_data/baxtlinc/perl/lib/site_perl/5.6.0
- /temp_data/baxtlinc/perl/lib/site_perl
- .
-
-
-=head2 Roger Foskett's Configuration (works with Apache and mod_perl)
-
- Platform:
- osname=hpux, osvers=11.00, archname=PA-RISC2.0
- uname='hp-ux titan b.11.00 u 9000800 103901567 unlimited-user license '
- config_args='-Ubincompat5005'
- hint=recommended, useposix=true, d_sigaction=define
- usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
- useperlio=undef d_sfio=undef uselargefiles=define
- use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
- Compiler:
- cc='cc', optimize='-O', gccversion=
- cppflags='-D_HP-UX_SOURCE -Aa -I/usr/local/include'
- ccflags =' +z -D_HP-UX_SOURCE -I/usr/local/include -D_LARGEFILE_SOURCE
- -D_FILE_OFFSET_BITS=64 -Ae '
- stdchar='unsigned char', d_stdstdio=define, usevfork=false
- intsize=4, longsize=4, ptrsize=4, doublesize=8
- d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
- ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
- lseeksize=8
- alignbytes=8, usemymalloc=y, prototype=define
- Linker and Libraries:
- ld='ld', ldflags =' -L/usr/local/lib'
- libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib
- libs=-lnsl -lnm -lndbm -lgdbm -ldld -lm -lc -lndir -lcrypt -lsec -lcl
- -lpthread
- libc=/lib/libc.sl, so=sl, useshrplib=false, libperl=libperl.a
- Dynamic Linking:
- dlsrc=dl_hpux.xs, dlext=sl, d_dlsymun=undef, ccdlflags=' '
- cccdlflags='+z', lddlflags=' -b +vnocompatwarnings -L/usr/local/lib'
-
- Characteristics of this binary (from libperl):
- Compile-time options: USE_LARGE_FILES
- Built under hpux
- Compiled at Dec 19 2000 19:17:00
- @INC:
- /opt/www/perl5/lib/5.6.0/PA-RISC2.0
- /opt/www/perl5/lib/5.6.0
- /opt/www/perl5/lib/site_perl/5.6.0/PA-RISC2.0
- /opt/www/perl5/lib/site_perl/5.6.0
- /opt/www/perl5/lib/site_perl
- .
-
-
-Roger also provides a link to some threads containing some of his
-DBD-Oracle and HP-UX 11 trials...
-L<http://www.geocrawler.com/search/?config=183&words=Roger+Foskett>
-
-
-=head1 Appendix F (Why Dynamic Linking)
-
-Some one posted to the DBI email list the following question:
-
- What are the advantages of building a dynamically linked version?
- Being able to use threads? Or something besides that?
-
-The answer is there are too many to count, but here are several big
-ones:
-
-=over
-
-=item 1 Much smaller executables
-
-Only the code referenced gets loaded... this
-means faster execution times, and less machine resources (VM) used)
-
-=item 2 Modular addition and updating of modules.
-
-This is HUGE. One does not relink B<EVERYTHING, EVERY time> one changes
-or updates a module.
-
-=item 3 It eliminates Dynaloader warning (multiply defined).
-
-This occurs with the static build when Perl is run with -w. I fixed
-this by removing -w from my #! lines, converting the the pragam "use
-warnings;". However, it was annoying, since all my scripts had -w in the
-#! line.
-
-=item 4 It's the default build
-
-Since almost every OS now supports dynamic linking, I believe that
-static linking is NOT getting the same level of vetting it maybe used
-to. Dynamicly linking is what you get by default, so its way better
-tested.
-
-=item 5 It's required for Apache and mod_perl.
-
-=back
-
-=head1 Appendix G (RE problem with libjava.sl)
-
-The following is a message I received from Jon Stevenson concerning a
-problem with the libjava.sl. Note that the gcc build described in
-L<Appendix B> also describes a problem with libjava.sl, which was solved
-by putting it in the extra libraries option at configure time. That is
-probably a preferable solution.
-
-
- -----Original Message-----
- From: Stevenson, Jonathan [mailto:Jonathan.Stevenson@infores.com.Fix.This]
- Sent: Wednesday, March 27, 2002 6:31 AM
- To: LBaxter@FLEETCC.COM.Fix.This
- Cc: dbi_users@perl.org
- Subject: RE: Error on make for DBD-Oracle 1.12 on HP-UX 11.0
-
- Hi Lincoln,
-
- Thanks for your help with this. We now have a working installation,
- although we still do have some issues to resolve still. The problem
- seems to be the libjava.sl library. Running the make test step
- generated this message: Can't shl_load() a library containing Thread
- Local Storage.
-
- We have got round this by setting the LD_PRELOAD to point to the
- library - $ORACLE_HOME/JRE/lib/PA_RISC/native_threads/libjava.sl. The
- make test passes OK, and make install works. My DBI test script is
- able to do some basic stuff, so presumably it is OK.
-
- There are some problems remaining with it, though. You have to
- set the LD_PRELOAD variable before running any perl against Oracle
- (as I guess the library does not get built into the DBD). We have
- also noticed that if you set LD_PRELOAD as above, then run swlist,
- the system coredumps (swlist works normally without this set).
-
- This worries me, as it may cause other commands to coredump, so we
- will need to try to extensively roadtest this before we can move
- into production.
-
- The libjava.sl library is only required for an advanced authentication
- module that we do not use, so we are hoping that we can remove this
- from our Oracle installation, and get around the problem this way.
-
- We did manage to install DBD on one of our boxes before Xmas without
- this problem, so we know that it can be done, we have just lost the
- recipe that we need. If anyone has any suggestions that we could try,
- we would be grateful. It is also worth noting that this error was what
- hung us up trying to get gcc to work, so with this option, we may be
- able to push forward on this. We will give it a go on another box,
- and post if we get any joy from this.
-
- I have included the recipe that we have used below. This does produce
- a working build, we are just a little concerned about the side effects.
-
- Cheers,
-
- Jon
-
-
- Machine specs:
-
- HP-UX 11.00
- Oracle 8.1.6 client
- HP ANSI C compiler (B.11.02.03)
-
-
- Downloaded:
-
- Perl 5.6.1 From http://www.cpan.org/src/index.html
- <http://www.cpan.org/src/index.html> (Stable release)
-
- DBI 1.21 From http://search.cpan.org/search?dist=DBI
- <http://search.cpan.org/search?dist=DBI>
- DBD:Oracle 1.12 From http://search.cpan.org/search?module=DBD::Oracle
- <http://search.cpan.org/search?module=DBD::Oracle>
-
- Create /tmp/perl temporary area and extract tar files
-
- cd /tmp/perl/perl-5.6.1
- ../Configure -Ubincompat5005
- #Prepend additional libraries with "-lcl -lpthread"
- #Prepend cc flags with "+z"
-
- make
- make test
- make install
-
- Install DBI
-
- cd /tmp/perl/DBI-1.21
- perl Makefile.PL
- make
- make test
- make install
-
-
- Install DBD:Oracle
-
- #Set the Oracle environment
- export ORACLE_HOME=/oracle/app/oracle/product/8.1.6
- export SHLIB_PATH=/usr/lib:/oracle/app/oracle/product/8.1.6/lib
- export ORACLE_SID=sid
- export ORACLE_USERID=userid/password@sid
- export LD_LIBRARY_PATH=/oracle/app/oracle/product/8.1.6/lib
-
- export LD_PRELOAD=/oracle/app/oracle/product/8.1.6/JRE/lib/PA_RISC/native_threads/libjava.sl
- # Need to prevent libjava.sl TLS error - need to do this for runtime as well
-
- cd /tmp/perl/DBD-Oracle-1.12
- perl Makefile.PL
-
- cat Makefile | sed 's/PERL_DL_NONLAZY=1/PERL_DL_NONLAZY=0/g' > Makefile.tmp
- # Need to force load of all libraries
- mv Makefile.tmp Makefile
- make
- make test
- make install
-
- Apparently Oracle stored the 64 bit libraries in .../lib & .../rdbms/lib.
- 32 bit libraries are available in .../lib32 and .../rdbms/lib32. I'm forced
- to stay with Perl 32bit & the workaround is to manually edit the resulting
- Makefile. Anyone have a patch to detect & correct this situation?
-
- John Schaefer
-
- BAESystems, San Diego
@@ -1,322 +0,0 @@
-README.java
-
-This file relates to a specific problem on Solaris platforms
-for Oracle 8.1.6 (and possibly later versions) where loading
-DBD::Oracle fails with an error message like:
-
- ``You must install a Solaris patch to run this version of
- the Java runtime.
- Please see the README and release notes for more information.''
-
-The problem seems to be that:
-
-1/ By default, the Oracle shared library contains a ``Radius
- authentication module'' that is implemented in Java.
-2/ The Java implementation requires that the thread library is
- also linked into the application.
-3/ For some inexplicable reason the thread library has to be
- linked to the executable that's doing the dynamic loading.
- It's is not sufficient to link -lthread to DBD::Oracle.
-
-There are several ways to workaround this:
-
-1/ Remove the Radius authentication module if you don't need it.
- This requires you to perform surgery on the Oracle installation.
- (If the name Radius doesn't mean anything to you and you're
- the person maintaining the Oracle installation then you almost
- certainly don't need it.)
-
-2/ Use the LD_PRELOAD environment variable to force the pre-loading
- of the thread library. Note that this must be set before perl
- starts, you can't set it via $ENV{LD_PRELOAD} within the script.
-
-3/ Link the thread library to your perl binary.
- You can do that either by (re)building perl with thread support
- or, I believe, it should be possible to issue a magic 'ld' command
- to add linkage to the thread library to an existing perl executable.
- (But you'll need to work that one out yourself. If you do please let
- me know so I can add the details here to share with others.)
-
-Most of this information comes from Andi Lamprecht, to whom I'm very
-grateful indeed.
-
-I've included below two of his email messages, slightly edited, where
-he explains the procedure for options 1 and 2 above. I've also
-appended a slight reworking of option 1 from Paul Vallee. And I've later
-added some more useful messages from other people.
-
-Tim.
-
-----
-
-
-From: andi@sunnix.sie.siemens.at
-
-Have managed it to get DBD to work with Oracle 8i without these nasty Java
-error! It seems to be that a thing called "NAU" links in a radius
-athentication module which is written in Java and this causes the
-additional java libraries in the libclntsh.so. After throwing it all out
-DBD tests ran successfully.
-
-The steps to take are:
-
- - shut down Oracle server if you have one running in the installation
- you're about to modify.
- - take a backup copy of your Oracle installation! You have been warned!
-
- - go to $ORACLE_HOME/network/lib (or it maybe (also?) in $ORACLE_HOME/oas/lib)
- - rebuild nautab.o with:
-
- make -f ins_nau.mk NAU_ADAPTERS="IDENTIX KERBEROS5 SECURID" nautab.o
-
- This build a new nautab.o without the radius authentication module.
-
- - go to $ORACLE_HOME/lib
- - edit file "ldflags" and delete all occurences of "-lnrad8" and "-ljava"
- and "-[LR]$ORACLE_HOME/JRE/lib/sparc/native_threads"
-
- - go to $ORACLE_HOME/bin
- - build a new libclntsh.so with:
-
- genclntsh
-
- - start up Oracle
-
- - go back to the DBD-* directory and build the Oracle driver with:
-
- perl Makefile.PL; make; make test
-
-This worked for me, the database is still operational, MAYBE SOME JAVA
-STUFF ISN'T WORKING. Better someone else with more experience in java
-finds out ...
-
-The problem seems to be a dynamic linking issue. Whenever java virtual
-machine is loaded, some symbols are missing (with java 1.2.2_05 these
-_thread_something symbols where not found, even with linked-in
-libthread.so, with java 1.1.8 some _lseek or so symbols couldn't be
-resolved). Seems Oracle did a good job in integration of Java in the
-database ...
-
-Ok, should go out now 'cause its a beatiful wheater here in Vienna!
-
-Greetings
-A. Lamprecht
-
------------
-
-
-From: andi@sunnix.sie.siemens.at
-
-For some reason libthread.so.1 isn't included as dynamic object in perl
-binary and so symbols aren't found.
-
-The interesting output of LD_DEBUG=symbols:
-symbol=thr_getstate; dlsym() starting at file=/usr/local/bin/perl
-symbol=thr_getstate; lookup in file=/usr/local/bin/perl [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libsocket.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libnsl.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libdl.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libm.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libc.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libcrypt_i.so.1 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libmp.so.2 [ ELF ]
-symbol=thr_getstate; lookup in file=/lib/libgen.so.1 [ ELF ]
-ld.so.1: /usr/local/bin/perl: fatal: thr_getstate: can't find symbol
-
-This list looks exactly like the one you get when ldd-ing the perl binary.
-There is an option to the dynamic linker "LD_PRELOAD" and if you set it with
-
- LD_PRELOAD=/lib/libthread.so.1
- export LD_PRELOAD
-
-before starting any DBD::oracle app, the app works! (Note that this must
-be set before perl starts, you can't set it via $ENV{LD_PRELOAD} within
-the script.)
-
-It looks like after libjava and libjvm is loaded, the library search path
-is somehow stripped to the one of the perl binary ...
-
-[That looks like a Solaris bug]
-
-Hope this helps.
-
-A. Lamprecht
------------
-
-
-From: Paul Vallee <vallee+dbi@pythian.com>
-
-Andi is right. Three cheers for Andi!!! :-)
-
-Final Summary (this is mostly Andi's work summarized here)
-
-1. Copy your ORACLE_HOME in it's entirety to a new directory.
-cp -r $ORACLE_HOME $ORACLE_HOME.nojava
-
-2. Set your ORACLE_HOME variable to the new one. Save the old one for reference.
-export OLD_ORACLE_HOME=$ORACLE_HOME
-export ORACLE_HOME=$ORACLE_HOME.nojava
-
-3. cd $ORACLE_HOME/network/lib (or it maybe (also?) in $ORACLE_HOME/oas/lib)
-This is your new ORACLE_HOME - the temporary one that will soon be without
-Java or Radius.
-
-4. build nautab.o with
-make -f ins_nau.mk NAU_ADAPTERS="IDENTIX KERBEROS5 SECURID" nautab.o
-
-5. go to $ORACLE_HOME/lib
-edit file "ldflags" and delete all occurences of "-lnrad8" and "-ljava"
-and "-[LR]$ORACLE_HOME/JRE/lib/sparc/native_threads"
-I wrote this little pipeline to do this.
-sed 's/-lnrad8//g' < ldflags | \
-sed 's/-ljava//g' | \
-sed "s%-L$OLD_ORACLE_HOME/JRE/lib/sparc/native_threads%%g" | \
-sed "s%-R$OLD_ORACLE_HOME/JRE/lib/sparc/native_threads%%g" | > newldflags
-If you look at newldflags, and like it, then run:
-cp ldflags oldldflags; cp newldflags ldflags
-
-6. go to $ORACLE_HOME/bin and build a new libclntsh.so with "genclntsh"
-genclntsh
-
-7. go to your DBD::oracle install directory and go through the regular
-install process.
-perl Makefile.PL; make; make install
-(I find the make test less useful than my test.pl perl file.)
-
-8. Set LD_LIBRARY_PATH=$ORACLE_HOME/lib.
-This part is very important - remember that at this stage ORACLE_HOME is set
-to the nojava home. Make this permanent by explicitly setting
-LD_LIBRARY_PATH to the nojava lib directory in your .profile.
-This is the step that stalled me - thanks again to Andi.
-
-9. Test this out. I use the following command which fails
-nicely if we've failed, and is very quiet if we've succeeded:
- perl -MDBD::Oracle -e 0
-there should be no output. Congratulations.
-
-10. Get rid of everything other than libclntsh.so in your new ORACLE_HOME -
-the rest is a waste of space.
-cd $ORACLE_HOME; cd ..
-mv $ORACLE_HOME $ORACLE_HOME.rmme
-mkdir $ORACLE_HOME; mkdir $ORACLE_HOME/lib
-cp $ORACLE_HOME.rmme/lib/libclntsh.so $ORACLE_HOME/lib
-
-11. Run test.pl again just to be sure it still works.
-
-12. If test.pl is still working, then we can reclaim space with
-rm -fr $ORACLE_HOME.rmme
-
-Note that in my opinion this is a workaround - there is no reason on the
-face of it that I can fathom that we shouldn't be able to use DBD::Oracle to
-connect to Oracle with Java compiled in. (?)
-
-Enjoy,
-Paul Vallee
-Principal
-The Pythian Group, Inc.
-------------------------------------------------------------------------------
-
-From: Peter Ludemann <peter.ludemann@us.xacct.com>
-
-Here's a different way for ensuring that LD_PRELOAD has been set:
-
- unless (($ENV{LD_PRELOAD}||'') =~ /thread.so/) {
- $ENV{LD_PRELOAD} = '/lib/libthread.so';
- exec($^X, '-w', $0, @ARGV);
- }
-
-This hasn't been rigorously tested, but it seems to do the trick, at
-least on Solaris 7 with Oracle 8.
-
-------------------------------------------------------------------------------
-
-From: VG <vgabriel@nbcs.rutgers.edu>
-
-I've had luck with adding the following at the top of my program:
-
-use DynaLoader;
-Dynaloader::db_load_file("/usr/lib/libthread.so", 0x01);
-
-(Others have reported this nor working for them.)
-
-------------------------------------------------------------------------------
-
-From: daver@despair.tmok.com (Dave C.)
-Subject: Re: DBI::DBD with Oracle 8i
-Newsgroups: comp.lang.perl.modules
-
-It looks like a lot of people are having this problem....
-
-I managed to solve it. I'm running Oracle 8.1.6, Solaris 8, Perl 5.6.0,
-and the latest DBI/DBD modules.
-
-I did some experimentation and discovered that the root of the problem
-was that libclntsh.so was linking with nautab.o. For some reason,
-nautab.o was linked with this RADIUS authentication (?) thing that was
-calling into Java (even though I don't use that particular functionality.)
-
-So, what I had to do was generate a libclntsh.so that linked with a
-nautab.o that didn't require the radius (and thus the java). I then
-forced the Oracle DBD to link with my library and installed it, and it
-worked.
-
-Here's the step-by-step:
-
-To do this, first copy the "genautab" and "genclntsh" scripts to a
-scratch directory. By default "genautab" apparently generates some
-default network authentication stub without a lot of options (which was
-okay for me.)
-
-I ran:
-
- ./genautab >nautab.s
- as -P nautab.s
-
-After this step you should have a "nautab.o" file.
-
-Now, you must must modify "genclntsh" to produce your custom clntsh
-library (which I called "perlclntsh" so I wouldn't mess up the original
-Oracle library.) So I went into the file and modified CLNT_NAM to read
-"perlclntsh". I also changed LIB_DIR to put the resulting library in
-my current directory: (LIB_DIR=`pwd`)
-
-Also, instead of creating the library, I modified the script to just
-echo the command. Search for "# Create library" and put "echo " before
-{$LD} ${LD_RUNTIME}... Now, when you run "./genclntsh" you should get
-a large command. Redir this command to a file "./genclntsh >t"
-
-Now, edit this file and remove all references to java libraries (get
-rid of all "-ljava" instances, at least, and you may need to delete
-other stuff, like -lnative_threads.) . Run your script: "sh ./t".
-After some time you should wind up with a "libperlclntsh.so.8.0".
-This is your custom library any of the java stuff linked in.
-
-Then copy this lib to /usr/local/lib and create a softlink
-"libperlclntsh.so" to "libperlclntsh.so.8.0" (or copy it wherever you
-want...)
-
-Then you have to force DBD to link with this library instead of linking
-with the libclntsh.so provided by Oracle.
-
-Basically what I did was follow the normal DBD-Oracle directions. I
-then edited the resulting Makefile manually and changed all references
-of libclntsh.so to libperlclnt.so (ie, -lclntsh to -lperlclntsh) I
-also changed the LDDLFLAGS and LDFLAGS and appended "-L/usr/local/lib
--R/usr/local/lib -L/usr/ucblib -R/usr/ucblib -lucb". (for some reason
-the resulting DBD wanted to link with ucb) Run "make" and rebuild the
-DBD. Now "make test" should pass.
-
-Note that this was a fairly long (couple of hours) series of trial and
-error before I finally got this to work. Your system may be different
-and you may encounter your own linking problems, etc.
-
-Disclaimer: This may not work for you, but it worked for me. Even if it
-does work for you there is no guarantee that the resulting module will
-function correctly and won't hose your database, etc...
-
-I forgot to mention that in script resulting from genclntsh you must
-tell it to use _your_ nautab.o for linking, not the oracle lib one.
-Oops.
-
--Dave
-
@@ -1,7 +0,0 @@
-This information is now in the DBD::Oracle module pod documentation.
-Use the 'perldoc DBD::Oracle' command to read it.
-
-Note: The test scripts use the ORACLE_USERID environment variable
-to determine who to login as. It's common to use the Oracle demo user
-'scott' with the standard password 'tiger', thus ORACLE_USERID can be
-set to 'scott/tiger', or set it to your own username and password.
@@ -1,81 +0,0 @@
-Some examples related to the use of LONG types.
-
-For complete working code, take a look at the t/long.t file.
-
-----------------------------------------------------------------------
-
-You must fetch the row before you can fetch the longs associated with
-that row. In other words, use the following alorithm...
-
- 1) login
- 2) prepare( select ... )
- 3) execute
- 4) while rows to fetch do
- 5) fetch row
- 6) repeat
- 7) fetch chunk of long
- 8) until have all of it
- 9) done
-
-If your select selects more than one row the need for step 4 may
-become a bit clearer... the blob_read always applies to the row
-that was last fetched.
-
-Thanks to Jurgen Botz <jbotz@reference.com>
-
-----------------------------------------------------------------------
-Example for reading LONG fields via blob_read:
-
- $dbh->{RaiseError} = 1;
- $dbh->{LongTruncOk} = 1; # truncation on initial fetch is ok
- $sth = $dbh->prepare("SELECT key, long_field FROM table_name");
- $sth->execute;
- while ( ($key) = $sth->fetchrow_array) {
- my $offset = 0;
- my $lump = 4096; # use benchmarks to get best value for you
- my @frags;
- while (1) {
- my $frag = $sth->blob_read(1, $offset, $lump);
- last unless defined $frag;
- my $len = length $frag;
- last unless $len;
- push @frags, $frag;
- $offset += $len;
- }
- my $blob = join "", @frags;
- print "$key: $blob\n";
- }
-
-With thanks to james.taylor@srs.gov and desilva@ind70.industry.net.
-
-----------------------------------------------------------------------
-
-Example for inserting LONGS From: Andrew Berry <adb@bha.oz.au>
-
-# Assuming the existence of @row and an associative array (%clauses) containing the
-# column names and placeholders, and an array @types containing column types ...
-
- $ih = $db->prepare("INSERT INTO $table ($clauses{names})
- VALUES ($clauses{places})")
- || die "prepare insert into $table: " . $db->errstr;
-
- $attrib{'ora_type'} = $longrawtype; # $longrawtype == 24
-
- ##-- bind the parameter for each of the columns
- for ($i = 0; $i < @types; $i++) {
-
- ##-- long raw values must have their type attribute explicitly specified
- if ($types[$i] == $longrawtype) {
- $ih->bind_param($i+1, $row[$i], \%attrib)
- || die "binding placeholder for LONG RAW " . $db->errstr;
- }
- ##-- other values work OK with the default attributes
- else {
- $ih->bind_param($i+1, $row[$i])
- || die "binding placeholder" . $db->errstr;
- }
- }
-
- $ih->execute || die "execute INSERT into $table: " . $db->errstr;
-
-----------------------------------------------------------------------
@@ -1,43 +0,0 @@
-These instructions allow for the compilation and successful testing of
-DBD::Oracle on MacOS X 10.2.4 using Oracle 9iR2 DR (Release 9.2.0.1.0).
-
-MacOS X DBD::Oracle has only been tested using Perl 5.8.0 - please refer to:
-
- Installing Perl 5.8 on Jaguar
- http://developer.apple.com/internet/macosx/perl.html
-
-for Perl 5.8.0 installation instructions.
-
-
-1) Install Oracle exactly per Oracle documentation. If you change
-install locations, then you'll need to modify paths accordingly.
-
-2) As oracle user execute the following commands to fix namespace
-collisions in Oracle's dynamic libraries.
-
- nmedit -R ./hints/macos_lib.syms $ORACLE_HOME/lib/libclntsh.dylib
-
- *** Please make a backup copy of the libclntsh.dylib file before
- executing the command (which edits the file) and make sure that
- sqlplus still operates as expected afterwards.
-
-3) Install the module DBI as per its instructions.
-
-4) Install the DBD::Oracle module.
-
- perl Makefile.PL
- make
- make test
- make install
-
-5) If you have any problems then follow the instructions in the README.
- Please post details of any problems (or changes you needed to make) to
- dbi-users@perl.org and CC them to me at brooksch@mac.com on MacOSX
- specific problems.
-
-Original instructions thanks to:
- Andy Lester <andy@petdance.com>
- Steve Sapovits <sapovitss@gsicommerce.com>
- Tom Mornini <tmornini@infomania.com>
-
--Brook Schofield <brooksch@mac.com>
@@ -0,0 +1,4298 @@
+# NAME
+
+DBD::Oracle - Oracle database driver for the DBI module
+
+# VERSION
+
+version 1.74
+
+# SYNOPSIS
+
+ use DBI;
+
+ $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd);
+
+ $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd);
+
+ # See the DBI module documentation for full details
+
+ # for some advanced uses you may need Oracle type values:
+ use DBD::Oracle qw(:ora_types);
+
+# DESCRIPTION
+
+DBD::Oracle is a Perl module which works with the DBI module to provide
+access to Oracle databases.
+
+This documentation describes driver specific behaviour and restrictions. It is
+not supposed to be used as the only reference for the user. In any case
+consult the [DBI](https://metacpan.org/pod/DBI) documentation first!
+
+# CONSTANTS
+
+- :ora\_session\_modes
+
+ ORA\_SYSDBA ORA\_SYSOPER ORA\_SYSASM ORA\_SYSBACKUP ORA\_SYSDG ORA\_SYSKM
+
+- :ora\_types
+
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
+
+- SQLCS\_IMPLICIT
+- SQLCS\_NCHAR
+
+ SQLCS\_IMPLICIT and SQLCS\_NCHAR are _character set form_ values.
+ See notes about Unicode elsewhere in this document.
+
+- SQLT\_INT
+- SQLT\_FLT
+
+ These types are used only internally, and may be specified as internal
+ bind type for ORA\_NUMBER\_TABLE. See notes about ORA\_NUMBER\_TABLE elsewhere
+ in this document
+
+- ORA\_OCI
+
+ Oracle doesn't provide a formal API for determining the exact version
+ number of the OCI client library used, so DBD::Oracle has to go digging
+ (and sometimes has to more or less guess). The ORA\_OCI constant
+ holds the result of that process.
+
+ In string context ORA\_OCI returns the full "A.B.C.D" version string.
+
+ In numeric context ORA\_OCI returns the major.minor version number
+ (8.1, 9.2, 10.0 etc). But note that version numbers are not actually
+ floating point and so if Oracle ever makes a release that has a two
+ digit minor version, such as `9.10` it will have a lower numeric
+ value than the preceding `9.9` release. So use with care.
+
+ The contents and format of ORA\_OCI are subject to change (it may,
+ for example, become a _version object_ in later releases).
+ I recommend that you avoid checking for exact values.
+
+- :ora\_fetch\_orient
+
+ OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST
+ OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE
+
+ These constants are used to set the orientation of a fetch on a scrollable cursor.
+
+- :ora\_exe\_modes
+
+ OCI_STMT_SCROLLABLE_READONLY
+
+- :ora\_fail\_over
+
+ OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR
+ OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY
+
+# DBI CLASS METHODS
+
+## __connect__
+
+This method creates a database handle by connecting to a database, and is the DBI equivalent of the "new" method.
+To open a connection to an Oracle database you need to specify a database connection string (URL), username and password.
+
+The connection string is always of the form: "dbi:Oracle:<db identifier>"
+There are several ways to identify a database:
+
+1. If the database is local, specifying the SID or service name will be enough.
+2. If the database is defined in a TNSNAMES.ORA file, you can use the service name given in the file
+3. To connect without TNSNAMES.ORA file, you can use an EZCONNECT url, of the form:
+//host\[:port\]\[/service\_name\]
+
+If port name is not specified, 1521 is the default. If service name is not specified, the hostname will be used as a service name.
+
+The following examples show several ways a connection can be created:
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password');
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username/password','');
+
+ $dbh = DBI->connect('dbi:Oracle:','username@DB','password');
+
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', '');
+
+ $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password');
+
+### OS authentication
+
+To connect to a local database with a user which has been set up to
+authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"):
+
+ $dbh = DBI->connect('dbi:Oracle:','/','');
+
+Note the lack of a connection name (use the ORACLE\_SID environment
+variable). If an explicit SID is used you will probably get an ORA-01004 error.
+
+That only works for local databases. (Authentication to remote Oracle
+databases using your Unix login name without a password is possible
+but it is not secure and not recommended so not documented here.
+
+### Oracle Environment Variables
+
+To use DBD::ORACLE to connect to an Oracle database, ORACLE\_HOME environment variable should be set correctly.
+In general, the value used should match the version of Oracle that was used to build DBD::Oracle. If using dynamic linking then ORACLE\_HOME should match the version of Oracle that will be used to load in the Oracle client libraries (via LD\_LIBRARY\_PATH, ldconfig, or similar on Unix).
+
+Oracle can use two environment variables to specify default connections: ORACLE\_SID and TWO\_TASK.
+
+To use them, specify either a local SID or service name, or a service name that is specified in the TNSNAMES.ORA file.
+
+Note that if you have \*both\* local and remote databases, and you have ORACLE\_SID \*and\* TWO\_TASK set, and you don't specify a fully
+qualified connect string on the command line, TWO\_TASK takes precedence over ORACLE\_SID (i.e. you get connected to remote system).
+
+It is highly recommended not to rely on environment variables and to always explicitly specify the SID in the connection string. This can prevent serious mistakes such as dropping a schema in the wrong database, and generally makes debugging and troubleshooting easier.
+
+Also remember that depending on the operating system you are using the differing "ORACLE" environment variables may be case sensitive, so if you are not connecting as you should double check the case of both the variable and its value.
+
+### Timezones
+
+If the query is run through SQL\*Net (mostly queries that are executed on remote servers), Oracle will return the time zone based on the setting of the UNIX environment variable "TZ" for the user who started the listener.
+
+If the query is run locally, Oracle will return the time zone based on the "TZ" environment variable setting of the user running
+the query.
+
+With local queries, you can change the time zone for a particular user by simply changing the setting of "TZ". To check the current setting,
+issue the UNIX "date" command.
+
+### Oracle DRCP
+
+DBD::Oracle supports DRCP (Database Resident Connection Pool) so
+if you have an 11.2 database and DRCP is enabled you can direct
+all of your connections to it by adding ':POOLED' to the SID or
+setting a connection attribute of ora\_drcp, or set the SERVER=POOLED
+when using a TNSENTRY style connection or even by setting an
+environment variable ORA\_DRCP. All of which are demonstrated below;
+
+ $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password')
+
+ $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password')
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1})
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1,
+ ora_drcp_class=>'my_app',
+ ora_drcp_min =>10})
+
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '')
+
+ $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION=
+ (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521))
+ (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "")
+
+ if the ORA_DRCP environment variable is set then just this
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password')
+
+You can find a white paper on setting up DRCP and its advantages at [http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf](http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf).
+
+Please note that DRCP support in DBD::Oracle is relatively new so the
+mechanics or its implementation are subject to change.
+
+### TAF (Transparent Application Failover)
+
+Transparent Application Failover (TAF) is the feature in OCI that
+allows for clients to automatically reconnect to an instance in the
+event of a failure of the instance. The reconnect happens
+automatically from within the OCI (Oracle Call Interface) library.
+DBD::Oracle now supports a callback function that will fire when a TAF
+event takes place. You may use the callback to inform the
+user a failover is taking place or to setup the session again
+once the failover has succeeded.
+
+You will have to set up TAF on your instance before you can use this
+callback. You can test your instance to see if you can use TAF
+callback with
+
+ $dbh->ora_can_taf();
+
+If you try to set up a callback without it being enabled DBD::Oracle
+will croak.
+
+NOTE: Currently, you must enable TAF during DBI's connect. However
+once enabled you can change the TAF settings.
+
+It is outside the scope of this document to go through all of the
+possible TAF situations you might want to set up but here is a simple
+example:
+
+The TNS entry for the instance has had the following added to the
+CONNECT\_DATA section
+
+ (FAILOVER_MODE=
+ (TYPE=select)
+ (METHOD=basic)
+ (RETRIES=10)
+ (DELAY=10))
+
+You will also have to create your own perl function that will be
+called from the client. You can name it anything you want and it will
+always be passed two parameters, the failover event value and the
+failover type. You can also set a sleep value in case of failover
+error and the OCI client will sleep for the specified seconds before it
+attempts another event.
+
+ use DBD::Oracle(qw(:ora_fail_over));
+ #import the ora fail over constants
+
+ #set up TAF on the connection
+ # NOTE since DBD::Oracle uses call_pv you may need to pass a full
+ # name space as the function e.g., 'main::handle_taf'
+ # NOTE from 1.49_00 ora_taf_function can accept a code ref as well
+ # as a sub name as it now uses call_sv
+ my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr',
+ {ora_taf_function => 'main::handle_taf'});
+
+ #create the perl TAF event function
+
+ sub handle_taf {
+ # NOTE from 1.49_00 the $dbh handle was passed to your callback
+ my ($fo_event,$fo_type, $dbh) = @_;
+ if ($fo_event == OCI_FO_BEGIN){
+
+ print " Instance Unavailable Please stand by!! \n";
+ printf(" Your TAF type is %s \n",
+ (($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_ABORT){
+ print " Failover aborted. Failover will not take place.\n";
+ }
+ elsif ($fo_event == OCI_FO_END){
+ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_REAUTH){
+ print " Failed over user. Resuming services\n";
+ }
+ elsif ($fo_event == OCI_FO_ERROR){
+ print " Failover error ...\n";
+ sleep 5; # sleep before having another go
+ return OCI_FO_RETRY;
+ }
+ else {
+ printf(" Bad Failover Event: %d.\n", $fo_event);
+
+ }
+ return 0;
+ }
+
+The TAF types are as follows
+
+ OCI_FO_SESSION indicates the user has requested only session failover.
+ OCI_FO_SELECT indicates the user has requested select failover.
+ OCI_FO_NONE indicates the user has not requested a failover type.
+ OCI_FO_TXNAL indicates the user has requested a transaction failover.
+
+The TAF events are as follows
+
+ OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting.
+ OCI_FO_END indicates successful completion of failover.
+ OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying.
+ OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover.
+ OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter).
+
+### Connect Attributes
+
+#### ora\_ncs\_buff\_mtpl
+
+You can customize the size of the buffer when selecting LOBs with
+the built-in AUTO Lob. The default value is 4 which is probably
+excessive for most situations but is needed for backward
+compatibility. If you not converting between a NCS on the DB and the
+Client then you might want to set this to 1 to reduce memory usage.
+
+This value can also be specified with the `ORA_DBD_NCS_BUFFER`
+environment variable in which case it sets the value at the connect
+stage.
+
+#### ora\_drcp
+
+For Oracle 11.2 or greater.
+
+Set to _1_ to enable DRCP. Can also be set via the `ORA_DRCP` environment variable.
+
+#### ora\_drcp\_class
+
+If you are using DRCP, you can set a CONNECTION\_CLASS for your pools
+as well. As sessions from a DRCP cannot be shared by users, you can
+use this setting to identify the same user across different
+applications. OCI will ensure that sessions belonging to a 'class' are
+not shared outside the class'.
+
+The values for ora\_drcp\_class cannot contain a '\*' and must be less
+than 1024 characters.
+
+This value can be also be specified with the `ORA_DRCP_CLASS`
+environment variable.
+
+#### ora\_drcp\_min
+
+This optional value specifies the minimum number of sessions that are
+initially opened. New sessions are only opened after this value has
+been reached.
+
+The default value is 4 and any value above 0 is valid.
+
+Generally, it should be set to the number of concurrent statements the
+application is planning or expecting to run.
+
+This value can also be specified with the `ORA_DRCP_MIN` environment
+variable.
+
+#### ora\_drcp\_max
+
+This optional value specifies the maximum number of sessions that can
+be open at one time. Once reached no more sessions can be opened
+until one becomes free. The default value is 40 and any value above 1
+is valid. You should not set this value lower than ora\_drcp\_min as
+that will just waste resources.
+
+This value can also be specified with the `ORA_DRCP_MAX` environment
+variable.
+
+#### ora\_drcp\_incr
+
+This optional value specifies the next increment for sessions to be
+started if the current number of sessions are less than
+ora\_drcp\_max. The default value is 2 and any value above 0 is
+valid as long as the value of ora\_drcp\_min + ora\_drcp\_incr is not
+greater than ora\_drcp\_max.
+
+This value can also be specified with the `ORA_DRCP_INCR` environment
+variable.
+
+#### ora\_taf
+
+This attribute was removed in 1.49\_00 as it was redundant. To
+enable TAF simply set ["ora\_taf\_function"](#ora_taf_function).
+
+#### ora\_taf\_function
+
+If your Oracle instance has been configured to use TAF events you can
+enable the TAF callback by setting this option.
+
+The name of the Perl subroutine (or a code ref from 1.49\_00) that will
+be called from OCI when a TAF event occurs. You must supply a perl
+function to use the callback and it will always receive at least two
+parameters; the failover event value and the failover type. From
+1.49\_00 the dbh is passed as the third argument. Below is an example
+of a TAF function
+
+ sub taf_event{
+ # NOTE from 1.49_00 the $dbh handle is passed to the callback
+ my ($event, $type, $dbh) = @_;
+
+ print "My TAF event=$event\n";
+ print "My TAF type=$type\n";
+ return;
+ }
+
+Note if passing a sub name you will probably have to use the full name
+space when setting the TAF function e.g., 'main::my\_taf\_function' and
+not just 'my\_taf\_function'.
+
+#### ora\_taf\_sleep
+
+This attribute was removed in 1.49\_00 as it was redundant. If you want
+to sleep between retries simple add a sleep to your callback sub.
+
+#### ora\_session\_mode
+
+The ora\_session\_mode attribute can be used to connect with SYSDBA,
+SYSOPER, ORA\_SYSASM, ORA\_SYSBACKUP, ORA\_SYSKM and ORA\_SYSDG authorization.
+The ORA\_SYSDBA, ORA\_SYSOPER, ORA\_SYSASM, ORA\_SYSBACKUP, ORA\_SYSKM
+and ORA\_SYSDG constants can be imported using
+
+ use DBD::Oracle qw(:ora_session_modes);
+
+This is one case where setting ORACLE\_SID may be useful since
+connecting as SYSDBA or SYSOPER via SQL\*Net is frequently disabled
+for security reasons.
+
+Example:
+
+ $dsn = "dbi:Oracle:"; # no dbname here
+ $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed
+ delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set
+
+ $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA });
+
+It has been reported that this only works if `$dsn` does not contain
+a SID so that Oracle then uses the value of ORACLE\_SID (not
+TWO\_TASK) environment variable to connect to a local instance. Also
+the username and password should be empty, and the user executing the
+script needs to be part of the dba group or osdba group.
+
+#### ora\_oratab\_orahome
+
+Passing a true value for the ora\_oratab\_orahome attribute will make
+DBD::Oracle change `$ENV{ORACLE_HOME}` to make the Oracle home directory
+that specified in the `/etc/oratab` file _if_ the database to connect to
+is specified as a SID that exists in the oratab file, and DBD::Oracle was
+built to use the Oracle 7 OCI API (not Oracle 8+).
+
+#### ora\_module\_name
+
+After connecting to the database the value of this attribute is passed
+to the SET\_MODULE() function in the `DBMS_APPLICATION_INFO` PL/SQL
+package. This can be used to identify the application to the DBA for
+monitoring and performance tuning purposes. For example:
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 });
+
+ $dbh->{ora_module_name} = $y;
+
+The maximum size is 48 bytes.
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+#### ora\_driver\_name
+
+For 11g and later you can now set the name of the driver layer using OCI.
+Perl, Perl5, ApachePerl so on. Names starting with "ORA" are reserved. You
+can enter up to 8 characters. If none is enter then this will default to
+DBDOxxxx where xxxx is the current version number. This value can be
+retrieved on the server side using V$SESSION\_CONNECT\_INFO or
+GV$SESSION\_CONNECT\_INFO
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' });
+
+ $dbh->{ora_driver_name} = $q;
+
+#### ora\_client\_info
+
+Allows you to add any value (up to 64 bytes) to your session and it can be
+retrieved on the server side from the `V$SESSION`a view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' });
+
+ $dbh->{ora_client_info} = "Remote2";
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+#### ora\_client\_identifier
+
+Allows you to specify the user identifier in the session handle.
+
+Most useful for web applications as it can pass in the session user
+name which might be different to the connection user name. Can be up
+to 64 bytes long but do not to include the password for security
+reasons and the first character of the identifier should not be
+':'. This value can be retrieved on the server side using `V$SESSION`
+view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user });
+
+ $dbh->{ora_client_identifier} = $local_user;
+
+#### ora\_action
+
+Allows you to specify any string up to 32 bytes which may be retrieved
+on the server side using `V$SESSION` view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"});
+
+ $dbh->{ora_action} = "New Long Query 22";
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+#### ora\_dbh\_share
+
+Requires at least Perl 5.8.0 compiled with ithreads.
+
+Allows you to share
+database connections between threads. The first connect will make the
+connection, all following calls to connect with the same ora\_dbh\_share
+attribute will use the same database connection. The value must be a
+reference to a already shared scalar which is initialized to an empty
+string.
+
+ our $orashr : shared = '' ;
+
+ $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ;
+
+#### ora\_envhp
+
+The first time a connection is made a new OCI 'environment' is
+created by DBD::Oracle and stored in the driver handle.
+Subsequent connects reuse (share) that same OCI environment
+by default.
+
+The ora\_envhp attribute can be used to disable the reuse of the OCI
+environment from a previous connect. If the value is `0` then
+a new OCI environment is allocated and used for this connection.
+
+The OCI environment holds information about the client side context,
+such as the local NLS environment. By altering `%ENV` and setting
+ora\_envhp to 0 you can create connections with different NLS
+settings. This is most useful for testing.
+
+#### ora\_charset, ora\_ncharset
+
+For oracle versions >= 9.2 you can specify the client charset and
+ncharset with the ora\_charset and ora\_ncharset attributes. You
+still need to pass `ora_envhp = 0` for all but the first connect.
+
+These attributes override the settings from environment variables.
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_charset => 'AL32UTF8'});
+
+#### ora\_verbose
+
+Use this value to enable DBD::Oracle only tracing. Simply either set
+the ora\_verbose attribute on the connect() method to the trace level
+you desire like this
+
+ my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6});
+
+or set it directly on the DB handle like this;
+
+ $dbh->{ora_verbose} =6;
+
+In both cases the DBD::Oracle trace level is set to 6, which is the highest
+level tracing most of the calls to OCI.
+
+NOTE: In future versions of DBD::Oracle ora\_verbose will be changed so
+that it is simply a switch to turn DBI's DBD tracing on or off. A
+true value will turn it on and a false value will turn it off. DBI's
+"DBD" tracing was not available when ora\_verbose was created and
+ora\_verbose adds an additional test to every trace test.
+
+#### ora\_oci\_success\_warn
+
+Use this value to print otherwise silent OCI warnings that may happen
+when an execute or fetch returns "Success With Info" or when you want
+to tune RowCaching and LOB Reads
+
+ $dbh->{ora_oci_success_warn} = 1;
+
+#### ora\_objects
+
+Use this value to enable extended embedded oracle objects mode. In extended:
+
+1. Embedded objects are returned as <DBD::Oracle::Object> instance (including type-name etc.) instead of simple ARRAY.
+2. Determine object type for each instance. All object attributes are returned (not only super-type's attributes).
+
+ $dbh->{ora_objects} = 1;
+
+#### ora\_ph\_type
+
+The default placeholder datatype for the database session.
+The `TYPE` or ["ora\_type"](#ora_type) attributes to ["bind\_param" in DBI](https://metacpan.org/pod/DBI#bind_param) and
+["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) override the datatype for individual placeholders.
+The most frequent reason for using this attribute is to permit trailing spaces
+in values passed by placeholders.
+
+Constants for the values allowed for this attribute can be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+Only the following values are permitted for this attribute.
+
+- ORA\_VARCHAR2
+
+ Oracle clients using OCI 8 will strip trailing spaces and allow embedded \\0 bytes.
+ Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \\0 bytes.
+ This is the normal default placeholder type.
+
+- ORA\_STRING
+
+ Do not strip trailing spaces and end the string at the first \\0.
+
+- ORA\_CHAR
+
+ Do not strip trailing spaces and allow embedded \\0.
+ Force 'blank-padded comparison semantics'.
+
+ For example:
+
+ use DBD::Oracle qw(:ora_types);
+
+ $SQL="select username from all_users where username = ?";
+ #username is a char(8)
+ $sth=$dbh->prepare($SQL)";
+ $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR});
+
+ Will pad bloggs out to 8 characters and return the username.
+
+#### ora\_parse\_error\_offset
+
+If the previous error was from a failed `prepare` due to a syntax error,
+this attribute gives the offset into the `Statement` attribute where the
+error was found.
+
+#### ora\_array\_chunk\_size
+
+Due to OCI limitations, DBD::Oracle needs to buffer up rows of
+bind values in its `execute_for_fetch` implementation. This attribute
+sets the number of rows to buffer at a time (default value is 1000).
+
+The `execute_for_fetch` function will collect (at most) this many
+rows in an array, send them off to the DB for execution, then go back
+to collect the next chunk of rows and so on. This attribute can be
+used to limit or extend the number of rows processed at a time.
+
+Note that this attribute also applies to `execute_array`, since that
+method is implemented using `execute_for_fetch`.
+
+#### ora\_connect\_with\_default\_signals
+
+Sometimes the Oracle client seems to change some of the signal
+handlers of the process during the connect phase. For instance, some
+users have observed Perl's default `$SIG{INT}` handler being ignored
+after connecting to an Oracle database. If this causes problems in
+your application, set this attribute to an array reference of signals
+you would like to be localized during the connect process. Once the
+connect is complete, the signal handlers should be returned to their
+previous state.
+
+For example:
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => [ 'INT' ] });
+
+NOTE disabling the signal handlers the OCI library sets up may affect
+functionality in the OCI library.
+
+NOTE If you are using connect\_cached then the above example will lead
+to DBI thinking each connection is different as an anonymous array reference
+is being used. To avoid this when using connect\_cached you are advised
+to use:
+
+ my @ora_default_signals = (...);
+ $dbh = DBI->connect($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => \@ora_default_signals});
+
+In more recent Perl versions you could possibly make use of new state
+variables.
+
+## __connect\_cached__
+
+Implemented by DBI, no driver-specific impact.
+Please note that connect\_cached as not been tested with DRCP.
+
+## __data\_sources__
+
+ @data_sources = DBI->data_sources('Oracle');
+ @data_sources = $dbh->data_sources();
+
+Returns a list of available databases. You will have to set either the 'ORACLE\_HOME' or
+'TNS\_ADMIN' environment value to retrieve this list. It will read these values from
+TNSNAMES.ORA file entries.
+
+# METHODS COMMON TO ALL HANDLES
+
+For all of the methods below, __$h__ can be either a database handle (__$dbh__)
+or a statement handle (__$sth__). Note that _$dbh_ and _$sth_ can be replaced with
+any variable name you choose: these are just the names most often used. Another
+common variable used in this documentation is $_rv_, which stands for "return value".
+
+## __err__
+
+ $rv = $h->err;
+
+Returns the error code from the last method called.
+
+## __errstr__
+
+ $str = $h->errstr;
+
+Returns the last error that was reported by Oracle. Starting with "ORA-00000" code followed by the error message.
+
+## __state__
+
+ $str = $h->state;
+
+Oracle hasn't supported SQLSTATE since the early versions OCI. It will return empty when the command succeeds and
+'S1000' (General Error) for all other errors.
+
+While this method can be called as either `$sth->state` or `$dbh->state`, it
+is usually clearer to always use `$dbh->state`.
+
+## __trace__
+
+Implemented by DBI, no driver-specific impact.
+
+## __trace\_msg__
+
+Implemented by DBI, no driver-specific impact.
+
+## __parse\_trace\_flag__ and __parse\_trace\_flags__
+
+Implemented by DBI, no driver-specific impact.
+
+## __func__
+
+DBD::Oracle uses the `func` method to support a variety of functions.
+
+## __Private database handle functions__
+
+Some of these functions are called through the method func()
+which is described in the DBI documentation. Any function that begins with ora\_
+can be called directly.
+
+## __plsql\_errstr__
+
+This function returns a string which describes the errors
+from the most recent PL/SQL function, procedure, package,
+or package body compile in a format similar to the output
+of the SQL\*Plus command 'show errors'.
+
+The function returns undef if the error string could not
+be retrieved due to a database error.
+Look in $dbh->errstr for the cause of the failure.
+
+If there are no compile errors, an empty string is returned.
+
+Example:
+
+ # Show the errors if CREATE PROCEDURE fails
+ $dbh->{RaiseError} = 0;
+ if ( $dbh->do( q{
+ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as
+ BEGIN
+ PROCEDURE filltab( stuff OUT TAB ); asdf
+ END; } ) ) {} # Statement succeeded
+ }
+ elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure
+ else {
+ my $msg = $dbh->func( 'plsql_errstr' );
+ die $dbh->errstr if ! defined $msg;
+ die $msg if $msg;
+ }
+
+## __dbms\_output\_enable / dbms\_output\_put / dbms\_output\_get__
+
+These functions use the PL/SQL DBMS\_OUTPUT package to store and
+retrieve text using the DBMS\_OUTPUT buffer. Text stored in this buffer
+by dbms\_output\_put or any PL/SQL block can be retrieved by
+dbms\_output\_get or any PL/SQL block connected to the same database
+session.
+
+Stored text is not available until after dbms\_output\_put or the PL/SQL
+block that saved it completes its execution. This means you __CAN NOT__
+use these functions to monitor long running PL/SQL procedures.
+
+Example 1:
+
+ # Enable DBMS_OUTPUT and set the buffer size
+ $dbh->{RaiseError} = 1;
+ $dbh->func( 1000000, 'dbms_output_enable' );
+
+ # Put text in the buffer . . .
+ $dbh->func( @text, 'dbms_output_put' );
+
+ # . . . and retrieve it later
+ @text = $dbh->func( 'dbms_output_get' );
+
+Example 2:
+
+ $dbh->{RaiseError} = 1;
+ $sth = $dbh->prepare(q{
+ DECLARE tmp VARCHAR2(50);
+ BEGIN
+ SELECT SYSDATE INTO tmp FROM DUAL;
+ dbms_output.put_line('The date is '||tmp);
+ END;
+ });
+ $sth->execute;
+
+ # retrieve the string
+ $date_string = $dbh->func( 'dbms_output_get' );
+
+## __dbms\_output\_enable ( \[ buffer\_size \] )__
+
+This function calls DBMS\_OUTPUT.ENABLE to enable calls to package
+DBMS\_OUTPUT procedures GET, GET\_LINE, PUT, and PUT\_LINE. Calls to
+these procedures are ignored unless DBMS\_OUTPUT.ENABLE is called
+first.
+
+The buffer\_size is the maximum amount of text that can be saved in the
+buffer and must be between 2000 and 1,000,000. If buffer\_size is not
+given, the default is 20,000 bytes.
+
+## __dbms\_output\_put ( \[ @lines \] )__
+
+This function calls DBMS\_OUTPUT.PUT\_LINE to add lines to the buffer.
+
+If all lines were saved successfully the function returns 1. Depending
+on the context, an empty list or undef is returned for failure.
+
+If any line causes buffer\_size to be exceeded, a buffer overflow error
+is raised and the function call fails. Some of the text might be in
+the buffer.
+
+## __dbms\_output\_get__
+
+This function calls DBMS\_OUTPUT.GET\_LINE to retrieve lines of text from
+the buffer.
+
+In an array context, all complete lines are removed from the buffer and
+returned as a list. If there are no complete lines, an empty list is
+returned.
+
+In a scalar context, the first complete line is removed from the buffer
+and returned. If there are no complete lines, undef is returned.
+
+Any text in the buffer after a call to DBMS\_OUTPUT.GET\_LINE or
+DBMS\_OUTPUT.GET is discarded by the next call to DBMS\_OUTPUT.PUT\_LINE,
+DBMS\_OUTPUT.PUT, or DBMS\_OUTPUT.NEW\_LINE.
+
+## __reauthenticate ( $username, $password )__
+
+Starts a new session against the current database using the credentials
+supplied.
+
+## __private\_attribute\_info__
+
+ $hashref = $dbh->private_attribute_info();
+ $hashref = $sth->private_attribute_info();
+
+Returns a hash of all private attributes used by DBD::Oracle, for either
+a database or a statement handle. Currently, all the hash values are undef.
+
+# ATTRIBUTES COMMON TO ALL HANDLES
+
+## __InactiveDestroy__ (boolean)
+
+Implemented by DBI, no driver-specific impact.
+
+## __RaiseError__ (boolean, inherited)
+
+Forces errors to always raise an exception. Although it defaults to off, it is recommended that this
+be turned on, as the alternative is to check the return value of every method (prepare, execute, fetch, etc.)
+manually, which is easy to forget to do.
+
+## __PrintError__ (boolean, inherited)
+
+Forces database errors to also generate warnings, which can then be filtered with methods such as
+locally redefining _$SIG{\_\_WARN\_\_}_ or using modules such as `CGI::Carp`. This attribute is on
+by default.
+
+## __ShowErrorStatement__ (boolean, inherited)
+
+Appends information about the current statement to error messages. If placeholder information
+is available, adds that as well. Defaults to true.
+
+## __Warn__ (boolean, inherited)
+
+Enables warnings. This is on by default, and should only be turned off in a local block
+for a short a time only when absolutely needed.
+
+## __Executed__ (boolean, read-only)
+
+Indicates if a handle has been executed. For database handles, this value is true after the ["do"](#do) method has been called, or
+when one of the child statement handles has issued an ["execute"](#execute). Issuing a ["commit"](#commit) or ["rollback"](#rollback) always resets the
+attribute to false for database handles. For statement handles, any call to ["execute"](#execute) or its variants will flip the value to
+true for the lifetime of the statement handle.
+
+## __TraceLevel__ (integer, inherited)
+
+Sets the trace level, similar to the ["trace"](#trace) method. See the sections on
+["trace"](#trace) and ["parse\_trace\_flag"](#parse_trace_flag) for more details.
+
+## __Active__ (boolean, read-only)
+
+Indicates if a handle is active or not. For database handles, this indicates if the database has
+been disconnected or not. For statement handles, it indicates if all the data has been fetched yet
+or not. Use of this attribute is not encouraged.
+
+## __Kids__ (integer, read-only)
+
+Returns the number of child processes created for each handle type. For a driver handle, indicates the number
+of database handles created. For a database handle, indicates the number of statement handles created. For
+statement handles, it always returns zero, because statement handles do not create kids.
+
+## __ActiveKids__ (integer, read-only)
+
+Same as `Kids`, but only returns those that are active.
+
+## __CachedKids__ (hash ref)
+
+Returns a hashref of handles. If called on a database handle, returns all statement handles created by use of the
+`prepare_cached` method. If called on a driver handle, returns all database handles created by the ["connect\_cached"](#connect_cached)
+method.
+
+## __ChildHandles__ (array ref)
+
+Implemented by DBI, no driver-specific impact.
+
+## __PrintWarn__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __HandleError__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __HandleSetErr__ (code ref, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __ErrCount__ (unsigned integer)
+
+Implemented by DBI, no driver-specific impact.
+
+## __FetchHashKeyName__ (string, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __ChopBlanks__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __Taint__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __TaintIn__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __TaintOut__ (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __Profile__ (inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+## __Type__ (scalar)
+
+Returns `dr` for a driver handle, `db` for a database handle, and `st` for a statement handle.
+Should be rarely needed.
+
+## __LongReadLen__
+
+The maximum size of long or longraw columns to retrieve. If one of
+these columns is longer than LongReadLen then either a data truncation
+error will be raised (LongTrunkOk is false) or the column will be
+silently truncated (LongTruncOk is true).
+
+DBI currently defaults this to 80.
+
+## __LongTruncOk__
+
+Implemented by DBI, no driver-specific impact.
+
+## __CompatMode__
+
+Type: boolean, inherited
+
+The 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.
+
+# ORACLE-SPECIFIC DATABASE HANDLE METHODS
+
+## __ora\_can\_unicode ( \[ $refresh \] )__
+
+Returns a number indicating whether either of the database character sets
+is a Unicode encoding. Calls ora\_nls\_parameters() and passes the optional
+$refresh parameter to it.
+
+0 = Neither character set is a Unicode encoding.
+
+1 = National character set is a Unicode encoding.
+
+2 = Database character set is a Unicode encoding.
+
+3 = Both character sets are Unicode encodings.
+
+## __ora\_can\_taf__
+
+Returns true if the current connection supports TAF events. False if otherwise.
+
+## __ora\_nls\_parameters ( \[ $refresh \] )__
+
+Returns a hash reference containing the current NLS parameters, as given
+by the v$nls\_parameters view. The values fetched are cached between calls.
+To cause the latest values to be fetched, pass a true value to the function.
+
+# ORACLE-SPECIFIC DATABASE FUNCTIONS
+
+## __ora\_server\_version__
+
+ $versions = $dbh->func('ora_server_version');
+
+Returns an array reference of server version strings e.g.,
+
+ [11,2,0,2,0]
+
+# DATABASE HANDLE METHODS
+
+## __selectall\_arrayref__
+
+ $ary_ref = $dbh->selectall_arrayref($sql);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values);
+
+Returns a reference to an array containing the rows returned by preparing and executing the SQL string.
+See the DBI documentation for full details.
+
+## __selectall\_hashref__
+
+ $hash_ref = $dbh->selectall_hashref($sql, $key_field);
+
+Returns a reference to a hash containing the rows returned by preparing and executing the SQL string.
+See the DBI documentation for full details.
+
+## __selectcol\_arrayref__
+
+ $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values);
+
+Returns a reference to an array containing the first column
+from each rows returned by preparing and executing the SQL string. It is possible to specify exactly
+which columns to return. See the DBI documentation for full details.
+
+## __prepare__
+
+ $sth = $dbh->prepare($statement, \%attr);
+
+Prepares a statement for later execution by the database engine and returns a reference to a statement handle object.
+
+### __Prepare Attributes__
+
+These attributes may be used in the `\%attr` parameter of the
+["prepare" in DBI](https://metacpan.org/pod/DBI#prepare) database handle method.
+
+- ora\_placeholders
+
+ Set to false to disable processing of placeholders. Used mainly for loading a
+ PL/SQL package that has been _wrapped_ with Oracle's `wrap` utility.
+
+- ora\_auto\_lob
+
+ If true (the default), fetching retrieves the contents of the CLOB or
+ BLOB column in most circumstances. If false, fetching retrieves the
+ Oracle "LOB Locator" of the CLOB or BLOB value.
+
+ See ["LOBS AND LONGS"](#lobs-and-longs) for more details.
+
+ See also the LOB tests in 05dbi.t of Oracle::OCI for examples
+ of how to use LOB Locators.
+
+- ora\_pers\_lob
+
+ If true the ["Simple Fetch for CLOBs and BLOBs"](#simple-fetch-for-clobs-and-blobs) method for the ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be
+ used for LOBs rather than the default method ["Data Interface for LOB Locators"](#data-interface-for-lob-locators).
+
+- ora\_clbk\_lob
+
+ If true the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback) method for the ["Data
+ Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be used for LOBs.
+
+- ora\_piece\_lob
+
+ If true the ["Piecewise Fetch with Polling"](#piecewise-fetch-with-polling) method for the ["Data
+ Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be used for LOBs.
+
+- ora\_piece\_size
+
+ This is the max piece size for the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback)
+ and ["Piecewise Fetch with Polling"](#piecewise-fetch-with-polling) methods, in chars for CLOBS, and
+ bytes for BLOBS.
+
+- ora\_check\_sql
+
+ If 1 (default), force SELECT statements to be described in prepare().
+ If 0, allow SELECT statements to defer describe until execute().
+
+ See ["Prepare Postponed Till Execute"](#prepare-postponed-till-execute) for more information.
+
+- ora\_exe\_mode
+
+ This will set the execute mode of the current statement. Presently
+ only one mode is supported;
+
+ OCI_STMT_SCROLLABLE_READONLY - make result set scrollable
+
+ See ["SCROLLABLE CURSORS"](#scrollable-cursors) for more details.
+
+- ora\_prefetch\_rows
+
+ Sets the number of rows to be prefetched. If it is not set, then the
+ default value is 1. See ["Row Prefetching"](#row-prefetching) for more details.
+
+- ora\_prefetch\_memory
+
+ Sets the memory level for rows to be prefetched. The application then
+ fetches as many rows as will fit into that much memory. See ["Row
+ Prefetching"](#row-prefetching) for more details.
+
+- ora\_row\_cache\_off
+
+ By default DBD::Oracle will use a row cache when fetching to cut down
+ the number of round trips to the server. If you do not want to use an
+ array fetch set this value to any value other than 0;
+
+ See ["Row Prefetching"](#row-prefetching) for more details.
+
+### __Placeholders__
+
+There are three types of placeholders that can be used in
+DBD::Oracle.
+
+The first is the "question mark" type, in which each placeholder is
+represented by a single question mark character. This is the method
+recommended by the DBI and is the most portable. Each question
+mark is internally replaced by a "dollar sign number" in the order in
+which they appear in the query (important when using ["bind\_param"](#bind_param)).
+
+The second type of placeholder is "named parameters" in the format
+":foo" which is the one Oracle prefers.
+
+ $dbh->{RaiseError} = 1; # save having to check each method call
+ $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name");
+ $sth->bind_param(':name', "John%");
+ $sth->execute;
+ DBI::dump_results($sth);
+
+Note when calling bind\_param with named parameters you must include
+the leading colon. The advantage of this placeholder type is that you
+can use the same placeholder more than once in the same SQL statement
+but you only need to bind it once.
+
+The last placeholder type is a variation of the two above where you
+name each placeholder :N (where N is a number). Like the named
+placeholders above you can use the same placeholder multiple times in
+the SQL but when you call bind\_param you only need to pass the N
+(e.g., for :1 you use bind\_param(1,...) and not bind\_param(':1',...).
+
+The different types of placeholders cannot be mixed within a statement, but you may
+use different ones for each statement handle you have. This is confusing at best, so
+stick to one style within your program.
+
+## __prepare\_cached__
+
+ $sth = $dbh->prepare_cached($statement, \%attr);
+
+Implemented by DBI, no driver-specific impact. This method is most useful
+if the same query is used over and over as it will cut down round trips to the server.
+
+## __do__
+
+ $rv = $dbh->do($statement);
+ $rv = $dbh->do($statement, \%attr);
+ $rv = $dbh->do($statement, \%attr, @bind_values);
+
+Prepare and execute a single statement. Returns the number of rows affected if the
+query was successful, returns undef if an error occurred, and returns -1 if the
+number of rows is unknown or not available. Note that this method will return __0E0__ instead
+of 0 for 'no rows were affected', in order to always return a true value if no error occurred.
+
+## __last\_insert\_id__
+
+Oracle does not implement auto\_increment of serial type columns it uses predefined
+sequences where the id numbers are either selected before insert, at insert time with a trigger,
+ or as part of the query.
+
+Below is an example of you to use the latter with the SQL returning clause to get the ID number back
+on insert with the bind\_param\_inout method.
+.
+
+ $dbh->do('CREATE SEQUENCE lii_seq START 1');
+ $dbh->do(q{CREATE TABLE lii (
+ foobar INTEGER NOT NULL UNIQUE,
+ baz VARCHAR)});
+ $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";";
+ $sth = $dbh->prepare($SQL);
+ my $p_new_id='-1';
+ $sth->bind_param_inout(":p_new_id",\$p_new_id,38);
+ $sth->execute();
+ $db->commit();
+
+## __commit__
+
+ $rv = $dbh->commit;
+
+Issues a COMMIT to the server, indicating that the current transaction is finished and that
+all changes made will be visible to other processes. If AutoCommit is enabled, then
+a warning is given and no COMMIT is issued. Returns true on success, false on error.
+
+## __rollback__
+
+ $rv = $dbh->rollback;
+
+Issues a ROLLBACK to the server, which discards any changes made in the current transaction. If AutoCommit
+is enabled, then a warning is given and no ROLLBACK is issued. Returns true on success, and
+false on error.
+
+## __begin\_work__
+
+This method turns on transactions until the next call to ["commit"](#commit) or ["rollback"](#rollback), if ["AutoCommit"](#autocommit) is
+currently enabled. If it is not enabled, calling begin\_work will issue an error. Note that the
+transaction will not actually begin until the first statement after begin\_work is called.
+
+## __disconnect__
+
+ $rv = $dbh->disconnect;
+
+Disconnects from the Oracle database. Any uncommitted changes will be rolled back upon disconnection. It's
+good policy to always explicitly call commit or rollback at some point before disconnecting, rather than
+relying on the default rollback behavior.
+
+If the script exits before disconnect is called (or, more precisely, if the database handle is no longer
+referenced by anything), then the database handle's DESTROY method will call the rollback() and disconnect()
+methods automatically. It is best to explicitly disconnect rather than rely on this behavior.
+
+## __ping__
+
+ $rv = $dbh->ping;
+
+This `ping` method is used to check the validity of a database handle. The value returned is
+either 0, indicating that the connection is no longer valid, or 1, indicating the connection is valid.
+This function does 1 round trip to the Oracle Server.
+
+## __get\_info()__
+
+ $value = $dbh->get_info($info_type);
+
+DBD::Oracle supports `get_info()`, but (currently) only a few info types.
+
+## __table\_info()__
+
+DBD::Oracle supports attributes for `table_info()`.
+
+In Oracle, the concept of _user_ and _schema_ is (currently) the
+same. Because database objects are owned by an user, the owner names
+in the data dictionary views correspond to schema names.
+Oracle does not support catalogues so TABLE\_CAT is ignored as
+selection criterion.
+
+Search patterns are supported for TABLE\_SCHEM and TABLE\_NAME.
+
+TABLE\_TYPE may contain a comma-separated list of table types.
+The following table types are supported:
+
+ TABLE
+ VIEW
+ SYNONYM
+ SEQUENCE
+
+The result set is ordered by TABLE\_TYPE, TABLE\_SCHEM, TABLE\_NAME.
+
+The special enumerations of catalogues, schemas and table types are
+supported. However, TABLE\_CAT is always NULL.
+
+An identifier is passed _as is_, i.e. as the user provides or
+Oracle returns it.
+`table_info()` performs a case-sensitive search. So, a selection
+criterion should respect upper and lower case.
+Normally, an identifier is case-insensitive. Oracle stores and
+returns it in upper case. Sometimes, database objects are created
+with quoted identifiers (for reserved words, mixed case, special
+characters, ...). Such an identifier is case-sensitive (if not all
+upper case). Oracle stores and returns it as given.
+`table_info()` has no special quote handling, neither adds nor
+removes quotes.
+
+## __primary\_key\_info()__
+
+Oracle does not support catalogues so TABLE\_CAT is ignored as
+selection criterion.
+The TABLE\_CAT field of a fetched row is always NULL (undef).
+See ["table\_info()"](#table_info) for more detailed information.
+
+If the primary key constraint was created without an identifier,
+PK\_NAME contains a system generated name with the form SYS\_Cn.
+
+The result set is ordered by TABLE\_SCHEM, TABLE\_NAME, KEY\_SEQ.
+
+An identifier is passed _as is_, i.e. as the user provides or
+Oracle returns it.
+See ["table\_info()"](#table_info) for more detailed information.
+
+## __foreign\_key\_info()__
+
+This method (currently) supports the extended behaviour of SQL/CLI, i.e. the
+result set contains foreign keys that refer to primary __and__ alternate keys.
+The field UNIQUE\_OR\_PRIMARY distinguishes these keys.
+
+Oracle does not support catalogues, so `$pk_catalog` and `$fk_catalog` are
+ignored as selection criteria (in the new style interface).
+The UK\_TABLE\_CAT and FK\_TABLE\_CAT fields of a fetched row are always
+NULL (undef).
+See ["table\_info()"](#table_info) for more detailed information.
+
+If the primary or foreign key constraints were created without an identifier,
+UK\_NAME or FK\_NAME contains a system generated name with the form SYS\_Cn.
+
+The UPDATE\_RULE field is always 3 ('NO ACTION'), because Oracle (currently)
+does not support other actions.
+
+The DELETE\_RULE field may contain wrong values. This is a known Bug (#1271663)
+in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and
+'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other
+actions (incl. 'SET NULL') appear as 'NO ACTION'.
+
+The DEFERABILITY field is always NULL, because this columns is
+not present in the ALL\_CONSTRAINTS view of older Oracle releases.
+
+The result set is ordered by UK\_TABLE\_SCHEM, UK\_TABLE\_NAME, FK\_TABLE\_SCHEM,
+FK\_TABLE\_NAME, ORDINAL\_POSITION.
+
+An identifier is passed _as is_, i.e. as the user provides or
+Oracle returns it.
+See ["table\_info()"](#table_info) for more detailed information.
+
+## __column\_info()__
+
+Oracle does not support catalogues so TABLE\_CAT is ignored as
+selection criterion.
+The TABLE\_CAT field of a fetched row is always NULL (undef).
+See ["table\_info()"](#table_info) for more detailed information.
+
+The CHAR\_OCTET\_LENGTH field is (currently) always NULL (undef).
+
+Don't rely on the values of the BUFFER\_LENGTH field!
+Especially the length of FLOATs may be wrong.
+
+Datatype codes for non-standard types are subject to change.
+
+Attention! The DATA\_DEFAULT (COLUMN\_DEF) column is of type LONG so you
+may have to set LongReadLen on the connection handle before calling
+column\_info if you have a large default column. After DBD::Oracle 1.40
+LongReadLen is set automatically to 1Mb when calling column\_info and
+reset aftwerwards.
+
+The result set is ordered by TABLE\_SCHEM, TABLE\_NAME, ORDINAL\_POSITION.
+
+An identifier is passed _as is_, i.e. as the user provides or
+Oracle returns it.
+See ["table\_info()"](#table_info) for more detailed information.
+
+It is possible with Oracle to make the names of the various DB objects (table,column,index etc)
+case sensitive.
+
+ alter table bloggind add ("Bla_BLA" NUMBER)
+
+So in the example the exact case "Bla\_BLA" must be used to get it info on the column. While this
+
+ alter table bloggind add (Bla_BLA NUMBER)
+
+any case can be used to get info on the column.
+
+## __statistics\_info()__
+
+Oracle does not support catalogues so TABLE\_CAT is ignored as
+selection criterion.
+The TABLE\_CAT field of a fetched row is always NULL (undef).
+See ["table\_info()"](#table_info) for more detailed information.
+
+The INDEX\_QUALIFIER field of a fetched row is always NULL (undef),
+for the same reason as for TABLE\_CAT.
+
+If an index was created without an identifier
+(e.g. in the course of a PK creation),
+INDEX\_NAME contains a system generated name with the form SYS\_.
+
+COLUMN\_NAME may contain a system generated name
+(e.g. for function-based indexes).
+
+For the TYPE column, a simple mapping is used:
+
+ NORMAL btree
+ CLUSTER clustered
+ ... other
+
+The `$quick` parameter is currently ignored.
+The method uses the dictionary with the gathered statistics,
+thus cannot ensure that the values for CARDINALITY and PAGES are current.
+
+The result set is ordered by
+NON\_UNIQUE, TYPE, INDEX\_QUALIFIER, INDEX\_NAME, ORDINAL\_POSITION.
+
+An identifier is passed _as is_, i.e. as the user provides or
+Oracle returns it.
+See ["table\_info()"](#table_info) for more detailed information.
+
+## __selectrow\_array__
+
+ @row_ary = $dbh->selectrow_array($sql);
+ @row_ary = $dbh->selectrow_array($sql, \%attr);
+ @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values);
+
+Returns an array of row information after preparing and executing the provided SQL string. The rows are returned
+by calling ["fetchrow\_array"](#fetchrow_array). The string can also be a statement handle generated by a previous prepare. Note that
+only the first row of data is returned. If called in a scalar context, only the first column of the first row is
+returned. Because this is not portable, it is not recommended that you use this method in that way.
+
+## __selectrow\_arrayref__
+
+ $ary_ref = $dbh->selectrow_arrayref($statement);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
+
+Exactly the same as ["selectrow\_array"](#selectrow_array), except that it returns a reference to an array, by internal use of
+the ["fetchrow\_arrayref"](#fetchrow_arrayref) method.
+
+## __selectrow\_hashref__
+
+ $hash_ref = $dbh->selectrow_hashref($sql);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values);
+
+Exactly the same as ["selectrow\_array"](#selectrow_array), except that it returns a reference to an hash, by internal use of
+the ["fetchrow\_hashref"](#fetchrow_hashref) method.
+
+## __clone__
+
+ $other_dbh = $dbh->clone();
+
+Creates a copy of the database handle by connecting with the same parameters as the original
+handle, then trying to merge the attributes. See the DBI documentation for complete usage.
+
+# DATABASE HANDLE ATTRIBUTES
+
+## __AutoCommit__ (boolean)
+
+Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is on, but this may change
+in the future, so it is highly recommended that you explicitly set it when
+calling ["connect"](#connect).
+
+## __ReadOnly__ (boolean)
+
+ $dbh->{ReadOnly} = 1;
+
+Specifies if the current database connection should be in read-only mode or not.
+
+Please not that this method is not foolproof: there are still ways to update the
+database. Consider this a safety net to catch applications that should not be
+issuing commands such as INSERT, UPDATE, or DELETE.
+
+This method method requires DBI version 1.55 or better.
+
+## __Name__ (string, read-only)
+
+Returns the name of the current database. This is the same as the DSN, without the
+"dbi:Oracle:" part.
+
+## __Username__ (string, read-only)
+
+Returns the name of the user connected to the database.
+
+## __Driver__ (handle, read-only)
+
+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}
+
+## __RowCacheSize__
+
+DBD::Oracle supports both Server pre-fetch and Client side row caching. By default both
+are turned on to give optimum performance. Most of the time one can just let DBD::Oracle
+figure out the best optimization.
+
+### __Row Caching__
+
+Row caching occurs on the client side and the object of it is to cut down the number of round
+trips made to the server when fetching rows. At each fetch a set number of rows will be retrieved
+from the server and stored locally. Further calls the server are made only when the end of the
+local buffer(cache) is reached.
+
+Rows up to the specified top level row
+count `RowCacheSize` are fetched if it occupies no more than the specified memory usage limit.
+The default value is 0, which means that memory size is not included in computing the number of rows to prefetch. If
+the `RowCacheSize` value is set to a negative number then the positive value of RowCacheSize is used
+to compute the number of rows to prefetch.
+
+By default `RowCacheSize` is automatically set. If you want to totally turn off prefetching set this to 1.
+
+For any SQL statement that contains a LOB, Long or Object Type Row Caching will be turned off. However server side
+caching still works. If you are only selecting a LOB Locator then Row Caching will still work.
+
+### Row Prefetching
+
+Row prefetching occurs on the server side and uses the DBI database handle attribute `RowCacheSize` and or the
+Prepare Attribute 'ora\_prefetch\_memory'. Tweaking these values may yield improved performance.
+
+ $dbh->{RowCacheSize} = 100;
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000});
+
+In the above example 10 rows will be prefetched up to a maximum of 10000 bytes of data. The Oracle Call Interface Programmer's Guide,
+suggests a good row cache value for a scrollable cursor is about 20% of expected size of the record set.
+
+The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes) when it needs to get new rows. This happens on the first
+fetch that sets the current\_positon to any value other than 0. In the above example if we do a OCI\_FETCH\_FIRST the first 10 rows are
+loaded into the buffer and DBD::Oracle will not have to go back to the server for more rows. When record 11 is fetched DBD::Oracle
+fetches and returns this row and the next 9 rows are loaded into the buffer. In this case if you fetch backwards from 10 to 1
+no server round trips are made.
+
+With large record sets it is best not to attempt to go to the last record as this may take some time, A large buffer size might even slow down
+the fetch. If you must get the number of rows in a large record set you might try using an few large OCI\_FETCH\_ABSOLUTEs and then an OCI\_FETCH\_LAST,
+this might save some time. So if you had a record set of 10000 rows and you set the buffer to 5000 and did a OCI\_FETCH\_LAST one would fetch the first 5000 rows into the buffer then the next 5000 rows.
+If one requires only the first few rows there is no need to set a large prefetch value.
+
+If the ora\_prefetch\_memory less than 1 or not present then memory size is not included in computing the
+number of rows to prefetch otherwise the number of rows will be limited to memory size. Likewise if the RowCacheSize is less than 1 it
+is not included in the computing of the prefetch rows.
+
+# ORACLE-SPECIFIC STATEMENT HANDLE METHODS
+
+## __ora\_stmt\_type__
+
+Returns the OCI Statement Type number for the SQL of a statement handle.
+
+## __ora\_stmt\_type\_name__
+
+Returns the OCI Statement Type name for the SQL of a statement handle.
+
+# DBI STATEMENT HANDLE OBJECT METHODS
+
+## __bind\_param__
+
+ $rv = $sth->bind_param($param_num, $bind_value);
+ $rv = $sth->bind_param($param_num, $bind_value, $bind_type);
+ $rv = $sth->bind_param($param_num, $bind_value, \%attr);
+
+Allows the user to bind a value and/or a data type to a placeholder.
+
+The value of `$param_num` is a number if using the '?' or if using ":foo" style placeholders, the complete name
+(e.g. ":foo") must be given.
+The `$bind_value` argument is fairly self-explanatory. A value of `undef` will
+bind a `NULL` to the placeholder. Using `undef` is useful when you want
+to change just the type and will be overwriting the value later.
+(Any value is actually usable, but `undef` is easy and efficient).
+
+The `\%attr` hash is used to indicate the data type of the placeholder.
+The default value is "varchar". If you need something else, you must
+use one of the values provided by DBI or by DBD::Pg. To use a SQL value,
+modify your "use DBI" statement at the top of your script as follows:
+
+ use DBI qw(:sql_types);
+
+This will import some constants into your script. You can plug those
+directly into the ["bind\_param"](#bind_param) call. Some common ones that you will
+encounter are:
+
+ SQL_INTEGER
+
+To use Oracle SQL data types, import the list of values like this:
+
+ use DBD::Pg qw(:ora_types);
+
+You can then set the data types by setting the value of the `ora_type`
+key in the hash passed to ["bind\_param"](#bind_param).
+The current list of Oracle data types exported is:
+
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
+
+Data types are "sticky," in that once a data type is set to a certain placeholder,
+it will remain for that placeholder, unless it is explicitly set to something
+else afterwards. If the statement has already been prepared, and you switch the
+data type to something else, DBD::Oracle will re-prepare the statement for you before
+doing the next execute.
+
+Examples:
+
+ use DBI qw(:sql_types);
+ use DBD::Pg qw(:ora_types);
+
+ $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?";
+ $sth = $dbh->prepare($SQL);
+
+ ## Both arguments below are bound to placeholders as "varchar"
+ $sth->execute(123, "Merk");
+
+ ## Reset the datatype for the first placeholder to an integer
+ $sth->bind_param(1, undef, SQL_INTEGER);
+
+ ## The "undef" bound above is not used, since we supply params to execute
+ $sth->execute(123, "Merk");
+
+ ## Set the first placeholder's value and data type
+ $sth->bind_param(1, 234, { pg_type => ORA_NUMBER });
+
+ ## Set the second placeholder's value and data type.
+ ## We don't send a third argument, so the default "varchar" is used
+ $sth->bind_param('$2', "Zool");
+
+ ## We realize that the wrong data type was set above, so we change it:
+ $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER });
+
+ ## We also got the wrong value, so we change that as well.
+ ## Because the data type is sticky, we don't need to change it
+ $sth->bind_param(1, 567);
+
+ ## This executes the statement with 567 (integer) and "Zool" (varchar)
+ $sth->execute();
+
+These attributes may be used in the `\%attr` parameter of the
+["bind\_param" in DBI](https://metacpan.org/pod/DBI#bind_param) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) statement handle methods.
+
+- ora\_type
+
+ Specify the placeholder's datatype using an Oracle datatype.
+ A fatal error is raised if `ora_type` and the DBI `TYPE` attribute
+ are used for the same placeholder.
+ Some of these types are not supported by the current version of
+ DBD::Oracle and will cause a fatal error if used.
+ Constants for the Oracle datatypes may be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+ Potentially useful values when DBD::Oracle was built using OCI 7 and later:
+
+ ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW,
+ ORA_CHAR, ORA_MLSLABEL, ORA_RSET
+
+ Additional values when DBD::Oracle was built using OCI 8 and later:
+
+ ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE
+
+ Additional values when DBD::Oracle was built using OCI 9.2 and later:
+
+ SQLT_CHR, SQLT_BIN
+
+ See ["Binding Cursors"](#binding-cursors) for the correct way to use ORA\_RSET.
+
+ See ["LOBS AND LONGS"](#lobs-and-longs) for how to use ORA\_CLOB and ORA\_BLOB.
+
+ See ["SYS.DBMS\_SQL datatypes"](#sys-dbms_sql-datatypes) for ORA\_VARCHAR2\_TABLE, ORA\_NUMBER\_TABLE.
+
+ See ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) for the correct way to use SQLT\_CHR and SQLT\_BIN.
+
+ See ["OTHER DATA TYPES"](#other-data-types) for more information.
+
+ See also ["Placeholders and Bind Values" in DBI](https://metacpan.org/pod/DBI#Placeholders-and-Bind-Values).
+
+- ora\_csform
+
+ Specify the OCI\_ATTR\_CHARSET\_FORM for the bind value. Valid values
+ are SQLCS\_IMPLICIT (1) and SQLCS\_NCHAR (2). Both those constants can
+ be imported from the DBD::Oracle module. Rarely needed.
+
+- ora\_csid
+
+ Specify the _integer_ OCI\_ATTR\_CHARSET\_ID for the bind value.
+ Character set names can't be used currently.
+
+- ora\_maxdata\_size
+
+ Specify the integer OCI\_ATTR\_MAXDATA\_SIZE for the bind value.
+ May be needed if a character set conversion from client to server
+ causes the data to use more space and so fail with a truncation error.
+
+- ora\_maxarray\_numentries
+
+ Specify the maximum number of array entries to allocate. Used with
+ ORA\_VARCHAR2\_TABLE, ORA\_NUMBER\_TABLE. Define the maximum number of
+ array entries Oracle can pass back to you in OUT variable of type
+ TABLE OF ... .
+
+- ora\_internal\_type
+
+ Specify internal data representation. Currently is supported only for
+ ORA\_NUMBER\_TABLE.
+
+### Optimizing Results
+
+#### Prepare Postponed Till Execute
+
+The DBD::Oracle module can avoid an explicit 'describe' operation
+prior to the execution of the statement unless the application requests
+information about the results (such as $sth->{NAME}). This reduces
+communication with the server and increases performance (reducing the
+number of PARSE\_CALLS inside the server).
+
+However, it also means that SQL errors are not detected until
+`execute()` (or $sth->{NAME} etc) is called instead of when
+`prepare()` is called. Note that if the describe is triggered by the
+use of $sth->{NAME} or a similar attribute and the describe fails then
+_an exception is thrown_ even if `RaiseError` is false!
+
+Set ["ora\_check\_sql"](#ora_check_sql) to 0 in prepare() to enable this behaviour.
+
+## __bind\_param\_inout__
+
+ $rv = $sth->bind_param_inout($param_num, \$scalar, 0);
+
+DBD::Oracle fully supports bind\_param\_inout below are some uses for this method.
+
+### __Returning A Value from an INSERT__
+
+Oracle supports an extended SQL insert syntax which will return one
+or more of the values inserted. This can be particularly useful for
+single-pass insertion of values with re-used sequence values
+(avoiding a separate "select seq.nextval from dual" step).
+
+ $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, :bar)
+ RETURNING id INTO :id
+ });
+ $sth->bind_param(":bar", 42);
+ $sth->bind_param_inout(":id", \my $new_id, 99);
+ $sth->execute;
+ print "The id of the new record is $new_id\n";
+
+If you have many columns to bind you can use code like this:
+
+ @params = (... column values for record to be inserted ...);
+ $sth->bind_param($_, $params[$_-1]) for (1..@params);
+ $sth->bind_param_inout(@params+1, \my $new_id, 99);
+ $sth->execute;
+
+If you have many rows to insert you can take advantage of Oracle's built in execute array feature
+with code like this:
+
+ my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10');
+ my @out_values;
+ my @status;
+ my $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, ?)
+ RETURNING id INTO ?
+ });
+ $sth->bind_param_array(1,\@in_values);
+ $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2});
+ $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting";
+ foreach my $id (@out_values){
+ print 'returned id='.$id.'\n';
+ }
+
+Which will return all the ids into @out\_values.
+
+- __Note:__
+- This will only work for numbered (?) placeholders,
+- The third parameter of bind\_param\_inout\_array, (0 in the example), "maxlen" is required by DBI but not used by DBD::Oracle
+- The "ora\_type" attribute is not needed but only ORA\_VARCHAR2 will work.
+
+### Returning A Recordset
+
+DBD::Oracle does not currently support binding a PL/SQL table (aka array)
+as an IN OUT parameter to any Perl data structure. You cannot therefore call
+a PL/SQL function or procedure from DBI that uses a non-atomic datatype as
+either a parameter, or a return value. However, if you are using Oracle 9.0.1
+or later, you can make use of table (or pipelined) functions.
+
+For example, assume you have the existing PL/SQL Package :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ --
+ l_Ret taRec ;
+ --
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+ --
+ END Array_Example ;
+ /
+
+Currently, there is no way to directly call the function
+Array\_Example.Array\_Func from DBI. However, by making the following relatively
+painless additions, its not only possible, but extremely efficient.
+
+First, you need to create database object types that correspond to the record
+and table types in the package. From the above example, these would be :
+
+ CREATE OR REPLACE TYPE tArray_Example__taRec
+ AS OBJECT (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE
+ ) ;
+
+ CREATE OR REPLACE TYPE taArray_Example__taRec
+ AS TABLE OF tArray_Example__taRec ;
+
+Now, assuming the existing function needs to remain unchanged (it is probably
+being called from other PL/SQL code), we need to add a new function to the
+package. Here's the new package specification and body :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ l_Ret taRec ;
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS
+ l_Set taRec ;
+ BEGIN
+ l_Set := Array_Func ;
+ FOR i IN l_Set.FIRST .. l_Set.LAST LOOP
+ PIPE ROW (
+ tArray_Example__taRec (
+ l_Set (i).Col1,
+ l_Set (i).Col2,
+ l_Set (i).Col3
+ )
+ ) ;
+ END LOOP ;
+ RETURN ;
+ END ;
+ --
+ END Array_Example ;
+
+As you can see, the new function is very simple. Now, it is a simple matter
+of calling the function as a straight-forward SELECT from your DBI code. From
+the above example, the code would look something like this :
+
+ my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)');
+ $sth->execute;
+ while ( my ($col1, $col2, $col3) = $sth->fetchrow_array {
+ ...
+ }
+
+### __SYS.DBMS\_SQL datatypes__
+
+DBD::Oracle has built-in support for __SYS.DBMS\_SQL.VARCHAR2\_TABLE__
+and __SYS.DBMS\_SQL.NUMBER\_TABLE__ datatypes. The simple example is here:
+
+ my $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl.count();
+ tbl(1) := \'def\';
+ tbl(2) := \'ijk\';
+ :mytable := tbl;
+ END;
+ ';
+
+ my $sth=$dbh->prepare( $statement );
+
+ my @arr=( "abc","efg","hij" );
+
+ $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_VARCHAR2_TABLE,
+ ora_maxarray_numentries => 100
+ } ) ;
+ $sth->bind_param_inout(":cc", \$cc, 100 );
+ $sth->execute();
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+- __Note:__
+- Take careful note that we use '\\\\@arr' here because the 'bind\_param\_inout'
+ will only take a reference to a scalar.
+
+### __ORA\_VARCHAR2\_TABLE__
+
+SYS.DBMS\_SQL.VARCHAR2\_TABLE object is always bound to array reference.
+( in bind\_param() and bind\_param\_inout() ). When you bind array, you need
+to specify full buffer size for OUT data. So, there are two parameters:
+_max\_len_ (specified as 3rd argument of bind\_param\_inout() ),
+and _ora\_maxarray\_numentries_. They define maximum array entry length and
+maximum rows, that can be passed to Oracle and back to you. In this
+example we send array with 1 element with length=3, but allocate space for 100
+Oracle array entries with maximum length 10 of each. So, you can get no more
+than 100 array entries with length <= 10.
+
+If you set _max\_len_ to zero, maximum array entry length is calculated
+as maximum length of entry of array bound. If 0 < _max\_len_ < length( $some\_element ),
+truncation occur.
+
+If you set _ora\_maxarray\_numentries_ to zero, current (at bind time) bound
+array length is used as maximum. If 0 < _ora\_maxarray\_numentries_ < scalar(@array),
+not all array entries are bound.
+
+### __ORA\_NUMBER\_TABLE__
+
+SYS.DBMS\_SQL.NUMBER\_TABLE object handling is much alike ORA\_VARCHAR2\_TABLE.
+The main difference is internal data representation. Currently 2 types of
+bind is allowed : as C-integer, or as C-double type. To select one of them,
+you may specify additional bind parameter _ora\_internal\_type_ as either
+__SQLT\_INT__ or __SQLT\_FLT__ for C-integer and C-double types.
+Integer size is architecture-specific and is usually 32 or 64 bit.
+Double is standard IEEE 754 type.
+
+_ora\_internal\_type_ defaults to double (SQLT\_FLT).
+
+_max\_len_ is ignored for OCI\_NUMBER\_TABLE.
+
+Currently, you cannot bind full native Oracle NUMBER(38). If you really need,
+send request to dbi-dev list.
+
+The usage example is here:
+
+ $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.NUMBER_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl(2);
+ tbl(4) := -1;
+ tbl(5) := -2;
+ :mytable := tbl;
+ END;
+ ';
+
+ $sth=$dbh->prepare( $statement );
+
+ if( ! defined($sth) ){
+ die "Prepare error: ",$dbh->errstr,"\n";
+ }
+
+ @arr=( 1,"2E0","3.5" );
+
+ # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE .
+ if( not $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_NUMBER_TABLE,
+ ora_maxarray_numentries => (scalar(@arr)+2),
+ ora_internal_type => SQLT_FLT
+ } ) ){
+ die "bind :mytable error: ",$dbh->errstr,"\n";
+ }
+ $cc=undef;
+ if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
+ die "bind :cc error: ",$dbh->errstr,"\n";
+ }
+
+ if( not $sth->execute() ){
+ die "Execute failed: ",$dbh->errstr,"\n";
+ }
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+The result is like:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ '1',
+ '2',
+ '3.5',
+ '-1',
+ '-2'
+ ];
+
+If you change bind type to __SQLT\_INT__, like:
+
+ ora_internal_type => SQLT_INT
+
+you get:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ 1,
+ 2,
+ 3,
+ -1,
+ -2
+ ];
+
+## __bind\_param\_inout\_array__
+
+DBD::Oracle supports this undocumented feature of DBI. See ["Returning A Value from an INSERT"](#returning-a-value-from-an-insert) for an example.
+
+## __bind\_param\_array__
+
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr)
+
+Binds an array of values to a placeholder, so that each is used in turn by a call
+to the ["execute\_array"](#execute_array) method.
+
+## __execute__
+
+ $rv = $sth->execute(@bind_values);
+
+Perform whatever processing is necessary to execute the prepared statement.
+
+## __execute\_array__
+
+ $tuples = $sth->execute_array() or die $sth->errstr;
+ $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 a prepared statement once for each item in a passed-in hashref, or items that
+were previously bound via the ["bind\_param\_array"](#bind_param_array) method. See the DBI documentation
+for more details.
+
+DBD::Oracle takes full advantage of OCI's array interface so inserts and updates using this interface will run very
+quickly.
+
+## __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);
+
+Used internally by the ["execute\_array"](#execute_array) method, and rarely used directly. See the
+DBI documentation for more details.
+
+## __fetchrow\_arrayref__
+
+ $ary_ref = $sth->fetchrow_arrayref;
+
+Fetches the next row of data from the statement handle, and returns a reference to an array
+holding the column values. Any columns that are NULL are returned as undef within the array.
+
+If there are no more rows or if an error occurs, the this method return undef. You should
+check `$sth->err` afterwards (or use the ["RaiseError"](#raiseerror) attribute) to discover if the 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 ["bind\_columns"](#bind_columns).
+
+## __fetchrow\_array__
+
+ @ary = $sth->fetchrow_array;
+
+Similar to the ["fetchrow\_arrayref"](#fetchrow_arrayref) method, but returns a list of column information rather than
+a reference to a list. Do not use this in a scalar context.
+
+## __fetchrow\_hashref__
+
+ $hash_ref = $sth->fetchrow_hashref;
+ $hash_ref = $sth->fetchrow_hashref($name);
+
+Fetches the next row of data and returns a hashref containing the name of the columns as the keys
+and the data itself as the values. Any NULL value is returned as undef value.
+
+If there are no more rows or if an error occurs, the this method return undef. You should
+check `$sth->err` afterwards (or use the ["RaiseError"](#raiseerror) attribute) to discover if the undef returned
+was due to an error.
+
+The optional `$name` argument should be either `NAME`, `NAME_lc` or `NAME_uc`, and indicates
+what sort of transformation to make to the keys in the hash. By default Oracle uses upper case.
+
+## __fetchall\_arrayref__
+
+ $tbl_ary_ref = $sth->fetchall_arrayref();
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice );
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
+
+Returns a reference to an array of arrays that contains all the remaining rows to be fetched from the
+statement handle. If there are no more rows, an empty arrayref will be returned. If an error occurs,
+the data read in so far will be returned. Because of this, you should always check `$sth->err` after
+calling this method, unless ["RaiseError"](#raiseerror) has been enabled.
+
+If `$slice` is an array reference, fetchall\_arrayref uses the ["fetchrow\_arrayref"](#fetchrow_arrayref) method 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, fetchall\_arrayref acts as if passed an empty array ref.
+
+If `$slice` is a hash reference, fetchall\_arrayref uses ["fetchrow\_hashref"](#fetchrow_hashref) to fetch each row as a hash reference.
+
+See the DBI documentation for a complete discussion.
+
+## __fetchall\_hashref__
+
+ $hash_ref = $sth->fetchall_hashref( $key_field );
+
+Returns a hashref containing all rows to be fetched from the statement handle. See the DBI documentation for
+a full discussion.
+
+## __finish__
+
+ $rv = $sth->finish;
+
+Indicates to DBI that you are finished with the statement handle and are not going to use it again. Only needed
+when you have not fetched all the possible rows.
+
+## __rows__
+
+ $rv = $sth->rows;
+
+Returns the number of rows affected for updates, deletes and inserts and -1 for selects.
+
+## __bind\_col__
+
+ $rv = $sth->bind_col($column_number, \$var_to_bind);
+ $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr );
+ $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
+
+Binds a Perl variable and/or some attributes to an output column of a SELECT statement.
+Column numbers count up from 1. You do not need to bind output columns in order to fetch data.
+
+NOTE: DBD::Oracle does not use the `$bind_type` to determine how to
+bind the column; it uses what Oracle says the data type is. You can
+however set the StrictlyTyped/DiscardString attributes and these will
+take effect as these attributes are applied after the column is
+retrieved.
+
+See the DBI documentation for a discussion of the optional parameters `\%attr` and `$bind_type`
+
+## __bind\_columns__
+
+ $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
+
+Calls the ["bind\_col"](#bind_col) method for each column in the SELECT statement, using the supplied list.
+
+## __dump\_results__
+
+ $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
+
+Fetches all the rows from the statement handle, calls `DBI::neat_list` for each row, and
+prints the results to `$fh` (which defaults to `STDOUT`). Rows are separated by `$lsep` (which defaults
+to a newline). Columns are separated by `$fsep` (which defaults to a comma). The `$maxlen` controls
+how wide the output can be, and defaults to 35.
+
+This method is designed as a handy utility for prototyping and testing queries. Since it uses
+"neat\_list" to format and edit the string for reading by humans, it is not recommended
+for data transfer applications.
+
+# STATEMENT HANDLE ATTRIBUTES
+
+## __NUM\_OF\_FIELDS__ (integer, read-only)
+
+Returns the number of columns returned by the current statement. A number will only be returned for
+SELECT statements for INSERT,
+UPDATE, and DELETE statements which contain a RETURNING clause.
+This method returns undef if called before `execute()`.
+
+## __NUM\_OF\_PARAMS__ (integer, read-only)
+
+Returns the number of placeholders in the current statement.
+
+## __NAME__ (arrayref, read-only)
+
+Returns an arrayref of column names for the current statement. This
+method will only work for SELECT statements, for SHOW statements, and for
+INSERT, UPDATE, and DELETE statements which contain a RETURNING clause.
+This method returns undef if called before `execute()`.
+
+## __NAME\_lc__ (arrayref, read-only)
+
+The same as the `NAME` attribute, except that all column names are forced to lower case.
+
+## __NAME\_uc__ (arrayref, read-only)
+
+The same as the `NAME` attribute, except that all column names are forced to upper case.
+
+## __NAME\_hash__ (hashref, read-only)
+
+Similar to the `NAME` attribute, but returns a hashref of column names instead of an arrayref. The names of the columns
+are the keys of the hash, and the values represent the order in which the columns are returned, starting at 0.
+This method returns undef if called before `execute()`.
+
+## __NAME\_lc\_hash__ (hashref, read-only)
+
+The same as the `NAME_hash` attribute, except that all column names are forced to lower case.
+
+## __NAME\_uc\_hash__ (hashref, read-only)
+
+The same as the `NAME_hash` attribute, except that all column names are forced to lower case.
+
+## __TYPE__ (arrayref, read-only)
+
+Returns an arrayref indicating the data type for each column in the statement.
+This method returns undef if called before `execute()`.
+
+## __PRECISION__ (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement.
+The number indicates the precision for `NUMERIC` columns, the size in number of
+characters for `CHAR` and `VARCHAR` columns, and for all other types of columns
+it returns the number of _bytes_.
+This method returns undef if called before `execute()`.
+
+## __SCALE__ (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement. The number
+indicates the scale of the that column. The only type that will return a value is `NUMERIC`.
+This method returns undef if called before `execute()`.
+
+## __NULLABLE__ (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement. The number
+indicates if the column is nullable or not. 0 = not nullable, 1 = nullable, 2 = unknown.
+This method returns undef if called before `execute()`.
+
+## __Database__ (dbh, read-only)
+
+Returns the database handle this statement handle was created from.
+
+## __ParamValues__ (hash ref, read-only)
+
+Returns a reference to a hash containing the values currently bound to placeholders. If the "named parameters"
+type of placeholders are being used (such as ":foo"), then the keys of the hash will be the names of the
+placeholders (without the colon). If the "dollar sign numbers" type of placeholders are being used, the keys of the hash will
+be the numbers, without the dollar signs. If the "question mark" type is used, integer numbers will be returned,
+starting at one and increasing for every placeholder.
+
+If this method is called before ["execute"](#execute), the literal values passed in are returned. If called after
+["execute"](#execute), then the quoted versions of the values are returned.
+
+## __ParamTypes__ (hash ref, read-only)
+
+Returns a reference to a hash containing the type names currently bound to placeholders. The keys
+are the same as returned by the ParamValues method. The values are hashrefs containing a single key value
+pair, in which the key is either 'TYPE' if the type has a generic SQL equivalent, and 'pg\_type' if the type can
+only be expressed by a Postgres type. The value is the internal number corresponding to the type originally
+passed in. (Placeholders that have not yet been bound will return undef as the value). This allows the output of
+ParamTypes to be passed back to the ["bind\_param"](#bind_param) method.
+
+## __Statement__ (string, read-only)
+
+Returns the statement string passed to the most recent "prepare" method called in this database handle, even if that method
+failed. This is especially useful where "RaiseError" is enabled and the exception handler checks $@ and sees that a `prepare`
+method call failed.
+
+## __RowsInCache__
+
+Returns the number of un-fetched rows in the cache for selects.
+
+# SCROLLABLE CURSORS
+
+Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where
+the rows can be fetched either sequentially or non-sequentially. One can fetch rows forward,
+backwards, from any given position or the n-th row from the current position in the result set.
+
+Rows are numbered sequentially starting at one and client-side caching of the partial or entire result set
+can improve performance by limiting round trips to the server.
+
+Oracle does not support DML type operations with scrollable cursors so you are limited
+to simple 'Select' operations only. As well you can not use this functionality with remote
+mapped queries or if the LONG datatype is part of the select list.
+
+However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind, and fetch methods.
+
+Only use scrollable cursors if you really have a good reason to. They do use up considerable
+more server and client resources and have poorer response times than non-scrolling cursors.
+
+## Enabling Scrollable Cursors
+
+To enable this functionality you must first import the 'Fetch Orientation' and the 'Execution Mode' constants by using;
+
+ use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes);
+
+Next you will have to tell DBD::Oracle that you will be using scrolling by setting the ora\_exe\_mode attribute on the
+statement handle to 'OCI\_STMT\_SCROLLABLE\_READONLY' with the prepare method;
+
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+
+When the statement is executed you will then be able to use 'ora\_fetch\_scroll' method to get a row
+or you can still use any of the other fetch methods but with a poorer response time than if you used a
+non-scrolling cursor. As well scrollable cursors are compatible with any applicable bind methods.
+
+## Scrollable Cursor Methods
+
+The following driver-specific methods are used with scrollable cursors.
+
+- ora\_scroll\_position
+
+ $position = $sth->ora_scroll_position();
+
+ This method returns the current position (row number) attribute of the result set. Prior to the first fetch this value is 0. This is the only time
+ this value will be 0 after the first fetch the value will be set, so you can use this value to test if any rows have been fetched.
+ The minimum value will always be 1 after the first fetch. The maximum value will always be the total number of rows in the record set.
+
+- ora\_fetch\_scroll
+
+ $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset);
+
+ Works the same as `fetchrow_arrayref`, excepts one passes in a 'Fetch Orientation' constant and a fetch\_offset
+ value which will then determine the row that will be fetched. It returns the row as a list containing the field values.
+ Null fields are returned as _undef_ values in the list.
+
+ The valid orientation constant and fetch offset values combination are detailed below
+
+ OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored.
+ OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value
+ is ignored.
+ OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored.
+ OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored.
+ OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset
+ value is ignored.
+
+ OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the
+ fetch offset value.
+
+ OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR.
+
+ The effect that a ora\_fetch\_scroll method call has on the current\_positon attribute is detailed below.
+
+ OCI_FETCH_CURRENT, has no effect on the current_positon attribute.
+ OCI_FETCH_NEXT, increments current_positon attribute by 1
+ OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT
+ OCI_FETCH_FIRST, sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the
+ record set.
+ OCI_FETCH_PRIOR, decrements current_positon attribute by 1.
+ OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change
+ current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in
+ the record set, does not change current_positon attribute, it is
+ equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute +
+ fetch offset value).
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1,
+ does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records
+ in the record set, does not change fetch offset value so it is equivalent
+ to a OCI_FETCH_CURRENT.
+
+ The effects of the differing orientation constants on the first fetch (current\_postion attribute at 0) are as follows.
+
+ OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute.
+ OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon
+ attribute to the total number of rows in the record set.
+ OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a
+ OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of
+ records in the record set is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent
+ to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number
+ of records in the record set, is equivalent to a OCI_FETCH_CURRENT.
+
+## Scrollable Cursor Usage
+
+Given a simple code like this:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes);
+ my $dbh = DBI->connect($dsn, $dbuser, '');
+ my $SQL = "select id,
+ first_name,
+ last_name
+ from employee";
+ my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+ $sth->execute();
+ my $value;
+
+and one assumes that the number of rows returned from the query is 20, the code snippets below will illustrate the use of ora\_fetch\_scroll
+method;
+
+- Fetching the Last Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute to will be 20 after this snippet. This is also a way to get the number of rows in the record set, however,
+ if the record set is large this could take some time.
+
+- Fetching the Current Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will still be 20 after this snippet.
+
+- Fetching the First Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 1 after this snippet.
+
+- Fetching the Next Row
+
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 5 after this snippet.
+
+- Fetching the Prior Row
+
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 1 after this snippet.
+
+- Fetching the 10th Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 10 after this snippet.
+
+- Fetching the 10th to 14th Row
+
+ for(my $i=10;$i<15;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 14 after this snippet.
+
+- Fetching the 14th to 10th Row
+
+ for(my $i=14;$i>9;$i--){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 10 after this snippet.
+
+- Fetching the 5th Row From the Present Position.
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 15 after this snippet.
+
+- Fetching the 9th Row Prior From the Present Position
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+ The current\_positon attribute will be 6 after this snippet.
+
+- Use Finish
+
+ $sth->finish();
+
+ When using scrollable cursors it is required that you use the $sth->finish() method when you are done with the cursor as this type of
+ cursor has to be explicitly cancelled on the server. If you do not do this you may cause resource problems on your database.
+
+# LOBS AND LONGS
+
+The key to working with LOBs (CLOB, BLOBs) is to remember the value of an Oracle LOB column is not the content of the LOB. It's a
+'LOB Locator' which, after being selected or inserted needs extra processing to read or write the content of the LOB. There are also legacy LONG types (LONG, LONG RAW, VARCHAR2)
+which are presently deprecated by Oracle but are still in use. These LONG types do not utilize a 'LOB Locator' and also are more limited in
+functionality than CLOB or BLOB fields.
+
+DBD::Oracle now offers three interfaces to LOB and LONG data,
+
+- ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs)
+
+ With this interface DBD::Oracle handles your data directly utilizing regular OCI calls, Oracle itself takes care of the LOB Locator operations in the case of
+ BLOBs and CLOBs treating them exactly as if they were the same as the legacy LONG or LONG RAW types.
+
+- ["Data Interface for LOB Locators"](#data-interface-for-lob-locators)
+
+ With this interface DBD::Oracle handles your data utilizing LOB Locator OCI calls so it only works with CLOB and BLOB datatypes. With this interface DBD::Oracle takes care of the LOB Locator operations for you.
+
+- ["LOB Locator Method Interface"](#lob-locator-method-interface)
+
+ This allows the user direct access to the LOB Locator methods, so you have to take case of the LOB Locator operations yourself.
+
+Generally speaking the interface that you will chose will be dependent on what end you are trying to achieve. All have their benefits and
+drawbacks.
+
+One point to remember when working with LOBs (CLOBs, BLOBs) is if your LOB column can be in one of three states;
+
+- NULL
+
+ The table cell is created, but the cell holds no locator or value.
+ If your LOB field is in this state then there is no LOB Locator that DBD::Oracle can work so if your encounter a
+
+ DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr
+
+ error when working with a LOB.
+
+ You can correct this by using an SQL UPDATE statement to reset the LOB column to a non-NULL (or empty LOB) value with either EMPTY\_BLOB or EMPTY\_CLOB as in this example;
+
+ UPDATE lob_example
+ SET bindata=EMPTY_BLOB()
+ WHERE bindata IS NULL.
+
+- Empty
+
+ A LOB instance with a locator exists in the cell, but it has no value. The length of the LOB is zero. In this case DBD::Oracle will return 'undef' for the field.
+
+- Populated
+
+ A LOB instance with a locator and a value exists in the cell. You actually get the LOB value.
+
+## Data Interface for Persistent LOBs
+
+This is the original interface for LONG and LONG RAW datatypes and from Oracle 9iR1 and later the OCI API was extended to work directly with the other LOB datatypes.
+In other words you can treat all LOB type data (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using the same techniques
+you would use on other datatypes that store character or binary data. In some cases there are fewer round trips to the server as no 'LOB Locators' are
+used, normally one can get an entire LOB is a single round trip.
+
+### Simple Fetch for LONGs and LONG RAWs
+
+As the name implies this is the simplest way to use this interface. DBD::Oracle just attempts to get your LONG datatypes as a single large piece.
+There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LONG or LONG RAW.
+If the size of the LONG or LONG RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'.
+The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on. You have most likely reached this limit if you run into
+an 'ORA-01062: unable to allocate memory for define buffer' error. One solution is to set the size of 'LongReadLen' to a lower value.
+
+For example give this table;
+
+ CREATE TABLE test_long (
+ id NUMBER,
+ long1 long)
+
+this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select out all of the long1 fields in the table as long as they are all under 2MB in length. A value in long1 longer than this will throw an error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+before the execute will return all the long1 fields but they will be truncated at 2MBs.
+
+### Using ora\_ncs\_buff\_mtpl
+
+When getting CLOBs and NCLOBs in or out of Oracle, the Server will translate from the Server's NCharSet to the
+Client's. If they happen to be the same or at least compatible then all of these actions are a 1 char to 1 char bases.
+Thus if you set your LongReadLen buffer to 10\_000\_000 you will get up to 10\_000\_000 char.
+
+However if the Server has to translate from one NCharSet to another it will use bytes for conversion. The buffer
+value is set to 4 \* LONG\_READ\_LEN which was very wasteful as you might only be asking for 10\_000\_000 bytes
+but you were actually using 40\_000\_000 bytes of buffer under the hood. You would still get 10\_000\_000 bytes
+(maybe less characters though) but you are using allot more memory that you need.
+
+You can now customize the size of the buffer by setting the 'ora\_ncs\_buff\_mtpl' either on the connection or statement handle. You can
+also set this as 'ORA\_DBD\_NCS\_BUFFER' OS environment variable so you will have to go back and change all your code if you are getting into trouble.
+
+The default value is still set to 4 for backward compatibility. You can lower this value and thus increase the amount of data you can retrieve. If the
+ora\_ncs\_buff\_mtpl is too small DBD::Oracle will throw and error telling you to increase this buffer by one.
+
+If the error is not captured then you may get at some random point later on, usually at a finish() or disconnect() or even a fetch() this error;
+
+ ORA-03127: no new operations allowed until the active operation ends
+
+This is one of the more obscure ORA errors (have some fun and report it to Meta-Link they will scratch their heads for hours)
+
+If you get this, simply increment the ora\_ncs\_buff\_mtpl by one until it goes away.
+
+This should greatly increase your ability to select very large CLOBs or NCLOBs, by freeing up a large block of memory.
+
+You can tune this value by setting ora\_oci\_success\_warn which will display the following
+
+ OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen
+ 20(characters), BufLen 80(characters), Got 28(characters)
+
+In the case above the query Got 28 characters (well really only 20 characters of 28 bytes) so we could use ora\_ncs\_buff\_mtpl=>2 (20\*2=40) thus saving 40bytes of memory.
+
+### Simple Fetch for CLOBs and BLOBs
+
+To use this interface for CLOBs and LOBs datatypes set the 'ora\_pers\_lob' attribute of the statement handle to '1' with the prepare method, as well
+set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. If the size of the LOB exceeds
+the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'.
+The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on in the same way that LONGs and LONG RAWs are.
+
+For CLOBs and NCLOBs the limit is 64k chars if there is no truncation, this is an internal OCI limit complain to them if you want it changed. However if you CLOB is longer than this
+and also larger than the 'LongReadLen' than the 'LongReadLen' in chars is returned.
+
+It seems with BLOBs you are not limited by the 64k.
+
+For example give this table;
+
+ CREATE TABLE test_lob (id NUMBER,
+ clob1 CLOB,
+ clob2 CLOB,
+ blob1 BLOB,
+ blob2 BLOB)
+
+this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 2MB in length. Longer lobs will throw an error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+before the execute will return all the lobs but they will be truncated at 2MBs.
+
+### Piecewise Fetch with Callback
+
+With a piecewise callback fetch DBD::Oracle sets up a function that will 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece.
+To use this interface set the 'ora\_clbk\_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora\_piece\_size' to the size of the piece that
+you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected
+size of the LOB. Like the ["Simple Fetch for LONGs and LONG RAWs"](#simple-fetch-for-longs-and-long-raws) and ["Simple Fetch for CLOBs and BLOBs"](#simple-fetch-for-clobs-and-blobs) the if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB
+or set the 'LongReadLen' to a higher value. With this interface the value of 'ora\_piece\_size' seems to be constrained by the same memory limit as found on
+the Simple Fetch interface. If you encounter an 'ORA-01062' error try setting the value of 'ora\_piece\_size' to a smaller value. The value for 'LongReadLen' is
+dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs
+in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance.
+
+Using the table from the last example this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4\*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will throw an error.
+
+Using the table from the first example (LONG) this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 filed is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4\*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error.
+
+#### Piecewise Fetch with Polling
+
+With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora\_piece\_lob'
+attribute of the statement handle to '1' with the prepare method. Next set the 'ora\_piece\_size' to the size of the piece that
+you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected
+size of the LOB. Like the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback) and Simple Fetches if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB
+or set the 'LongReadLen' to a higher value. With this interface the value of 'ora\_piece\_size' seems to be constrained by the same memory limit as found on
+the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback).
+
+Using the table from the example above this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4\*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will throw an error.
+
+Finally with this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 field is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4\*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error.
+
+### Binding for Updates and Inserts for CLOBs and BLOBs
+
+To bind for updates and inserts all that is required to use this interface is to set the statement handle's prepare method
+'ora\_type' attribute to 'SQLT\_CHR' in the case of CLOBs and NCLOBs or 'SQLT\_BIN' in the case of BLOBs as in this example for an insert;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+ my $in_blob ="0101" for 1 .. 10_000;
+
+ $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)';
+ $sth=$dbh->prepare($SQL );
+ $sth->bind_param(1,3);
+ $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->execute();
+
+So far the only limit reached with this form of insert is the LOBs must be under 2GB in size.
+
+### Support for Remote LOBs;
+
+Starting with Oracle 10gR2 the interface for Persistent LOBs was expanded to support remote LOBs (access over a dblink). Given a database called 'lob\_test' that has a 'LINK' defined like this;
+
+ CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test';
+
+to a remote database called 'test\_lobs', the following code will work;
+
+ $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test');
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Below are the limitations of Remote LOBs;
+
+- Queries involving more than one database are not supported;
+
+ so the following returns an error:
+
+ SELECT t1.lobcol,
+ a2.lobcol
+ FROM t1,
+ t2.lobcol@dbs2 a2 W
+ WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol);
+
+ as does:
+
+ SELECT t1.lobcol
+ FROM t1@dbs1
+ UNION ALL
+ SELECT t2.lobcol
+ FROM t2@dbs2;
+
+- DDL commands are not supported;
+
+ so the following returns an error:
+
+ CREATE VIEW v AS SELECT lob_col FROM tab@dbs;
+
+- Only binds and defines for data going into remote persistent LOBs are supported.
+
+ so that parameter passing in PL/SQL where CHAR data is bound or defined for remote LOBs is not allowed .
+
+ These statements all produce errors:
+
+ SELECT foo() FROM table1@dbs2;
+
+ SELECT foo()@dbs INTO char_val FROM DUAL;
+
+ SELECT XMLType().getclobval FROM table1@dbs2;
+
+- If the remote object is a view such as
+
+ CREATE VIEW v AS SELECT foo() FROM ...
+
+ the following would not work:
+
+ SELECT * FROM v@dbs2;
+
+- Limited PL/SQL parameter passing
+
+ PL/SQL parameter passing is not allowed where the actual argument is a LOB type
+ and the remote argument is one of VARCHAR2, NVARCHAR2, CHAR, NCHAR, or RAW.
+
+- RETURNING INTO does not support implicit conversions between CHAR and CLOB.
+
+ so the following returns an error:
+
+ SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test
+
+## Locator Data Interface
+
+### Simple Usage
+
+When fetching LOBs with this interface a 'LOB Locator' is created then used to get the lob with the LongReadLen and LongTruncOk attributes.
+The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs
+in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance.
+
+When inserting or updating LOBs some _major_ magic has to be performed
+behind the scenes to make it transparent. Basically the driver has to
+insert a 'LOB Locator' and then refetch the newly inserted LOB
+Locator before being able to write the data into it. However, it works
+well most of the time, and I've made it as fast as possible, just one
+extra server-round-trip per insert or update after the first. For the
+time being, only single-row LOB updates are supported.
+
+To insert or update a large LOB using a placeholder, DBD::Oracle has to
+know in advance that it is a LOB type. So you need to say:
+
+ $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB });
+
+The ORA\_CLOB and ORA\_BLOB constants can be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+or use the corresponding integer values (112 and 113).
+
+One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has
+to be able to tell which parameters relate to which table fields.
+In all cases where it can possibly work it out for itself, it does,
+however, if there are multiple LOB fields of the same type in the table
+then you need to tell it which field each LOB param relates to:
+
+ $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' });
+
+There are some limitations inherent in the way DBD::Oracle makes typical
+LOB operations simple by hiding the LOB Locator processing:
+
+ - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL)
+ - To INSERT a LOB, you need UPDATE privilege.
+
+The alternative is to disable the automatic LOB Locator processing.
+If ["ora\_auto\_lob"](#ora_auto_lob) is 0 in prepare(), you can fetch the LOB Locators and
+do all the work yourself using the ora\_lob\_\*() methods.
+See the ["Data Interface for LOB Locators"](#data-interface-for-lob-locators) section below.
+
+### LOB support in PL/SQL
+
+LOB Locators can be passed to PL/SQL calls by binding them to placeholders
+with the proper `ora_type`. If ["ora\_auto\_lob"](#ora_auto_lob) is true, output LOB
+parameters will be automatically returned as strings.
+
+If the Oracle driver has support for temporary LOBs (Oracle 9i and higher),
+strings can be bound to input LOB placeholders and will be automatically
+converted to LOBs.
+
+Example:
+ # Build a large XML document, bind it as a CLOB,
+ # extract elements through PL/SQL and return as a CLOB
+
+ # $dbh is a connected database handle
+ # output will be large
+
+ local $dbh->{LongReadLen} = 1_000_000;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+
+ my $out_clob;
+
+
+ my $sth = $dbh->prepare(<<PLSQL_END);
+ -- extract 'value' nodes
+ DECLARE
+ x XMLTYPE := XMLTYPE(:in);
+ BEGIN
+ :out := x.extract('/document/value').getClobVal();
+ END;
+
+ PLSQL_END
+
+ # :in param will be converted to a temp lob
+ # :out parameter will be returned as a string.
+
+ $sth->bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } );
+ $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } );
+ $sth->execute;
+
+If you ever get an
+
+ ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt
+
+error, while attempting to insert a LOB, this means the Oracle user has insufficient space for LOB you are trying to insert.
+One solution it to use "alter database datafile 'sss.ggg' resize Mnnn" to increase the available memory for LOBs.
+
+## Persistent & Locator Interface Caveats
+
+Now that one has the option of using the Persistent or the Locator interface for LOBs the questions arises
+which one to use. For starters, if you want to access LOBs over a dblink you will have to use the Persistent
+interface so that choice is simple. The question of which one to use after that is a little more tricky.
+It basically boils down to a choice between LOB size and speed.
+
+The Callback and Polling piecewise fetches are very very slow
+when compared to the Simple and the Locator fetches but they can handle very large blocks of data. Given a situation where a
+large LOB is to be read the Locator fetch may time out while either of the piecewise fetches may not.
+
+With the Simple fetch you are limited by physical memory of your server but it runs a little faster than the Locator, as there are fewer round trips
+to the server. So if you have small LOBs and need to save a little bandwidth this is the one to use. It you are going after large LOBs then the Locator interface is the one to use.
+
+If you need to update more than a single row of with LOB data then the Persistent interface can do it while the Locator can't.
+
+If you encounter a situation where you have to access the legacy LOBs (LONG, LONG RAW) and the values are to large for you system then you can use
+the Callback or Polling piecewise fetches to get all of the data.
+
+Not all of the Persistent interface has been implemented yet, the following are not supported;
+
+ 1) Piecewise, polling and callback binds for INSERT and UPDATE operations.
+ 2) Piecewise array binds for SELECT, INSERT and UPDATE operations.
+
+Most of the time you should just use the ["Locator Data Interface"](#locator-data-interface) as this is in one that has the best combination of speed and size.
+
+All this being said if you are doing some critical programming I would use the ["Data Interface for LOB Locators"](#data-interface-for-lob-locators) as this gives you very
+fine grain control of your LOBs, of course the code for this will be somewhat more involved.
+
+## Data Interface for LOB Locators
+
+The following driver-specific methods let you manipulate "LOB Locators" directly.
+To select a LOB locator directly set the if the `ora_auto_lob`
+attribute to false, or alternatively they can be returned via PL/SQL procedure calls.
+
+(If using a DBI version earlier than 1.36 they must be called via the
+func() method. Note that methods called via func() don't honour
+RaiseError etc, and so it's important to check $dbh->err after each call.
+It's recommended that you upgrade to DBI 1.38 or later.)
+
+Note that LOB locators are only valid while the statement handle that
+created them is valid. When all references to the original statement
+handle are lost, the handle is destroyed and the locators are freed.
+
+- ora\_lob\_read
+
+ $data = $dbh->ora_lob_read($lob_locator, $offset, $length);
+
+ Read a portion of the LOB. $offset starts at 1.
+ Uses the Oracle OCILobRead function.
+
+ NOTE: DBD::Oracle post 1.46 will return undef for any read lob if the
+ length specified in the ora\_lob\_read is 0. See RT 55028. This avoids
+ the potential problem with empty lobs (created with empty\_clob) which
+ return a length of 0 from ora\_lob\_length and prior to 1.46 a call to
+ ora\_lob\_read with a 0 length would segfault.
+
+- ora\_lob\_write
+
+ $rc = $dbh->ora_lob_write($lob_locator, $offset, $data);
+
+ Write/overwrite a portion of the LOB. $offset starts at 1.
+ Uses the Oracle OCILobWrite function.
+
+- ora\_lob\_append
+
+ $rc = $dbh->ora_lob_append($lob_locator, $data);
+
+ Append $data to the LOB. Uses the Oracle OCILobWriteAppend function.
+
+- ora\_lob\_trim
+
+ $rc = $dbh->ora_lob_trim($lob_locator, $length);
+
+ Trims the length of the LOB to $length.
+ Uses the Oracle OCILobTrim function.
+
+- ora\_lob\_length
+
+ $length = $dbh->ora_lob_length($lob_locator);
+
+ Returns the length of the LOB.
+ Uses the Oracle OCILobGetLength function.
+
+- ora\_lob\_is\_init
+
+ $is_init = $dbh->ora_lob_is_init($lob_locator);
+
+ Returns true(1) if the Lob Locator is initialized false(0) if it is not, or 'undef'
+ if there is an error.
+ Uses the Oracle OCILobLocatorIsInit function.
+
+- ora\_lob\_chunk\_size
+
+ $chunk_size = $dbh->ora_lob_chunk_size($lob_locator);
+
+ Returns the chunk size of the LOB.
+ Uses the Oracle OCILobGetChunkSize function.
+
+ For optimal performance, Oracle recommends reading from and
+ writing to a LOB in batches using a multiple of the LOB chunk size.
+ In Oracle 10g and before, when all defaults are in place, this
+ chunk size defaults to 8k (8192).
+
+### LOB Locator Method Examples
+
+_Note:_ Make sure you first read the note in the section above about
+multi-byte character set issues with these methods.
+
+The following examples demonstrate the usage of LOB Locators
+to read, write, and append data, and to query the size of
+large data.
+
+The following examples assume a table containing two large
+object columns, one binary and one character, with a primary
+key column, defined as follows:
+
+ CREATE TABLE lob_example (
+ lob_id INTEGER PRIMARY KEY,
+ bindata BLOB,
+ chardata CLOB
+ )
+
+It also assumes a sequence for use in generating unique
+lob\_id field values, defined as follows:
+
+ CREATE SEQUENCE lob_example_seq
+
+### Example: Inserting a new row with large data
+
+Unless enough memory is available to store and bind the
+entire LOB data for insert all at once, the LOB columns must
+be written interactively, piece by piece. In the case of a new row,
+this is performed by first inserting a row, with empty values in
+the LOB columns, then modifying the row by writing the large data
+interactively to the LOB columns using their LOB locators as handles.
+
+The insert statement must create token values in the LOB
+columns. Here, we use the empty string for both the binary
+and character large object columns 'bindata' and 'chardata'.
+
+After the INSERT statement, a SELECT statement is used to
+acquire LOB locators to the 'bindata' and 'chardata' fields
+of the newly inserted row. Because these LOB locators are
+subsequently written, they must be acquired from a select
+statement containing the clause 'FOR UPDATE' (LOB locators
+are only valid within the transaction that fetched them, so
+can't be used effectively if AutoCommit is enabled).
+
+ my $lob_id = $dbh->selectrow_array( <<" SQL" );
+ SELECT lob_example_seq.nextval FROM DUAL
+ SQL
+
+ my $sth = $dbh->prepare( <<" SQL" );
+ INSERT INTO lob_example
+ ( lob_id, bindata, chardata )
+ VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() )
+ SQL
+ $sth->execute( $lob_id );
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata, chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator, $char_locator ) = $sth->fetchrow_array();
+ $sth->finish();
+
+ open BIN_FH, "/binary/data/source" or die;
+ open CHAR_FH, "/character/data/source" or die;
+ my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator );
+
+ # BEGIN WRITING BIN_DATA COLUMN
+ my $offset = 1; # Offsets start at 1, not 0
+ my $length = 0;
+ my $buffer = '';
+ while( $length = read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $bin_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+ # BEGIN WRITING CHAR_DATA COLUMN
+ $chunk_size = $dbh->ora_lob_chunk_size( $char_locator );
+ $offset = 1; # Offsets start at 1, not 0
+ $length = 0;
+ $buffer = '';
+ while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $char_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+In this example we demonstrate the use of ora\_lob\_write()
+interactively to append data to the columns 'bin\_data' and
+'char\_data'. Had we used ora\_lob\_append(), we could have
+saved ourselves the trouble of keeping track of the offset
+into the lobs. The snippet of code beneath the comment
+'BEGIN WRITING BIN\_DATA COLUMN' could look as follows:
+
+ my $buffer = '';
+ while ( read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_append( $bin_locator, $buffer );
+ }
+
+The scalar variables $offset and $length are no longer
+needed, because ora\_lob\_append() keeps track of the offset
+for us.
+
+### Example: Updating an existing row with large data
+
+In this example, we demonstrate a technique for overwriting
+a portion of a blob field with new binary data. The blob
+data before and after the section overwritten remains
+unchanged. Hence, this technique could be used for updating
+fixed length subfields embedded in a binary field.
+
+ my $lob_id = 5; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator ) = $sth->fetchrow_array();
+
+ my $offset = 100234;
+ my $data = "This string will overwrite a portion of the blob";
+ $dbh->ora_lob_write( $bin_locator, $offset, $data );
+
+After running this code, the row where lob\_id = 5 will
+contain, starting at position 100234 in the bin\_data column,
+the string "This string will overwrite a portion of the blob".
+
+### Example: Streaming character data from the database
+
+In this example, we demonstrate a technique for streaming
+data from the database to a file handle, in this case
+STDOUT. This allows more data to be read in and written out
+than could be stored in memory at a given time.
+
+ my $lob_id = 17; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ SQL
+ $sth->execute( $lob_id );
+ my ( $char_locator ) = $sth->fetchrow_array();
+
+ my $chunk_size = 1034; # Arbitrary chunk size, for example
+ my $offset = 1; # Offsets start at 1, not 0
+ while(1) {
+ my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size );
+ last unless length $data;
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+Notice that the select statement does not contain the phrase
+"FOR UPDATE". Because we are only reading from the LOB
+Locator returned, and not modifying the LOB it refers to,
+the select statement does not require the "FOR UPDATE"
+clause.
+
+A word of caution when using the data returned from an ora\_lob\_read in a conditional statement.
+for example if the code below;
+
+ while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) {
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+was used with a chunk size of 4096 against a blob that requires more than 1 chunk to return
+the data and the last chunk is one byte long and contains a zero (ASCII 48) you will miss this last byte
+as $data will contain 0 which PERL will see as false and not print it out.
+
+### Example: Truncating existing large data
+
+In this example, we truncate the data already present in a
+large object column in the database. Specifically, for each
+row in the table, we truncate the 'bindata' value to half
+its previous length.
+
+After acquiring a LOB Locator for the column, we query its
+length, then we trim the length by half. Because we modify
+the large objects with the call to ora\_lob\_trim(), we must
+select the LOB locators 'FOR UPDATE'.
+
+ my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ FOR UPATE
+ SQL
+ $sth->execute();
+ while( my ( $bin_locator ) = $sth->fetchrow_array() ) {
+ my $binlength = $dbh->ora_lob_length( $bin_locator );
+ if( $binlength > 0 ) {
+ $dbh->ora_lob_trim( $bin_locator, $binlength/2 );
+ }
+ }
+
+# SPACES AND PADDING
+
+## Trailing Spaces
+
+Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder
+values and uses Nonpadded Comparison Semantics with the result.
+This causes trouble if the spaces are needed for
+comparison with a CHAR value or to prevent the value from
+becoming '' which Oracle treats as NULL.
+Look for Blank-padded Comparison Semantics and Nonpadded
+Comparison Semantics in Oracle's SQL Reference or Server
+SQL Reference for more details.
+
+To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8,
+either change the default placeholder type with ["ora\_ph\_type"](#ora_ph_type) or the placeholder
+type for a particular call to ["bind" in DBI](https://metacpan.org/pod/DBI#bind) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout)
+with ["ora\_type"](#ora_type) or `TYPE`.
+Using [ORA\_CHAR](https://metacpan.org/pod/ORA_CHAR) with [ora\_type](https://metacpan.org/pod/ora_type) or `SQL_CHAR` with `TYPE`
+allows the placeholder to be used with Padded Comparison Semantics
+if the value it is being compared to is a CHAR, NCHAR, or literal.
+
+Please remember that using spaces as a value or at the end of
+a value makes visually distinguishing values with different
+numbers of spaces difficult and should be avoided.
+
+Oracle Clients that use OCI 9.2 do not strip trailing spaces.
+
+## Padded Char Fields
+
+Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR.
+As the default placeholder type value in DBD::Oracle is ORA\_VARCHAR2 to access this behaviour you will
+have to change the default placeholder type with ["ora\_ph\_type"](#ora_ph_type) or placeholder
+type for a particular call with ["bind" in DBI](https://metacpan.org/pod/DBI#bind) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout)
+with ["ORA\_CHAR"](#ora_char).
+
+# UNICODE
+
+DBD::Oracle now supports Unicode UTF-8. There are, however, a number
+of issues you should be aware of, so please read all this section
+carefully.
+
+In this section we'll discuss "Perl and Unicode", then "Oracle and
+Unicode", and finally "DBD::Oracle and Unicode".
+
+Information about Unicode in general can be found at:
+[http://www.unicode.org/](http://www.unicode.org/). It is well worth reading because there are
+many misconceptions about Unicode and you may be holding some of them.
+
+## Perl and Unicode
+
+Perl began implementing Unicode with version 5.6, but the implementation
+did not mature until version 5.8 and later. If you plan to use Unicode
+you are _strongly_ urged to use Perl 5.8.2 or later and to _carefully_ read
+the Perl documentation on Unicode:
+
+ perldoc perluniintro # in Perl 5.8 or later
+ perldoc perlunicode
+
+And then read it again.
+
+Perl's internal Unicode format is UTF-8
+which corresponds to the Oracle character set called AL32UTF8.
+
+## Oracle and Unicode
+
+Oracle supports many characters sets, including several different forms
+of Unicode. These include:
+
+ AL16UTF16 => valid for NCHAR columns (CSID=2000)
+ UTF8 => valid for NCHAR columns (CSID=871), deprecated
+ AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873)
+
+When you create an Oracle database, you must specify the DATABASE
+character set (used for DDL, DML and CHAR datatypes) and the NATIONAL
+character set (used for NCHAR and NCLOB types).
+The character sets used in your database can be found using:
+
+ $hash_ref = $dbh->ora_nls_parameters()
+ $database_charset = $hash_ref->{NLS_CHARACTERSET};
+ $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET};
+
+The Oracle 9.2 and later default for the national character set is AL16UTF16.
+The default for the database character set is often US7ASCII.
+Although many experienced DBAs will consider an 8bit character set like
+WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle
+other than US7ASCII, requires that the NLS\_LANG environment variable be set.
+See the ["Oracle UTF8 is not UTF-8"](#oracle-utf8-is-not-utf-8) section below.
+
+You are strongly urged to read the Oracle Internationalization documentation
+specifically with respect the choices and trade offs for creating
+a databases for use with international character sets.
+
+Oracle uses the NLS\_LANG environment variable to indicate what
+character set is being used on the client. When fetching data Oracle
+will convert from whatever the database character set is to the client
+character set specified by NLS\_LANG. Similarly, when sending data to
+the database Oracle will convert from the character set specified by
+NLS\_LANG to the database character set.
+
+The NLS\_NCHAR environment variable can be used to define a different
+character set for 'national' (NCHAR) character types.
+
+Both UTF8 and AL32UTF8 can be used in NLS\_LANG and NLS\_NCHAR.
+For example:
+
+ NLS_LANG=AMERICAN_AMERICA.UTF8
+ NLS_LANG=AMERICAN_AMERICA.AL32UTF8
+ NLS_NCHAR=UTF8
+ NLS_NCHAR=AL32UTF8
+
+## Oracle UTF8 is not UTF-8
+
+AL32UTF8 should be used in preference to UTF8 if it works for you,
+which it should for Oracle 9.2 or later. If you're using an old
+version of Oracle that doesn't support AL32UTF8 then you should
+avoid using any Unicode characters that require surrogates, in other
+words characters beyond the Unicode BMP (Basic Multilingual Plane).
+
+That's because the character set that Oracle calls "UTF8" doesn't
+conform to the UTF-8 standard in its handling of surrogate characters.
+Technically the encoding that Oracle calls "UTF8" is known as "CESU-8".
+Here are a couple of extracts from [http://www.unicode.org/reports/tr26/](http://www.unicode.org/reports/tr26/):
+
+ CESU-8 is useful in 8-bit processing environments where binary
+ collation with UTF-16 is required. It is designed and recommended
+ for use only within products requiring this UTF-16 binary collation
+ equivalence. It is not intended nor recommended for open interchange.
+
+ As a very small percentage of characters in a typical data stream
+ are expected to be supplementary characters, there is a strong
+ possibility that CESU-8 data may be misinterpreted as UTF-8.
+ Therefore, all use of CESU-8 outside closed implementations is
+ strongly discouraged, such as the emittance of CESU-8 in output
+ files, markup language or other open transmission forms.
+
+Oracle uses this internally because it collates (sorts) in the same order
+as UTF16, which is the basis of Oracle's internal collation definitions.
+
+Rather than change UTF8 for clients Oracle chose to define a new character
+set called "AL32UTF8" which does conform to the UTF-8 standard.
+(The AL32UTF8 character set can't be used on the server because it
+would break collation.)
+
+Because of that, for the rest of this document we'll use "AL32UTF8".
+If you're using an Oracle version below 9.2 you'll need to use "UTF8"
+until you upgrade.
+
+## DBD::Oracle and Unicode
+
+DBD::Oracle Unicode support has been implemented for Oracle versions 9
+or greater, and Perl version 5.6 or greater (though we _strongly_
+suggest that you use Perl 5.8.2 or later).
+
+You can check which Oracle version your DBD::Oracle was built with by
+importing the `ORA_OCI` constant from DBD::Oracle.
+
+__Fetching Data__
+
+Any data returned from Oracle to DBD::Oracle in the AL32UTF8
+character set will be marked as UTF-8 to ensure correct handling by Perl.
+
+For Oracle to return data in the AL32UTF8 character set the
+NLS\_LANG or NLS\_NCHAR environment variable _must_ be set as described
+in the previous section.
+
+When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle
+will set the Perl UTF-8 flag on the returned data if either NLS\_NCHAR
+is AL32UTF8, or NLS\_NCHAR is not set and NLS\_LANG is AL32UTF8.
+
+When fetching other character data from Oracle, DBD::Oracle
+will set the Perl UTF-8 flag on the returned data if NLS\_LANG is AL32UTF8.
+
+__Sending Data using Placeholders__
+
+Data bound to a placeholder is assumed to be in the default client
+character set (specified by NLS\_LANG) except for a few special
+cases. These are listed here with the highest precedence first:
+
+If the `ora_csid` attribute is given to bind\_param() then that
+is passed to Oracle and takes precedence.
+
+If the value is a Perl Unicode string (UTF-8) then DBD::Oracle
+ensures that Oracle uses the Unicode character set, regardless of
+the NLS\_LANG and NLS\_NCHAR settings.
+
+If the placeholder is for inserting an NCLOB then the client NLS\_NCHAR
+character set is used. (That's useful but inconsistent with the other behaviour
+so may change. Best to be explicit by using the `ora_csform`
+attribute.)
+
+If the `ora_csform` attribute is given to bind\_param() then that
+determines if the value should be assumed to be in the default
+(NLS\_LANG) or NCHAR (NLS\_NCHAR) client character set.
+
+ use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR );
+ ...
+ $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR });
+
+or
+
+ $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders
+
+Binding with bind\_param\_array and execute\_array is also UTF-8 compatible in the same way. If you attempt to
+insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert
+will still happen but a error code of 0 will be returned with the following warning;
+
+ DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data.
+ The Query charset id=1, name=US7ASCII
+
+The warning will report the parameter number and the NCHAR setting that the query is running.
+
+__Sending Data using SQL__
+
+Oracle assumes the SQL statement is in the default client character
+set (as specified by NLS\_LANG). So Unicode strings containing
+non-ASCII characters should not be used unless the default client
+character set is AL32UTF8.
+
+## DBD::Oracle and Other Character Sets and Encodings
+
+The only multi-byte Oracle character set supported by DBD::Oracle is
+"AL32UTF8" (and "UTF8"). Single-byte character sets should work well.
+
+# OBJECT & COLLECTION DATA TYPES
+
+Oracle databases allow for the creation of object oriented like user-defined types.
+There are two types of objects, Embedded--an object stored in a column of a regular table
+and REF--an object that uses the REF retrieval mechanism.
+
+DBD::Oracle supports only the 'selection' of embedded objects of the following types OBJECT, VARRAY
+and TABLE in any combination. Support is seamless and recursive, meaning you
+need only supply a simple SQL statement to get all the values in an embedded object.
+You can either get the values as an array of scalars or they can be returned into a DBD::Oracle::Object.
+
+Array example, given this type and table;
+
+ CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30);
+
+ CREATE TABLE "CONTACT"
+ ( "COMPANYNAME" VARCHAR2(40),
+ "ADDRESS" VARCHAR2(100),
+ "PHONE_NUMBERS" "PHONE_NUMBERS"
+ )
+
+The code to access all the data in the table could be something like this;
+
+ my $sth = $dbh->prepare('SELECT * FROM CONTACT');
+ $sth->execute;
+ while ( my ($company, $address, $phone) = $sth->fetchrow()) {
+ print "Company: ".$company."\n";
+ print "Address: ".$address."\n";
+ print "Phone #: ";
+
+ foreach my $items (@$phone){
+ print $items.", ";
+ }
+ print "\n";
+ }
+
+Note that values in PHONE\_NUMBERS are returned as an array reference '@$phone'.
+
+As stated before DBD::Oracle will automatically drill into the embedded object and extract
+all of the data as reference arrays of scalars. The example below has OBJECT type embedded in a TABLE type embedded in an
+SQL TABLE;
+
+ CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER;
+
+ CREATE OR REPLACE TYPE STUDENT AS OBJECT(
+ NAME VARCHAR2(60),
+ SOME_GRADES GRADELIST);
+
+ CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT;
+
+ CREATE TABLE GROUPS(
+ GRP_ID NUMBER(4),
+ GRP_NAME VARCHAR2(10),
+ STUDENTS STUDENTS_T)
+ NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB
+ (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB);
+
+The following code will access all of the embedded data;
+
+ $SQL='select grp_id,grp_name,students as my_students_test from groups';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){
+ print "Group ID#".$grp_id." Group Name =".$grp_name."\n";
+ foreach my $student (@$students){
+ print "Name:".$student->[0]."\n";
+ print "Marks:";
+ foreach my $grades (@$student->[1]){
+ foreach my $marks (@$grades){
+ print $marks.",";
+ }
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+
+Object example, given this object and table;
+
+ CREATE OR REPLACE TYPE Person AS OBJECT (
+ name VARCHAR2(20),
+ age INTEGER)
+ ) NOT FINAL;
+
+ CREATE TYPE Employee UNDER Person (
+ salary NUMERIC(8,2)
+ );
+
+ CREATE TABLE people (id INTEGER, obj Person);
+
+ INSERT INTO people VALUES (1, Person('Black', 25));
+ INSERT INTO people VALUES (2, Employee('Smith', 44, 5000));
+
+The following code will access the data;
+
+ $dbh{'ora_objects'} =>1;
+
+ $sth = $dbh->prepare("select * from people order by id");
+ $sth->execute();
+
+ # object are fetched as instance of DBD::Oracle::Object
+ my ($id1, $obj1) = $sth->fetchrow();
+ my ($id2, $obj2) = $sth->fetchrow();
+
+ # get full type-name of object
+ print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed
+ print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed
+
+ # get attribute NAME from object
+ print $obj1->attr('NAME')."3\n"; # 'Black' is printed
+ print $obj2->attr('NAME')."3\n"; # 'Smith' is printed
+
+ # get all atributes as hash reference
+ my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25}
+ my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44,
+ # 'SALARY' => 5000 }
+
+ # get all attributes (names and values) as array
+ my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25)
+ my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44,
+ # 'SALARY', 5000 )
+
+So far DBD::Oracle has been tested on a table with 20 embedded Objects, Varrays and Tables
+nested to 10 levels.
+
+Any NULL values found in the embedded object will be returned as 'undef'.
+
+# OTHER DATA TYPES
+
+DBD::Oracle does not _explicitly_ support most Oracle datatypes.
+It simply asks Oracle to return them as strings and Oracle does so.
+Mostly. Similarly when binding placeholder values DBD::Oracle binds
+them as strings and Oracle converts them to the appropriate type,
+such as DATE, when used.
+
+Some of these automatic conversions to and from strings use NLS
+settings to control the formatting for output and the parsing for
+input. The most common example is the DATE type. The default NLS
+format for DATE might be DD-MON-YYYY and so when a DATE type is
+fetched that's how Oracle will format the date. NLS settings also
+control the default parsing of strings into DATE values. An error
+will be generated if the contents of the string don't match the
+NLS format. If you're dealing in dates which don't match the default
+NLS format then you can either change the default NLS format or, more
+commonly, use TO\_CHAR(field, "format") and TO\_DATE(?, "format")
+to explicitly specify formats for converting to and from strings.
+
+A slightly more subtle problem can occur with NUMBER types. The
+default NLS settings might format numbers with a fullstop ("`.`")
+to separate thousands and a comma ("`,`") as the decimal point.
+Perl will generate warnings and use incorrect values when numbers,
+returned and formatted as strings in this way by Oracle, are used
+in a numeric context. You could explicitly convert each numeric
+value using the TO\_CHAR(...) function but that gets tedious very
+quickly. The best fix is to change the NLS settings. That can be
+done for an individual connection by doing:
+
+ $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'");
+
+There are some types, like BOOLEAN, that Oracle does not automatically
+convert to or from strings (pity). These need to be converted
+explicitly using SQL or PL/SQL functions.
+
+Examples:
+
+ # DATE values
+ my $sth0 = $dbh->prepare( <<SQL_END );
+ SELECT username, TO_CHAR( created, ? )
+ FROM all_users
+ WHERE created >= TO_DATE( ?, ? )
+ SQL_END
+ $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' );
+
+ # BOOLEAN values
+ my $sth2 = $dbh->prepare( <<PLSQL_END );
+ DECLARE
+ b0 BOOLEAN;
+ b1 BOOLEAN;
+ o0 VARCHAR2(32);
+ o1 VARCHAR2(32);
+
+ FUNCTION to_bool( i VARCHAR2 ) RETURN BOOLEAN IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i = 'F' OR i = '0' THEN RETURN FALSE;
+ ELSE RETURN TRUE;
+ END IF;
+ END;
+ FUNCTION from_bool( i BOOLEAN ) RETURN NUMBER IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i THEN RETURN 1;
+ ELSE RETURN 0;
+ END IF;
+ END;
+ BEGIN
+ -- Converting values to BOOLEAN
+ b0 := to_bool( :i0 );
+ b1 := to_bool( :i1 );
+
+ -- Converting values from BOOLEAN
+ :o0 := from_bool( b0 );
+ :o1 := from_bool( b1 );
+ END;
+ PLSQL_END
+ my ( $i0, $i1, $o0, $o1 ) = ( "", "Something else" );
+ $sth2->bind_param( ":i0", $i0 );
+ $sth2->bind_param( ":i1", $i1 );
+ $sth2->bind_param_inout( ":o0", \$o0, 32 );
+ $sth2->bind_param_inout( ":o1", \$o1, 32 );
+ $sth2->execute();
+ foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) {
+ $_ = "(undef)" if ! defined $_;
+ }
+ print "$i0 to $o0, $i1 to $o1\n";
+ # Result is : "'' to '(undef)', 'Something else' to '1'"
+
+## Support for Insert of XMLType (ORA\_XMLTYPE)
+
+Inserting large XML data sets into tables with XMLType fields is now supported by DBD::Oracle. The only special
+requirement is the use of bind\_param() with an attribute hash parameter that specifies ora\_type as ORA\_XMLTYPE. For
+example with a table like this;
+
+ create table books (book_id number, book_xml XMLType);
+
+one can insert data using this code
+
+ $SQL='insert into books values (1,:p_xml)';
+ $xml= '<Books>
+ <Book id=1>
+ <Title>Programming the Perl DBI</Title>
+ <Subtitle>The Cheetah Book</Subtitle>
+ <Authors>
+ <Author>T. Bunce</Author>
+ <Author>Alligator Descartes</Author>
+ </Authors>
+
+ </Book>
+ <Book id=10000>...
+ </Books>';
+ my $sth =$dbh-> prepare($SQL);
+ $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE });
+ $sth-> execute();
+
+In the above case we will assume that $xml has 10000 Book nodes and is over 32k in size and is well formed XML.
+This will also work for XML that is smaller than 32k as well. Attempting to insert malformed XML will cause an error.
+
+## Binding Cursors
+
+Cursors can be returned from PL/SQL blocks, either from stored
+functions (or procedures with OUT parameters) or
+from direct `OPEN` statements, as shown below:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types);
+ my $dbh = DBI->connect(...);
+ my $sth1 = $dbh->prepare(q{
+ BEGIN OPEN :cursor FOR
+ SELECT table_name, tablespace_name
+ FROM user_tables WHERE tablespace_name = :space;
+ END;
+ });
+ $sth1->bind_param(":space", "USERS");
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+The only special requirement is the use of `bind_param_inout()` with an
+attribute hash parameter that specifies `ora_type` as `ORA_RSET`.
+If you don't do that you'll get an error from the `execute()` like:
+"ORA-06550: line X, column Y: PLS-00306: wrong number or types of
+arguments in call to ...".
+
+Here's an alternative form using a function that returns a cursor.
+This example uses the pre-defined weak (or generic) REF CURSOR type
+SYS\_REFCURSOR. This is an Oracle 9 feature.
+
+ # Create the function that returns a cursor
+ $dbh->do(q{
+ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR
+ AS l_cursor SYS_REFCURSOR;
+ BEGIN
+ OPEN l_cursor FOR select ename, empno from emp
+ ORDER BY ename;
+ RETURN l_cursor;
+ END;
+ });
+
+ # Use the function that returns a cursor
+ my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+A cursor obtained from PL/SQL as above may be passed back to PL/SQL
+by binding for input, as shown in this example, which explicitly
+closes a cursor:
+
+ my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;");
+ $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } );
+ $sth3->execute;
+
+It is not normally necessary to close a cursor explicitly in this
+way. Oracle will close the cursor automatically at the first
+client-server interaction after the cursor statement handle is
+destroyed. An explicit close may be desirable if the reference to the
+cursor handle from the PL/SQL statement handle delays the destruction
+of the cursor handle for too long. This reference remains until the
+PL/SQL handle is re-bound, re-executed or destroyed.
+
+NOTE: From DBD::Oracle 1.57 functions or procedures returning
+SYS\_REFCURSORs which have not been opened (are still in the
+initialised state) will return undef for the cursor statement handle
+e.g., in the example above if the sp\_ListEmp function simply returned l\_cursor
+instead of opening it. This means you can have a function/procedure
+which can elect to open the cursor or not, Before this change if you called
+a function/procedure which returned a SYS\_REFCURSOR which was not opened
+DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised
+cursor.
+
+See the `curref.pl` script in the Oracle.ex directory in the DBD::Oracle
+source distribution for a complete working example.
+
+## Fetching Nested Cursors
+
+Oracle supports the use of select list expressions of type REF CURSOR.
+These may be explicit cursor expressions - `CURSOR(SELECT ...)`, or
+calls to PL/SQL functions which return REF CURSOR values. The values
+of these expressions are known as nested cursors.
+
+The value returned to a Perl program when a nested cursor is fetched
+is a statement handle. This statement handle is ready to be fetched from.
+It should not (indeed, must not) be executed.
+
+Oracle imposes a restriction on the order of fetching when nested
+cursors are used. Suppose `$sth1` is a handle for a select statement
+involving nested cursors, and `$sth2` is a nested cursor handle fetched
+from `$sth1`. `$sth2` can only be fetched from while `$sth1` is
+still active, and the row containing `$sth2` is still current in `$sth1`.
+Any attempt to fetch another row from `$sth1` renders all nested cursor
+handles previously fetched from `$sth1` defunct.
+
+Fetching from such a defunct handle results in an error with the message
+`ERROR nested cursor is defunct (parent row is no longer current)`.
+
+This means that the `fetchall...` or `selectall...` methods are not useful
+for queries returning nested cursors. By the time such a method returns,
+all the nested cursor handles it has fetched will be defunct.
+
+It is necessary to use an explicit fetch loop, and to do all the
+fetching of nested cursors within the loop, as the following example
+shows:
+
+ use DBI;
+ my $dbh = DBI->connect(...);
+ my $sth = $dbh->prepare(q{
+ SELECT dname, CURSOR(
+ SELECT ename FROM emp
+ WHERE emp.deptno = dept.deptno
+ ORDER BY ename
+ ) FROM dept ORDER BY dname
+ });
+ $sth->execute;
+ while ( my ($dname, $nested) = $sth->fetchrow_array ) {
+ print "$dname\n";
+ while ( my ($ename) = $nested->fetchrow_array ) {
+ print " $ename\n";
+ }
+ }
+
+The cursor returned by the function `sp_ListEmp` defined in the
+previous section can be fetched as a nested cursor as follows:
+
+ my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual});
+ $sth->execute;
+ my ($nested) = $sth->fetchrow_array;
+ while ( my @row = $nested->fetchrow_array ) { ... }
+
+## Pre-fetching Nested Cursors
+
+By default, DBD::Oracle pre-fetches rows in order to reduce the number of
+round trips to the server. For queries which do not involve nested cursors,
+the number of pre-fetched rows is controlled by the DBI database handle
+attribute `RowCacheSize` (q.v.).
+
+In Oracle, server side open cursors are a controlled resource, limited in
+number, on a per session basis, to the value of the initialization
+parameter `OPEN_CURSORS`. Nested cursors count towards this limit.
+Each nested cursor in the current row counts 1, as does
+each nested cursor in a pre-fetched row. Defunct nested cursors do not count.
+
+An Oracle specific database handle attribute, `ora_max_nested_cursors`,
+further controls pre-fetching for queries involving nested cursors. For
+each statement handle, the total number of nested cursors in pre-fetched
+rows is limited to the value of this parameter. The default value
+is 0, which disables pre-fetching for queries involving nested cursors.
+
+# PL/SQL Examples
+
+Most of these PL/SQL examples come from: Eric Bartley <bartley@cc.purdue.edu>.
+
+ /*
+ * PL/SQL to create package with stored procedures invoked by
+ * Perl examples. Execute using sqlplus.
+ *
+ * Use of "... OR REPLACE" prevents failure in the event that the
+ * package already exists.
+ */
+
+ CREATE OR REPLACE PACKAGE plsql_example
+ IS
+ PROCEDURE proc_np;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ );
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ );
+
+ FUNCTION func_np
+ RETURN VARCHAR2;
+
+ END plsql_example;
+ /
+
+ CREATE OR REPLACE PACKAGE BODY plsql_example
+ IS
+ PROCEDURE proc_np
+ IS
+ whoami VARCHAR2(20) := NULL;
+ BEGIN
+ SELECT USER INTO whoami FROM DUAL;
+ END;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ )
+ IS
+ BEGIN
+ RAISE_APPLICATION_ERROR(err_code, 'This is a test.');
+ END;
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ )
+ IS
+ BEGIN
+ is_odd := MOD(test_num, 2);
+ END;
+
+ FUNCTION func_np
+ RETURN VARCHAR2
+ IS
+ ret_val VARCHAR2(20);
+ BEGIN
+ SELECT USER INTO ret_val FROM DUAL;
+ RETURN ret_val;
+ END;
+
+ END plsql_example;
+ /
+ /* End PL/SQL for example package creation. */
+
+ use DBI;
+
+ my($db, $csr, $ret_val);
+
+ $db = DBI->connect('dbi:Oracle:database','user','password')
+ or die "Unable to connect: $DBI::errstr";
+
+ # So we don't have to check every DBI call we set RaiseError.
+ # See the DBI docs now if you're not familiar with RaiseError.
+ $db->{RaiseError} = 1;
+
+ # Example 1 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Calling a PLSQL procedure that takes no parameters. This shows you the
+ # basic's of what you need to execute a PLSQL procedure. Just wrap your
+ # procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
+ #
+ # p.s. If you've used SQL*Plus's exec command all it does is wrap the
+ # command in a BEGIN END; block for you.
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_NP;
+ END;
+ });
+ $csr->execute;
+
+
+ # Example 2 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Now we call a procedure that has 1 IN parameter. Here we use bind_param
+ # to bind out parameter to the prepared statement just like you might
+ # do for an INSERT, UPDATE, DELETE, or SELECT statement.
+ #
+ # I could have used positional placeholders (e.g. :1, :2, etc.) or
+ # ODBC style placeholders (e.g. ?), but I prefer Oracle's named
+ # placeholders (but few DBI drivers support them so they're not portable).
+
+ my $err_code = -20001;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN(:err_code);
+ END;
+ });
+
+ $csr->bind_param(":err_code", $err_code);
+
+ # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
+ # Because we set RaiseError, the DBI will croak (die) so we catch that with eval.
+ eval {
+ $csr->execute;
+ };
+ print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n";
+
+
+ # Example 3 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Building on the last example, I've added 1 IN OUT parameter. We still
+ # use a placeholders in the call to prepare, the difference is that
+ # we now call bind_param_inout to bind the value to the place holder.
+ #
+ # Note that the third parameter to bind_param_inout is the maximum size
+ # of the variable. You normally make this slightly larger than necessary.
+ # But note that the Perl variable will have that much memory assigned to
+ # it even if the actual value returned is shorter.
+
+ my $test_num = 5;
+ my $is_odd;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd);
+ END;
+ });
+
+ # The value of $test_num is _copied_ here
+ $csr->bind_param(":test_num", $test_num);
+
+ $csr->bind_param_inout(":is_odd", \$is_odd, 1);
+
+ # The execute will automagically update the value of $is_odd
+ $csr->execute;
+
+ print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n";
+
+
+ # Example 4 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # What about the return value of a PLSQL function? Well treat it the same
+ # as you would a call to a function from SQL*Plus. We add a placeholder
+ # for the return value and bind it with a call to bind_param_inout so
+ # we can access it's value after execute.
+
+ my $whoami = "";
+
+ $csr = $db->prepare(q{
+ BEGIN
+ :whoami := PLSQL_EXAMPLE.FUNC_NP;
+ END;
+ });
+
+ $csr->bind_param_inout(":whoami", \$whoami, 20);
+ $csr->execute;
+ print "Your database user name is $whoami\n";
+
+ $db->disconnect;
+
+You can find more examples in the t/plsql.t file in the DBD::Oracle
+source directory.
+
+Oracle 9.2 appears to have a bug where a variable bound
+with bind\_param\_inout() that isn't assigned to by the executed
+PL/SQL block may contain garbage.
+See [http://www.mail-archive.com/dbi-users@perl.org/msg18835.html](http://www.mail-archive.com/dbi-users@perl.org/msg18835.html)
+
+## Avoid Using "SQL Call"
+
+Avoid using the "SQL Call" statement with DBD:Oracle as you might find that
+DBD::Oracle will not raise an exception in some case. Specifically if you use
+"SQL Call" to run a procedure all "No data found" exceptions will be quietly
+ignored and returned as null. According to Oracle support this is part of the same
+mechanism where;
+
+ select (select * from dual where 0=1) from dual
+
+returns a null value rather than an exception.
+
+# CONTRIBUTING
+
+If you'd like DBD::Oracle to do something new or different the best way
+to make that happen is to do it yourself and email to dbi-dev@perl.org a
+patch of the source code (using 'diff' - see below) that shows the changes.
+
+## How to create a patch using Subversion
+
+The DBD::Oracle source code is maintained using Subversion (a replacement
+for CVS, see [http://subversion.tigris.org/](http://subversion.tigris.org/)). To access the source
+you'll need to install a Subversion client. Then, to get the source
+code, do:
+
+ svn checkout http://svn.perl.org/modules/dbd-oracle/trunk
+
+If it prompts for a username and password use your perl.org account
+if you have one, else just 'guest' and 'guest'. The source code will
+be in a new subdirectory called `trunk`.
+
+To keep informed about changes to the source you can send an empty email
+to dbd-oracle-changes-subscribe@perl.org after which you'll get an email with the
+change log message and diff of each change checked-in to the source.
+
+After making your changes you can generate a patch file, but before
+you do, make sure your source is still upto date using:
+
+ svn update
+
+If you get any conflicts reported you'll need to fix them first.
+Then generate the patch file from within the `trunk` directory using:
+
+ svn diff > foo.patch
+
+Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org.
+
+## How to create a patch without Subversion
+
+Unpack a fresh copy of the distribution:
+
+ tar xfz DBD-Oracle-1.40.tar.gz
+
+Rename the newly created top level directory:
+
+ mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo
+
+Edit the contents of DBD-Oracle-1.40.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 _another_ copy of the original distribution you started with:
+
+ tar xfz DBD-Oracle-1.40.tar.gz
+
+Then create a patch file by performing a recursive `diff` on the two
+top level directories:
+
+ diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.your_foo.patch
+
+## 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.
+
+## GitHub repository
+
+A git mirror of the subversion is also available at
+\`https://github.com/yanick/DBD-Oracle\`.
+
+# WHICH VERSION OF DBD::ORACLE IS FOR ME?
+
+From version 1.25 onwards DBD::Oracle only support Oracle clients
+9.2 or greater. Support for ProC connections was dropped in 1.29.
+
+If you are still stuck with an older version of Oracle or its client you might want to look at the table below.
+
+ +---------------------+-----------------------------------------------------+
+ | | Oracle Version |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 0.1~16 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.17 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.18 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.19 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.20 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.21~1.24 | N | N | N | N | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.25+ | N | N | N | N | N | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+
+As there are dozens of different versions of Oracle's clients this
+list does not include all of them, just the major released versions of
+Oracle.
+
+Note that one can still connect to any Oracle version with the older
+DBD::Oracle versions the only problem you will have is that some of
+the newer OCI and Oracle features available in later DBD::Oracle
+releases will not be available to you.
+
+So to make a short story a little longer:
+
+1. If you are using Oracle 7 or early 8 DB and you can manage to get a 9 client and you can use
+any DBD::Oracle version.
+2. If you have to use an Oracle 7 client then DBD::Oracle 1.17 should work
+3. Same thing for 8 up to R2, use 1.17, if you are lucky and have the right patch-set you might
+go with 1.18.
+4. For 8iR3 you can use any of the DBD::Oracle versions up to 1.21. Again this depends on your
+patch-set, If you run into trouble go with 1.19
+5. After 9.2 you can use any version you want.
+6. It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go back to 7
+and even get to 10. I am not sure what the 11g client can connect to.
+
+# BUGS AND LIMITATIONS
+
+There is a known problem with the 11.2g Oracle client and the
+`DBMS_LOB.GETLENGTH()` PL/SQL function.
+See [https://rt.cpan.org/Public/Bug/Display.html?id=69350](https://rt.cpan.org/Public/Bug/Display.html?id=69350) for the details.
+
+# SEE ALSO
+
+- [DBI](https://metacpan.org/pod/DBI)
+
+ http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in
+ the DBD::Oracle source distribution including the examples in the
+ Oracle.ex directory
+
+- DBD::Oracle Tutorial
+
+ http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-oracle.html
+
+- Oracle Instant Client
+
+ http://www.oracle.com/technology/tech/oci/instantclient/index.html
+
+- Oracle on Linux
+
+ http://www.ixora.com.au/
+
+- Free Oracle Tools and Links
+
+ ora\_explain supplied and installed with DBD::Oracle.
+
+ http://www.orafaq.com/
+
+ http://vonnieda.org/oracletool/
+
+- Commercial Oracle Tools and Links
+
+ Assorted tools and references for general information.
+ No recommendation implied.
+
+ http://www.platinum.com
+
+ http://www.SoftTreeTech.com
+
+ Also PL/Vision from RevealNet and Steven Feuerstein, and
+ "Q" from Savant Corporation.
+
+# AUTHORS
+
+DBI by Tim Bunce [http://www.tim.bunce.name](http://www.tim.bunce.name).
+
+The original `DBD::Oracle` was by Tim Bunce.
+Maintained as of release 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the
+auspice of the Pythian Group ([http://www.pythian.com](http://www.pythian.com)).
+
+# ACKNOWLEDGEMENTS
+
+A great many people have helped with DBD::Oracle over the 17 years
+between 1994 and 2011. Far too many to name, but we thank them all.
+Many are named in the Changes file.
+
+# COPYRIGHT
+
+The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland.
+The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The Pythian Group). Canada.
+The DBD::Oracle module is Copyright (c) 2011 John Scoles. Canada.
+
+The DBD::Oracle module is free open source software; you can
+redistribute it and/or modify it under the same terms as Perl 5.
+
+# AUTHORS
+
+- Tim Bunce <timb@cpan.org>
+- John Scoles <byterock@cpan.org>
+- Yanick Champoux <yanick@cpan.org>
+- Martin J. Evans <mjevans@cpan.org>
+
+# COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
@@ -1,142 +0,0 @@
-I have no intention of becoming a channel for Oracle Support Services
-but this is a significant security hole and so I'm making an exception.
-
------ Forwarded message from Oracle Support Services <MEDIAGRP@US.ORACLE.COM> -----
-
-Date: Fri, 7 May 1999 06:29:09 -0700
-From: Oracle Support Services <MEDIAGRP@US.ORACLE.COM>
-Subject: SUID Security Issue
-
-Platform: UNIX
-
-Distribution: Internal & External
-
-Problem Subject Line: SUID Security
-
-Product: Oracle Enterprise Manager 2.0.4
- Oracle Data Server
-
-Oracle Version: 8.0.3, 8.0.4, 8.0.5, 8.1.5
-
-Component: Intelligent Agent
- Oracle Data Server
-
-Component Version: 8.0.3, 8.0.4, 8.0.5, 8.1.5
-
-Sub-Component: N/A
-
-Platform Version: All Unix Versions.
-
-Errors: N/A
-
-Revision Date: 6-March-1999
-
-Problem Description:
-
-On UNIX platforms, some executable files have the setuid (SUID)
-bit on. It may be possible for a knowledgeable user to use
-these executables to bypass your system security by elevating
-their operating system privileges. Oracle Corporation has
-identified issues regarding executables with SUID set in
-Oracle releases 8.0.3, 8.0.4, 8.0.5 and 8.1.5 on UNIX platforms
-only. This problem will be fixed in Oracle releases 8.0.6 and
-8.1.6.
-
-Depending on your Oracle installation, the available patch will 1)
-correct the SUID bits on applicable files, and/or 2) delete the
-oratclsh file. This shell script should be run immediately, and also
-should be run after each relink of Oracle.
-
-You can download the patch from Oracle Support?s MetaLink website by
-going to the following URL,
-http://support.oracle.com/ml/plsql/mlv15.frame?call_type=download&javaFlag=JAVA.
-Once you are in this page, select 'Oracle RDBMS' as the product
-and then click on the 'Go' button. Then download patch named 'setuid.'
-
-Please contact Oracle Worldwide Support for any additional issues.
-
------ End forwarded message -----
-
-Date: Sat, 08 May 1999 19:12:52 -0700
-From: Mark Dedlow <dedlow@voro.lbl.gov>
-
-I went to the URL listed for the patch, but it appears you can't get to
-it directly. It requires a Oracle Metalink account, and even then, you
-have to follow a bunch of links to get it, you can't go direct (at
-least I couldn't at the URL in the announcement).
-
-You don't really need the patch however, it's just a shell script that
-in effect does chmod -s on everything in $ORACLE_HOME/bin except
-'oracle' and 'dbsnmp' (needed only for OEM or SNMP).
-
-Also, although the patch didn't address the issue, make sure _nothing_
-below ORACLE_HOME is owned by root. There are some installations that
-make certain files setuid to root (files that are trivial to compromise).
-
-Mark
-
-
-------------------------------------------------------------------------------
-
-From: Dan Sugalski <sugalskd@osshe.edu>
-Date: Mon, 10 May 1999 09:13:28 -0700
-
-The patch actually removes the setuid bit on a number of oracle
-executables. The 'unset' list is:
-
-lsnrctl oemevent onrsd osslogin tnslsnr tnsping trcasst trcroute cmctl
-cmadmin cmgw names namesctl otrccref otrcfmt otrcrep otrccol oracleO
-
-While the 'must set' list is:
-
-oracle dbsnmp
-
-The shell script to fix the bits properly was posted to the oracle list
-running at telelists.com. Check the archives there for it if you want.
-(www.telelists.com) I think it's also gone out to one of the BUGTRAQ
-lists, and some of the CERTs might have it too.
-
- Dan
-
-------------------------------------------------------------------------------
-
-Date: Wed, 12 May 1999 11:49:45 -0700
-From: Mark Dedlow <dedlow@voro.lbl.gov>
-
-> The patch actually removes the setuid bit on a number of oracle
-> executables. The 'unset' list is:
->
-> lsnrctl oemevent onrsd osslogin tnslsnr tnsping trcasst trcroute cmctl
-> cmadmin cmgw names namesctl otrccref otrcfmt otrcrep otrccol oracleO
-
-Actually, there's a little more than that. For each item in that list,
-it also looks for a version of the file with a 0 or O appended to it
-(these are backups the link makefiles create), so the above list isn't
-exactly complete.
-
-The important issues are simply:
-
- o *ONLY* $ORACLE_HOME/bin/oracle requires setuid bit set for
- the Oracle RDBMS and tools to function.
-
- o *IF* you run dbsnmp, it must be setuid. (If you don't know what dbsnmp
- is, you're probably not running it -- it's a remote monitoring/control
- daemon)
-
-Armed with that knowledge, you can use any technique you like to achieve
-the desired results. For example, this achieves it:
-
-find $ORACLE_HOME/bin -perm -2000 ! -name oracle ! -name dbsnmp | xargs chmod -s
-
-Mark
-
-------------------------------------------------------------------------------
-
-One further note I'll pass on anonymously and without comment:
-
-> please include something like: "After removing the setuid bits, slap
-> your system administrator for running root.sh as root without actually
-> reading it first."
-> :)
-
-------------------------------------------------------------------------------
@@ -1,49 +0,0 @@
->From Perl 5.6.0 onwards DBD::Oracle supports UTF8 as local
-character set (using OCI8). Thus, when the environment
-variable NLS_LANG ends with "utf8", DBD::Oracle marks Perl
-strings as unicode (when multibyte characters are present).
-This affects the handling of CHAR/VARCHARx columns and
-LONGs/CLOBs.
-
-Multibyte chars in Perl 5.6.0:
-
-Perl 5.6.0 switches to character semantics (as compared to
-byte) for multibyte strings. According to Perl documentation
-this is done transparently to Perl scripts - all builtin
-operators know about it. DBD::Oracle tries to preserve this
-transparency as far as Oracle allows this (see below).
-
-As a consequence, "LongReadLen" now counts characters and
-not bytes when dealing with LONG/CLOB values. Selected LONGs
-and CLOBs will return at most LongReadLen chars, but may
-contain a multiple of that in actual bytes.
-
-blob_read issued on CLOBs will also use character semantics.
-You have to take extra precautions when using such strings
-in a byte-size context, for example a fixed size field in
-a protocol message. This is not specific to DBD::Oracle as
-such, but be warned.
-
-You need patches at least up to 6090 for Perl 5.6.0 for utf8
-to work with DBD::Oracle. (For WinUsers: ActiveState build
-beyond 613 will probably do).
-
-
-Multibyte chars in Oracle 8(i)
-
-CHAR/VARCHAR and friends count size in bytes, not characters.
-If you have a Oracle database created with character set utf8
-and insert a string with 10 characters into a VARCHAR2(10)
-column, this will only work if the string is 10 bytes long.
-If the string is longer, it will fail (and report and error).
-This behaviour is inherent to Oracle/OCI and not influenced
-by DBD::Oracle.
-
-This is then the place where transparency of utf8 breaks. If
-you want to check your parameter lengths before insert, you
-have to switch Perl to bytes semantics (see "use bytes" in
-Perl documentation).
-
-
-
-2000-05-09, Stefan Eissing (se@acm.org)
@@ -1,52 +0,0 @@
-In general, on Windows, it's best to just use ActiveState Perl and the
-PPM package manager to install a pre-built version of DBD::Oracle.
-
-If you built Perl with gcc, read README.wingcc as well as this file.
-
---- other information, some of which is out of date ---
-
-9/14/02 -- Michael Chase
-
-Makefile.PL uses Win32::TieRegistry or Win32::Registry to find the
-current Oracle Home directory if the ORACLE_HOME environment variable
-is not set. If neither module is installed, you must set ORACLE_HOME
-before running Makefile.PL. Since the registry location of the current
-Oracle Home is in different locations in different Oracle versions,
-it is usually safer to set ORACLE_HOME before running Makefile.PL.
-
-10/24/97 -- Jeff Urlwin
-
-Tested with Oracle 8 and OCI 8. Well, not the *new* OCI api, but
-using the same api as always. This version now searches for OCI
-include and library files in $ORACLE_HOME\OCI80, then
-$ORACLE_HOME\OCI73. It will use the first of these found.
-
-In order for the tests to connect successfully, I had to
-set the environment variable ORACLE_USERID to
-scott/tiger@mydb (where mydb is the tns name of your server)
-
-4/8/97 -- Jeff Urlwin
-
-Even though the Oracle libraries under Win32 (NT) do not require the
-environment variable ORACLE_HOME be set for proper operation, the
-Makefile.PL does. Please set the ORACLE_HOME variable to your oracle
-home directory. Mine, for example, is H:\ORANT.
-
-The environment variable TWO_TASK is not supported under Windows.
-Instead Oracle uses the settings LOCAL and REMOTE as described in
-the Oracle Networking Documentation, "Oracle Network Products Getting
-Started for Windows Platforms."
-
-This version was created and tested with the 7.3 client libraries (see
-if you have an OCI73 directory). This version of the Oracle clients
-have a convenient organization, including OCI73\INCLUDE, OCI73\LIB,
-etc. It also has a nice samples directory to test with. Older
-versions had the OCI samples under RDMBS72. This version has not been
-tested (and will not currently work) with anything other than the 7.3
-versions.
-
-Questions should be directed towards the dbi-users mailing list. I will
-try to answer them quickly there. Please put something about Win32 or
-95 or NT in the subject, as I get TONS of other email and spend a fair
-amount of time weeding out messages that are not relevant to what I
-do. I may miss something if the subject is not clear.
@@ -1,21 +0,0 @@
-14-Sep-2002 -- Michael Chase
-
-Makefile.PL should now create liboci.a for you. If it fails, follow the
-directions below.
-
-19-may-1999
-
-added support for mingw32 and cygwin32 environments.
-
-Makefile.PL should find and make use of OCI include
-files, but you have to build an import library for
-OCI.DLL and put it somewhere in library search path.
-one of the possible ways to do this is issuing command
-
-dlltool --input-def oci.def --output-lib liboci.a
-
-in the directory where you unpacked DBD::Oracle distribution
-archive. this will create import library for Oracle 8.0.4.
-
-Note: make clean removes *.a files, so put a copy in a safe place.
-
@@ -1,5 +1,49 @@
[ In no particular order ]
+**************************** NOTE: ora_db_shutdown/ora_dv_startup/StrictlyType/DiscardString not documented
+
+User requested a document/link anywhere that details what Oracle client attributes
+are supported and which are not for Oracle 11g and interacting with a RAC
+and using things like TAF, FAN, etc...
+
+
+Seems this file has been neglected for quite a while so I will try to keep it up to date for now
+
+For release 1.26 or later
+
+Add support for TAF
+Add support for New Lob Functions
+Add support for Statement Cacheing
+Add support for callbacks??
+Drop support for ProC connections
+
+For release 1.22 or later
+
+--> done 1.22Drop support for Oralce 8 and earlier
+
+add support for $dbh->trace('SQL');
+
+Replace OCIInitialize + OCIEnvInit, with OCIEnvCreate
+
+--> done 1.22 dbd_verbose ora_verbose Add in the DBD only debugging flag
+
+--> done 1.22 Add new method oci_exe_mode to get the Name of the Execution Modes
+
+Add support for OCIClientVersion(),OCIPing(),OCIServerVersion()
+
+-->done 1.22 Expand support for Data Interface for Persistent LOBs by setting up support
+for Piecewise Fetch and Piecewise Fetch with Callback and perhaps Array Fetch as well
+
+Add support for version 2 of lob functions
+
+Add support for OCIStmtPrepare2(), Statement caching
+
+The below might of been done but this list has not been maintained;
+
+Add column_info test
+
+Add info about getting help - mailing lists etc.
+
Public Oracle docs:
http://www.csis.gvsu.edu/GeneralInfo/Oracle/nav/docindex.htm
LOBs
@@ -8,6 +52,12 @@ http://technet.oracle.com/tech/oci/htdocs/faq.html#1000425
Convert most of test.pl into standard t/*.t tests.
+Record ORACLE_HOME when building (auto::DBD::Oracle::mk)
+Check emails from Oracle about that.
+
+Check fix for unassigned placeholder (alen==SvLEN) can't be
+triggered by a valid assignment that's exactly that long.
+
Resolve imp_sth->stmt_type != OCI_STMT_SELECT issue - add an attribute for it?
connect with $user = "/ as sysdba" etc as per SQL*Plus
@@ -1,12 +1,11 @@
/*
- $Id: dbdimp.c,v 1.77 2003/03/27 16:44:15 timbo Exp $
+ vim: sw=4:ts=8
+ dbdimp.c
- Copyright (c) 1994,1995,1996,1997,1998 Tim Bunce
+ Copyright (c) 1994-2006 Tim Bunce Ireland
+ Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada
- You may distribute under the terms of either the GNU General Public
- License or the Artistic License, as specified in the Perl README file,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
+ See the COPYRIGHT section in the Oracle.pm file for terms.
*/
@@ -14,174 +13,353 @@
#define strcasecmp strcmpi
#endif
-#include "Oracle.h"
+#ifdef __CYGWIN32__
+#include "w32api/windows.h"
+#include "w32api/winbase.h"
+#endif /* __CYGWIN32__ */
+#include "Oracle.h"
/* XXX DBI should provide a better version of this */
#define IS_DBI_HANDLE(h) \
- (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && \
+ (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && \
SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P')
+#ifndef SvPOK_only_UTF8
+#define SvPOK_only_UTF8(sv) SvPOK_only(sv)
+#endif
DBISTATE_DECLARE;
-int ora_fetchtest; /* intrnal test only, not thread safe */
-int is_extproc = 0;
+int ora_fetchtest; /* internal test only, not thread safe */
+int is_extproc = 0; /* not ProC but ExtProc.pm */
+int dbd_verbose = 0; /* DBD only debugging*/
+int oci_warn = 0; /* show oci warnings */
+int ora_objects = 0; /* get oracle embedded objects as instance of DBD::Oracle::Object */
+int ora_ncs_buff_mtpl = 4; /* a mulitplyer for ncs clob buffers */
-#ifdef UTF8_SUPPORT
-int cs_is_utf8;
-#endif
+/* bitflag constants for figuring out how to handle utf8 for array binds */
+#define ARRAY_BIND_NATIVE 0x01
+#define ARRAY_BIND_UTF8 0x02
+#define ARRAY_BIND_MIXED (ARRAY_BIND_NATIVE|ARRAY_BIND_UTF8)
+
+
+ub2 charsetid = 0;
+ub2 ncharsetid = 0;
+ub2 us7ascii_csid = 1;
+ub2 utf8_csid = 871;
+ub2 al32utf8_csid = 873;
+ub2 al16utf16_csid = 2000;
-static int ora_login_nomsg; /* don't fetch real login errmsg if true */
-static int ora_sigchld_restart = 1;
-#ifndef OCI_V8_SYNTAX
-static int set_sigint_handler = 0;
-#endif
typedef struct sql_fbh_st sql_fbh_t;
struct sql_fbh_st {
- int dbtype;
- int prec;
- int scale;
+ int dbtype;
+ int prec;
+ int scale;
};
static sql_fbh_t ora2sql_type _((imp_fbh_t* fbh));
+static void disable_taf(imp_dbh_t *imp_dbh);
+static int enable_taf(SV *dbh, imp_dbh_t *imp_dbh);
-void ora_free_phs_contents _((phs_t *phs));
-static void dump_env_to_trace();
+void ora_free_phs_contents _((imp_sth_t *imp_sth, phs_t *phs));
+static void dump_env_to_trace(imp_dbh_t *imp_dbh);
-void
-dbd_init(dbistate)
- dbistate_t *dbistate;
+static sb4
+oci_error_get(imp_xxh_t *imp_xxh,
+ OCIError *errhp, sword status, char *what, SV *errstr, int debug)
{
- char *p;
- DBIS = dbistate;
- dbd_init_oci(dbistate);
+ dTHX;
+ text errbuf[1024];
+ ub4 recno = 0;
+ sb4 errcode = 0;
+ sb4 eg_errcode = 0;
+ sword eg_status;
+ if (!SvOK(errstr))
+ sv_setpv(errstr,"");
+ if (!errhp) {
+ sv_catpv(errstr, oci_status_name(status));
+ if (what) {
+ sv_catpv(errstr, " ");
+ sv_catpv(errstr, what);
+ }
+ return status;
+ }
- if ((p=getenv("DBD_ORACLE_LOGIN_NOMSG")))
- ora_login_nomsg = atoi(p);
- if ((p=getenv("DBD_ORACLE_SIGCHLD")))
- ora_sigchld_restart = atoi(p);
+ while( ++recno
+ && OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf,
+ (ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA
+ && eg_status != OCI_INVALID_HANDLE
+ && recno < 100
+ ) {
+ if (debug >= 4 || recno>1/*XXX temp*/ || dbd_verbose >= 4 )
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh),
+ " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n",
+ what ? what : "<NULL>", (long)recno,
+ (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
+ status, (long)eg_errcode, errbuf);
+ errcode = eg_errcode;
+ sv_catpv(errstr, (char*)errbuf);
+ if (*(SvEND(errstr)-1) == '\n')
+ --SvCUR(errstr);
+ }
-#ifdef UTF8_SUPPORT
- {
- char *nls = getenv("NLS_LANG");
- STRLEN nlslen;
- if (nls && (nlslen = strlen(nls)) >= 4) {
- cs_is_utf8 = !strcasecmp(nls + nlslen - 4, "utf8");
+ if (what || status != OCI_ERROR) {
+ sv_catpv(errstr, (debug<0) ? " (" : " (DBD ");
+ sv_catpv(errstr, oci_status_name(status));
+ if (what) {
+ sv_catpv(errstr, ": ");
+ sv_catpv(errstr, what);
+ }
+ sv_catpv(errstr, ")");
}
- }
+ return errcode;
+}
+
+static int
+GetRegKey(char *key, char *val, char *data, unsigned long *size)
+{
+#ifdef WIN32
+ unsigned long len = *size - 1;
+ HKEY hKey;
+ long ret;
+
+ ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, key, 0, KEY_QUERY_VALUE, &hKey);
+ if (ret != ERROR_SUCCESS)
+ return 0;
+ ret = RegQueryValueEx(hKey, val, NULL, NULL, data, size);
+ RegCloseKey(hKey);
+ if ((ret != ERROR_SUCCESS) || (*size >= len))
+ return 0;
+ return 1;
+#else
+ /* For gcc not to warn on unused parameters. */
+ if( key ){}
+ if( val ){}
+ if( data ){}
+ if( size ){}
+ return 0;
#endif
}
+char *
+ora_env_var(char *name, char *buf, unsigned long size)
+{
+#define WIN32_REG_BUFSIZE 80
+ dTHX;
+ char last_home_id[WIN32_REG_BUFSIZE+1];
+ char ora_home_key[WIN32_REG_BUFSIZE+1];
+ unsigned long len = WIN32_REG_BUFSIZE;
+ char *e = getenv(name);
+ if (e)
+ return e;
+ if (!GetRegKey("SOFTWARE\\ORACLE\\ALL_HOMES", "LAST_HOME", last_home_id, &len))
+ return Nullch;
+ last_home_id[2] = 0;
+ sprintf(ora_home_key, "SOFTWARE\\ORACLE\\HOME%s", last_home_id);
+ size -= 1; /* allow room for null termination */
+ if (!GetRegKey(ora_home_key, name, buf, &size))
+ return Nullch;
+ buf[size] = 0;
+ return buf;
+}
+
+#ifdef __CYGWIN32__
+/* Under Cygwin there are issues with setting environment variables
+ * at runtime such that Windows-native libraries loaded by a Cygwin
+ * process can see those changes.
+ *
+ * Cygwin maintains its own cache of environment variables, and also
+ * only writes to the Windows environment using the "_putenv" win32
+ * call. This call writes to a Windows C runtime cache, rather than
+ * the true process environment block.
+ *
+ * In order to change environment variables so that the Oracle client
+ * DLL can see the change, the win32 function SetEnvironmentVariable
+ * must be called. This function gives an interface to that API.
+ *
+ * It is only available when building under Cygwin, and is used by
+ * the testsuite.
+ *
+ * Whilst it could be called by end users, it should be used with
+ * caution, as it bypasses the environment variable conversions that
+ * Cygwin typically performs.
+ */
+void
+ora_cygwin_set_env(char *name, char *value)
+{
+ SetEnvironmentVariable(name, value);
+}
+#endif /* __CYGWIN32__ */
+
+
+void
+dbd_init(dbistate_t *dbistate)
+{
+ dTHX;
+ DBIS = dbistate;
+ dbd_init_oci(dbistate);
+}
+
int
-dbd_discon_all(drh, imp_drh)
- SV *drh;
- imp_drh_t *imp_drh;
+dbd_discon_all(SV *drh, imp_drh_t *imp_drh)
{
- dTHR;
+ dTHR;
+ dTHX;
/* The disconnect_all concept is flawed and needs more work */
- if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
- sv_setiv(DBIc_ERR(imp_drh), (IV)1);
- sv_setpv(DBIc_ERRSTR(imp_drh),
- (char*)"disconnect_all not implemented");
- DBIh_EVENT2(drh, ERROR_event,
- DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh));
+ if (!PL_dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
+ DBIh_SET_ERR_CHAR(drh, (imp_xxh_t*)imp_drh, Nullch, 1, "disconnect_all not implemented", Nullch, Nullch);
+ return FALSE;
+ }
return FALSE;
- }
- return FALSE;
}
-
void
-dbd_fbh_dump(fbh, i, aidx)
- imp_fbh_t *fbh;
- int i;
- int aidx; /* array index */
+dbd_fbh_dump(imp_sth_t *imp_sth, imp_fbh_t *fbh, int i, int aidx)
{
- PerlIO *fp = DBILOGFP;
- PerlIO_printf(fp, " fbh %d: '%s'\t%s, ",
+ dTHX;
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " fbh %d: '%s'\t%s, ",
i, fbh->name, (fbh->nullok) ? "NULLable" : "NO null ");
- PerlIO_printf(fp, "otype %3d->%3d, dbsize %ld/%ld, p%d.s%d\n",
- fbh->dbtype, fbh->ftype, (long)fbh->dbsize,(long)fbh->disize,
- fbh->prec, fbh->scale);
- if (fbh->fb_ary) {
- PerlIO_printf(fp, " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n",
- fbh->ftype, fbh->fb_ary->bufl, fbh->fb_ary->aindp[aidx],
- fbh->fb_ary->arlen[aidx], fbh->fb_ary->arcode[aidx]);
- }
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), "otype %3d->%3d, dbsize %ld/%ld, p%d.s%d\n",
+ fbh->dbtype, fbh->ftype, (long)fbh->dbsize,(long)fbh->disize,
+ fbh->prec, fbh->scale);
+ if (fbh->fb_ary) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n",
+ fbh->ftype, fbh->fb_ary->bufl, fbh->fb_ary->aindp[aidx],
+ fbh->fb_ary->arlen[aidx], fbh->fb_ary->arcode[aidx]);
+ }
}
-
int
-ora_dbtype_is_long(dbtype)
- int dbtype;
+ora_dbtype_is_long(int dbtype)
{
- /* Is it a LONG, LONG RAW, LONG VARCHAR or LONG VARRAW type? */
- /* Return preferred type code to use if it's a long, else 0. */
- if (dbtype == 8 || dbtype == 24) /* LONG or LONG RAW */
+ /* Is it a LONG, LONG RAW, LONG VARCHAR or LONG VARRAW type? */
+ /* Return preferred type code to use if it's a long, else 0. */
+ if (dbtype == 8 || dbtype == 24) /* LONG or LONG RAW */
return dbtype; /* --> same */
- if (dbtype == 94) /* LONG VARCHAR */
+ if (dbtype == 94) /* LONG VARCHAR */
return 8; /* --> LONG */
- if (dbtype == 95) /* LONG VARRAW */
+ if (dbtype == 95) /* LONG VARRAW */
return 24; /* --> LONG RAW */
- return 0;
+ return 0;
}
static int
-oratype_bind_ok(dbtype) /* It's a type we support for placeholders */
- int dbtype;
+oratype_bind_ok(int dbtype) /* It's a type we support for placeholders */
{
- /* basically we support types that can be returned as strings */
- switch(dbtype) {
- case 1: /* VARCHAR2 */
- case 5: /* STRING */
- case 8: /* LONG */
- case 23: /* RAW */
- case 24: /* LONG RAW */
- case 96: /* CHAR */
- case 97: /* CHARZ */
- case 106: /* MLSLABEL */
- case 102: /* SQLT_CUR OCI 7 cursor variable */
- case 112: /* SQLT_CLOB / long */
- case 113: /* SQLT_BLOB / long */
- case 116: /* SQLT_RSET OCI 8 cursor variable */
+ /* basically we support types that can be returned as strings */
+ switch(dbtype) {
+ case 1: /* VARCHAR2 */
+ case 2: /* NVARCHAR2 */
+ case 5: /* STRING */
+ case 8: /* LONG */
+ case 21: /* BINARY FLOAT os-endian */
+ case 22: /* BINARY DOUBLE os-endian */
+ case 23: /* RAW */
+ case 24: /* LONG RAW */
+ case 96: /* CHAR */
+ case 97: /* CHARZ */
+ case 100: /* BINARY FLOAT oracle-endian */
+ case 101: /* BINARY DOUBLE oracle-endian */
+ case 106: /* MLSLABEL */
+ case 102: /* SQLT_CUR OCI 7 cursor variable */
+ case 112: /* SQLT_CLOB / long */
+ case 113: /* SQLT_BLOB / long */
+ case 116: /* SQLT_RSET OCI 8 cursor variable */
+ case ORA_VARCHAR2_TABLE: /* 201 */
+ case ORA_NUMBER_TABLE: /* 202 */
+ case ORA_XMLTYPE: /* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */
return 1;
- }
- return 0;
+ }
+ return 0;
+}
+
+#ifdef THIS_IS_NOT_CURRENTLY_USED
+static int
+oratype_rebind_ok(int dbtype) /* all are vrcar any way so just use it */
+{
+ /* basically we support types that can be returned as strings */
+ switch(dbtype) {
+ case 1: /* VARCHAR2 */
+ case 2: /* NVARCHAR2 */
+ case 5: /* STRING */
+ case 8: /* LONG */
+ case 21: /* BINARY FLOAT os-endian */
+ case 22: /* BINARY DOUBLE os-endian */
+ case 23: /* RAW */
+ case 24: /* LONG RAW */
+ case 96: /* CHAR */
+ case 97: /* CHARZ */
+ case 100: /* BINARY FLOAT oracle-endian */
+ case 101: /* BINARY DOUBLE oracle-endian */
+ case 106: /* MLSLABEL */
+ case 102: /* SQLT_CUR OCI 7 cursor variable */
+ case 116: /* SQLT_RSET OCI 8 cursor variable */
+ case ORA_VARCHAR2_TABLE: /* 201 */
+ case ORA_NUMBER_TABLE: /* 202 */
+ case ORA_XMLTYPE: /* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */
+ case 113: /* SQLT_BLOB / long */
+ return SQLT_BIN;
+ case 112: /* SQLT_CLOB / long */
+ return SQLT_CHR;
+ }
+
+ return dbtype;
+}
+#endif /* THIS_IS_NOT_CURRENTLY_USED */
+/* --- allocate and free oracle oci 'array' buffers --- */
+
+/* --- allocate and free oracle oci 'array' buffers for callback--- */
+
+fb_ary_t *
+fb_ary_cb_alloc(ub4 piece_size, ub4 max_len, int size)
+{
+ fb_ary_t *fb_ary;
+ /* these should be reworked to only to one Newz() */
+ /* and setup the pointers in the head fb_ary struct */
+ Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t);
+ Newz(42, fb_ary->abuf, size * piece_size, ub1);
+ Newz(42, fb_ary->cb_abuf, size * max_len, ub1);
+ Newz(42, fb_ary->aindp,(unsigned)size,sb2);
+ Newz(42, fb_ary->arlen,(unsigned)size,ub2);
+ Newz(42, fb_ary->arcode,(unsigned)size,ub2);
+ fb_ary->bufl = piece_size;
+ fb_ary->cb_bufl = max_len;
+ return fb_ary;
}
/* --- allocate and free oracle oci 'array' buffers --- */
fb_ary_t *
-fb_ary_alloc(bufl, size)
- int bufl;
- int size;
+fb_ary_alloc(ub4 bufl, int size)
{
- fb_ary_t *fb_ary;
- /* these should be reworked to only to one Newz() */
- /* and setup the pointers in the head fb_ary struct */
- Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t);
- Newz(42, fb_ary->abuf, size * bufl, ub1);
- Newz(42, fb_ary->aindp, size, sb2);
- Newz(42, fb_ary->arlen, size, ub2);
- Newz(42, fb_ary->arcode, size, ub2);
- fb_ary->bufl = bufl;
- return fb_ary;
+ fb_ary_t *fb_ary;
+ /* these should be reworked to only to one Newz() */
+ /* and setup the pointers in the head fb_ary struct */
+ Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t);
+ Newz(42, fb_ary->abuf, size * bufl, ub1);
+ Newz(42, fb_ary->aindp, (unsigned)size,sb2);
+ Newz(42, fb_ary->arlen, (unsigned)size,ub2);
+ Newz(42, fb_ary->arcode,(unsigned)size,ub2);
+ fb_ary->bufl = bufl;
+ /* fb_ary->cb_bufl = bufl;*/
+ return fb_ary;
}
void
-fb_ary_free(fb_ary)
- fb_ary_t *fb_ary;
+fb_ary_free(fb_ary_t *fb_ary)
{
- Safefree(fb_ary->abuf);
- Safefree(fb_ary->aindp);
- Safefree(fb_ary->arlen);
- Safefree(fb_ary->arcode);
- Safefree(fb_ary);
+ Safefree(fb_ary->abuf);
+ Safefree(fb_ary->aindp);
+ Safefree(fb_ary->arlen);
+ Safefree(fb_ary->arcode);
+ Safefree(fb_ary->cb_abuf);
+ Safefree(fb_ary);
+
}
@@ -189,419 +367,665 @@ fb_ary_free(fb_ary)
int
-dbd_db_login(dbh, imp_dbh, dbname, uid, pwd)
- SV *dbh; imp_dbh_t *imp_dbh; char *dbname; char *uid; char *pwd;
+dbd_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd)
{
- return dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, Nullsv);
+ return dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, Nullsv);
}
/* from shared.xs */
typedef struct {
- SV *sv; /* The actual SV - in shared space */
+ SV *sv; /* The actual SV - in shared space */
/* we don't need the following two */
- /*recursive_lock_t lock; */
- /*perl_cond user_cond;*/ /* For user-level conditions */
+ /*recursive_lock_t lock; */
+ /*perl_cond user_cond;*/ /* For user-level conditions */
} shared_sv;
-
+
int
-dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, attr)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- char *dbname;
- char *uid;
- char *pwd;
- SV *attr;
+dbd_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd, SV *attr)
{
- dTHR;
- sword status;
- SV **svp;
- shared_sv * shared_dbh_ssv = NULL ;
- imp_dbh_t * shared_dbh = NULL ;
+ dTHR;
+ dTHX;
+ sword status;
+ SV **svp;
+ shared_sv * shared_dbh_ssv = NULL ;
+ imp_dbh_t * shared_dbh = NULL ;
+ D_imp_drh_from_dbh;
+ ub2 new_charsetid = 0;
+ ub2 new_ncharsetid = 0;
+ int forced_new_environment = 0;
#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar)
- SV ** shared_dbh_priv_svp ;
- SV * shared_dbh_priv_sv ;
- STRLEN shared_dbh_len = 0 ;
+ SV ** shared_dbh_priv_svp ;
+ SV * shared_dbh_priv_sv ;
+ STRLEN shared_dbh_len = 0 ;
+#endif
+
+#ifdef ORA_OCI_112
+ /*check to see if the user is connecting with DRCP */
+ if (DBD_ATTRIB_TRUE(attr,"ora_drcp",8,svp))
+ imp_dbh->using_drcp = 1;
+
+ /* some connection pool atributes */
+
+ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_drcp_class", 14)) && SvOK(*svp)) {
+ STRLEN svp_len;
+ if (!SvPOK(*svp))
+ croak("ora_drcp_class is not a string");
+ imp_dbh->pool_class = (text *) SvPV (*svp, svp_len );
+ imp_dbh->pool_classl= (ub4) svp_len;
+ }
+ if (DBD_ATTRIB_TRUE(attr,"ora_drcp_min",12,svp))
+ DBD_ATTRIB_GET_IV( attr, "ora_drcp_min", 12, svp, imp_dbh->pool_min);
+ if (DBD_ATTRIB_TRUE(attr,"ora_drcp_max",12,svp))
+ DBD_ATTRIB_GET_IV( attr, "ora_drcp_max", 12, svp, imp_dbh->pool_max);
+ if (DBD_ATTRIB_TRUE(attr,"ora_drcp_incr",13,svp))
+ DBD_ATTRIB_GET_IV( attr, "ora_drcp_incr", 13, svp, imp_dbh->pool_incr);
+
+ imp_dbh->driver_name = "DBD01.50_00";
#endif
-#ifdef OCI_V8_SYNTAX
- struct OCIExtProcContext *this_ctx;
+
+#ifdef ORA_OCI_112
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION,
+ imp_dbh->driver_name,
+ (ub4)strlen(imp_dbh->driver_name),
+ OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
#endif
- D_imp_drh_from_dbh;
+ /* TAF Events */
+ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_taf_function", 16)) && SvOK(*svp)) {
+ if ((SvROK(*svp) && (SvTYPE(SvRV(*svp)) == SVt_PVCV)) ||
+ (SvPOK(*svp))) {
+ imp_dbh->taf_function = newSVsv(*svp);
+ } else {
+ croak("ora_taf_function needs to be a string or code reference");
+ }
+ /* avoid later STORE: */
+ /* See DBI::DBB problem with ATTRIB_DELETE until DBI 1.607 */
+ /* DBD_ATTRIB_DELETE(attr, "ora_taf_function", 16); */
+ (void)hv_delete((HV*)SvRV(attr), "ora_taf_function", 16, G_DISCARD);
+ }
+
+ imp_dbh->server_version = 0;
+
+ /* check to see if DBD_verbose or ora_verbose is set*/
+ if (DBD_ATTRIB_TRUE(attr,"dbd_verbose",11,svp))
+ DBD_ATTRIB_GET_IV( attr, "dbd_verbose", 11, svp, dbd_verbose);
+ if (DBD_ATTRIB_TRUE(attr,"ora_verbose",11,svp))
+ DBD_ATTRIB_GET_IV( attr, "ora_verbose", 11, svp, dbd_verbose);
+
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 6 || dbd_verbose >= 6 )
+ dump_env_to_trace(imp_dbh);
+
+ /* dbi_imp_data code adapted from DBD::mysql */
+ if (DBIc_has(imp_dbh, DBIcf_IMPSET)) {
+ /* dbi_imp_data from take_imp_data */
+ if (DBIc_has(imp_dbh, DBIcf_ACTIVE)) {
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh), "dbd_db_login6 skip connect\n");
+ /* tell our parent we've adopted an active child */
+ ++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh));
+
+ return 1;
+ }
+ /* not ACTIVE so connect not skipped */
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh),
+ "dbd_db_login6 IMPSET but not ACTIVE so connect not skipped\n");
+ }
+
+ imp_dbh->envhp = imp_drh->envhp; /* will be NULL on first connect */
#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar)
- shared_dbh_priv_svp = (DBD_ATTRIB_OK(attr)?hv_fetch((HV*)SvRV(attr), "ora_dbh_share", 13, 0):NULL) ;
- shared_dbh_priv_sv = shared_dbh_priv_svp?*shared_dbh_priv_svp:NULL ;
-
- if (shared_dbh_priv_sv && SvROK(shared_dbh_priv_sv))
- shared_dbh_priv_sv = SvRV(shared_dbh_priv_sv) ;
-
- if (shared_dbh_priv_sv) {
- MAGIC * mg ;
-
- SvLOCK (shared_dbh_priv_sv) ;
-
- /* some magic from shared.xs (no public api yet :-( */
- mg = mg_find(shared_dbh_priv_sv, PERL_MAGIC_shared_scalar) ;
-
- shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ; /*sharedsv_find(*shared_dbh_priv_sv) ;*/
- if (!shared_dbh_ssv)
- croak ("value of ora_dbh_share must be a scalar that is shared") ;
-
- shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ;
- shared_dbh_len = SvCUR((shared_dbh_ssv -> sv)) ;
- if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t))
- croak ("Invalid value for ora_dbh_dup") ;
-
- if (shared_dbh_len == sizeof (imp_dbh_t)) {
- /* initialize from shared data */
- int o = DBH_DUP_OFF ;
- int l = DBH_DUP_LEN ;
- memcpy (((char *)imp_dbh) + DBH_DUP_OFF, ((char *)shared_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ;
- //Move (((char *)shared_dbh) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN, char *) ;
- shared_dbh -> refcnt++ ;
-#ifdef OCI_V8_SYNTAX
- imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ;
- imp_dbh -> shared_dbh = shared_dbh ;
- if (DBIS->debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_db_login: use shared Oracle database handles.\n");
+ shared_dbh_priv_svp = (DBD_ATTRIB_OK(attr)?hv_fetch((HV*)SvRV(attr), "ora_dbh_share", 13, 0):NULL) ;
+ shared_dbh_priv_sv = shared_dbh_priv_svp?*shared_dbh_priv_svp:NULL ;
+
+ if (shared_dbh_priv_sv && SvROK(shared_dbh_priv_sv))
+ shared_dbh_priv_sv = SvRV(shared_dbh_priv_sv) ;
+
+ if (shared_dbh_priv_sv) {
+ MAGIC * mg ;
+
+ SvLOCK (shared_dbh_priv_sv) ;
+
+ /* some magic from shared.xs (no public api yet :-( */
+ mg = mg_find(shared_dbh_priv_sv, PERL_MAGIC_shared_scalar) ;
+
+ shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ; /*sharedsv_find(*shared_dbh_priv_sv) ;*/
+
+ if (!shared_dbh_ssv)
+ croak ("value of ora_dbh_share must be a scalar that is shared") ;
+
+ shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ;
+ shared_dbh_len = SvCUR((shared_dbh_ssv -> sv)) ;
+
+ if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t))
+ croak ("Invalid value for ora_dbh_dup") ;
+
+ if (shared_dbh_len == sizeof (imp_dbh_t)) {
+ /* initialize from shared data */
+ memcpy (((char *)imp_dbh) + DBH_DUP_OFF, ((char *)shared_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ;
+ shared_dbh -> refcnt++ ;
+ imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ;
+ imp_dbh -> shared_dbh = shared_dbh ;
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh), " dbd_db_login: use shared Oracle database handles.\n");
+ } else {
+ shared_dbh = NULL ;
+ }
+ }
#endif
- } else {
- shared_dbh = NULL ;
- }
- }
-#endif
-#ifdef OCI_V8_SYNTAX
-
- imp_dbh->get_oci_handle = oci_db_handle;
-
- if (DBIS->debug >= 6 )
- dump_env_to_trace();
-
- /* "extproc" dbname is special if "ora_context" attribute also given */
- if (strEQ(dbname,"extproc") && (svp=DBD_ATTRIB_GET_SVP(attr, "ora_context", 7))) {
- IV tmp;
- if (!svp)
- croak("pointer to context SV is NULL");
- if (!sv_isa(*svp, "ExtProc::OCIExtProcContext"))
- croak("ora_context value is not of type ExtProc::OCIExtProcContext");
- tmp = SvIV((SV*)SvRV(*svp));
- this_ctx = (struct OCIExtProcContext *)tmp;
- if (this_ctx == NULL)
- croak("ora_context referenced ExtProc value is NULL");
- status = OCIExtProcGetEnv(this_ctx, &imp_drh->envhp,
- &imp_dbh->svchp, &imp_dbh->errhp);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIExtProcGetEnv");
- return 0;
+
+ imp_dbh->get_oci_handle = oci_db_handle;
+
+ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_envhp", 9)) && SvOK(*svp)) {
+ if (!SvTRUE(*svp)) {
+ imp_dbh->envhp = NULL; /* force new environment */
+ forced_new_environment = 1;
+ }
}
- imp_dbh->envhp = imp_drh->envhp;
- goto dbd_db_login6_out;
+ /* RT46739 */
+ if (imp_dbh->envhp) {
+ OCIError *errhp;
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &errhp, OCI_HTYPE_ERROR, status);
+ if (status != OCI_SUCCESS) {
+ imp_dbh->envhp = NULL;
+ } else {
+ OCIHandleFree_log_stat(imp_dbh, errhp, OCI_HTYPE_ERROR, status);
+ }
}
- if (!imp_drh->envhp || is_extproc) {
- /* OCI_OBJECT needed for OCIDescribeAny of table with LOBs else */
- /* you get a core dump (Not doc'd in 8.0.4). Thanks Oracle! */
- SV **init_mode_sv;
- ub4 init_mode = OCI_OBJECT;
- DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, init_mode_sv, init_mode);
+ if (!imp_dbh->envhp ) {
+ SV **init_mode_sv;
+ ub4 init_mode = OCI_OBJECT;/* needed for LOBs (8.0.4) */
+ DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, init_mode_sv, init_mode);
+
#if defined(USE_ITHREADS) || defined(MULTIPLICITY) || defined(USE_5005THREADS)
- init_mode |= OCI_THREADED;
+ init_mode |= OCI_THREADED;
#endif
- /* XXX recent oracle docs recommend using OCIEnvCreate() instead of */
- /* OCIInitialize + OCIEnvInit, we'd need ifdef's for old versions */
- OCIInitialize_log_stat(init_mode, 0, 0,0,0, status);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, NULL, status,
- "OCIInitialize. Check ORACLE_HOME and NLS settings etc.");
- return 0;
+
+ {
+ size_t rsize = 0;
+ /* Get CLIENT char and nchar charset id values */
+ OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &charsetid,(size_t) 0, OCI_NLS_CHARSET_ID, 0, &rsize ,status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status,
+ "OCINlsEnvironmentVariableGet(OCI_NLS_CHARSET_ID) Check NLS settings etc.");
+ return 0;
+ }
+
+ OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &ncharsetid,(size_t) 0, OCI_NLS_NCHARSET_ID, 0, &rsize ,status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status,
+ "OCINlsEnvironmentVariableGet(OCI_NLS_NCHARSET_ID) Check NLS settings etc.");
+ return 0;
+ }
+
+ /*{
+ After using OCIEnvNlsCreate() to create the environment handle,
+ **the actual lengths and returned lengths of bind and define handles are
+ always in number of bytes**. This applies to the following calls:
+
+ * OCIBindByName() * OCIBindByPos() * OCIBindDynamic()
+ * OCIDefineByPos() * OCIDefineDynamic()
+
+ This function enables you to set charset and ncharset ids at
+ environment creation time. [...]
+
+ This function sets nonzero charset and ncharset as client side
+ database and national character sets, replacing the ones specified
+ by NLS_LANG and NLS_NCHAR. When charset and ncharset are 0, it
+ behaves exactly the same as OCIEnvCreate(). Specifically, charset
+ controls the encoding for metadata and data with implicit form
+ attribute and ncharset controls the encoding for data with SQLCS_NCHAR
+ form attribute.
+ }*/
+
+ OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0,
+ charsetid, ncharsetid, status );
+
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status,
+ "OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc.");
+ return 0;
+ }
+ if (!imp_drh->envhp) /* cache first envhp info drh as future default */
+ imp_drh->envhp = imp_dbh->envhp;
+
+ svp = DBD_ATTRIB_GET_SVP(attr, "ora_charset", 11);/*get the charset passed in by the user*/
+ if (svp) {
+ if (!SvPOK(*svp)) {
+ croak("ora_charset is not a string");
+ }
+
+ new_charsetid = OCINlsCharSetNameToId(imp_dbh->envhp, (oratext*)SvPV_nolen(*svp));
+
+ if (!new_charsetid) {
+ croak("ora_charset value (%s) is not valid", SvPV_nolen(*svp));
+ }
+ }
+
+ svp = DBD_ATTRIB_GET_SVP(attr, "ora_ncharset", 12); /*get the ncharset passed in by the user*/
+
+ if (svp) {
+ if (!SvPOK(*svp)) {
+ croak("ora_ncharset is not a string");
+ }
+
+ new_ncharsetid = OCINlsCharSetNameToId(imp_dbh->envhp, (oratext*)SvPV_nolen(*svp));
+ if (!new_ncharsetid) {
+ croak("ora_ncharset value (%s) is not valid", SvPV_nolen(*svp));
+ }
+ }
+
+ if (new_charsetid || new_ncharsetid) { /* reset the ENV with the new charset from above*/
+ if (new_charsetid) charsetid = new_charsetid;
+ if (new_ncharsetid) ncharsetid = new_ncharsetid;
+ imp_dbh->envhp = NULL;
+ OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0,
+ charsetid, ncharsetid, status );
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status,
+ "OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc");
+ return 0;
+ }
+ if (!imp_drh->envhp) /* cache first envhp info drh as future default */
+ imp_drh->envhp = imp_dbh->envhp;
+ }
+
+ /* update the hard-coded csid constants for unicode charsets */
+ utf8_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"UTF8");
+ al32utf8_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"AL32UTF8");
+ al16utf16_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"AL16UTF16");
+ }
+
}
- OCIEnvInit_log_stat( &imp_drh->envhp, OCI_DEFAULT, 0, 0, status);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit");
- return 0;
+
+ if (shared_dbh_ssv) { /*is this a cached or shared handle from DBI*/
+ if (!imp_dbh->envhp) { /*no hande so create a new one*/
+ OCIEnvInit_log_stat(imp_dbh, &imp_dbh->envhp, OCI_DEFAULT, 0, 0, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit");
+ return 0;
+ }
+ }
}
- }
- if (shared_dbh_ssv) {
- if (!imp_dbh->envhp) {
- OCIEnvInit_log_stat( &imp_dbh->envhp, OCI_DEFAULT, 0, 0, status);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit");
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &charsetid, (ub4)0 ,
+ OCI_ATTR_ENV_CHARSET_ID, imp_dbh->errhp, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_CHARSET_ID");
return 0;
- }
}
- }
- else {
- imp_dbh->envhp = imp_drh->envhp;
- }
-
- OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status);
- if (!shared_dbh) {
- OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
- OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
+ OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &ncharsetid, (ub4)0 ,
+ OCI_ATTR_ENV_NCHARSET_ID, imp_dbh->errhp, status);
- OCIServerAttach_log_stat(imp_dbh, dbname, status);
if (status != OCI_SUCCESS) {
- oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach");
- OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
- OCIHandleFree_log_stat(imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
- OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status);
- return 0;
+ oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_NCHARSET_ID");
+ return 0;
}
- OCIAttrSet_log_stat( imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp,
- (ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status);
+ /* At this point we have charsetid & ncharsetid
+ * note that it is possible for charsetid and ncharestid to
+ * be distinct if NLS_LANG and NLS_NCHAR are both used.
+ * BTW: NLS_NCHAR is set as follows: NSL_LANG=AL32UTF8
+ */
+
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 3 || dbd_verbose >= 3 ) {
+ oratext charsetname[OCI_NLS_MAXBUFSZ];
+ oratext ncharsetname[OCI_NLS_MAXBUFSZ];
+ OCINlsCharSetIdToName(imp_dbh->envhp,charsetname, sizeof(charsetname),charsetid );
+ OCINlsCharSetIdToName(imp_dbh->envhp,ncharsetname, sizeof(ncharsetname),ncharsetid );
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_dbh),
+ " charset id=%d, name=%s, ncharset id=%d, name=%s"
+ " (csid: utf8=%d al32utf8=%d)\n",
+ charsetid,charsetname, ncharsetid,ncharsetname, utf8_csid, al32utf8_csid);
+#ifdef ORA_OCI_112
+ if (imp_dbh->using_drcp)
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh)," Using DRCP Connection\n ");
+#endif
+ }
- OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->authp, OCI_HTYPE_SESSION, status);
+ if (!shared_dbh) {
+
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach");
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ return 0;
+ }
+
+ {
+ SV **sess_mode_type_sv;
+ ub4 sess_mode_type = OCI_DEFAULT;
+ ub4 cred_type;
+ DBD_ATTRIB_GET_IV(attr, "ora_session_mode",16, sess_mode_type_sv, sess_mode_type);
+
+#ifdef ORA_OCI_112
+
+ if (imp_dbh->using_drcp) { /* connect uisng a DRCP */
+ ub4 purity = OCI_ATTR_PURITY_SELF;
+ /* pool Default values */
+ if (!imp_dbh->pool_min )
+ imp_dbh->pool_min = 4;
+ if (!imp_dbh->pool_max )
+ imp_dbh->pool_max = 40;
+ if (!imp_dbh->pool_incr)
+ imp_dbh->pool_incr = 2;
+
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->poolhp, OCI_HTYPE_SPOOL, status);
+
+ OCISessionPoolCreate_log_stat(
+ imp_dbh,
+ imp_dbh->envhp,
+ imp_dbh->errhp,
+ imp_dbh->poolhp,
+ (OraText **) &imp_dbh->pool_name,
+ (ub4 *) &imp_dbh->pool_namel,
+ (OraText *) dbname,
+ strlen(dbname),
+ imp_dbh->pool_min,
+ imp_dbh->pool_max,
+ imp_dbh->pool_incr,
+ (OraText *) uid,
+ strlen(uid),
+ (OraText *) pwd,
+ strlen(pwd),
+ status);
+
+ if (status != OCI_SUCCESS) {
+
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionPoolCreate");
+ OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ return 0;
+ }
+
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->authp, OCI_HTYPE_AUTHINFO, status);
+
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, (ub4) OCI_HTYPE_AUTHINFO,
+ &purity, (ub4) 0,(ub4) OCI_ATTR_PURITY, imp_dbh->errhp, status);
+
+ if (imp_dbh->pool_class) /*pool_class may or may not be used */
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, (ub4) OCI_HTYPE_AUTHINFO,
+ (OraText *) imp_dbh->pool_class, (ub4) imp_dbh->pool_classl,
+ (ub4) OCI_ATTR_CONNECTION_CLASS, imp_dbh->errhp, status);
+
+ cred_type = ora_parse_uid(imp_dbh, &uid, &pwd);
+
+ OCISessionGet_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, &imp_dbh->svchp, imp_dbh->authp,
+ imp_dbh->pool_name, (ub4)strlen((char *)imp_dbh->pool_name), status);
+
+ if (status != OCI_SUCCESS) {
+
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionGet");
+ OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status);
+ OCISessionPoolDestroy_log_stat(
+ imp_dbh, imp_dbh->poolhp, imp_dbh->errhp,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ return 0;
+ }
+
+ if (DBIc_DBISTATE(imp_dbh)->debug >= 4 || dbd_verbose >= 4 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_dbh),
+ "Using DRCP with session settings min=%d, max=%d, and increment=%d\n",
+ imp_dbh->pool_min,
+ imp_dbh->pool_max,
+ imp_dbh->pool_incr);
+ if (imp_dbh->pool_class)
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_dbh),
+ "with connection class=%s\n",imp_dbh->pool_class);
+ }
+
+ }
+ else {
+#endif /* ORA_OCI_112 */
+
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
+ OCIServerAttach_log_stat(imp_dbh, dbname,OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach");
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
+ if (forced_new_environment)
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
+ return 0;
+ }
+
+
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp,
+ (ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status);
+
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->seshp, OCI_HTYPE_SESSION, status);
+
+ cred_type = ora_parse_uid(imp_dbh, &uid, &pwd);
+
+ OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,cred_type, sess_mode_type, status);
+
+ if (status == OCI_SUCCESS_WITH_INFO) {
+ /* eg ORA-28011: the account will expire soon; change your password now */
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
+ status = OCI_SUCCESS;
+ }
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
+ OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
+ if (forced_new_environment)
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
+ return 0;
+ }
+
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX,
+ imp_dbh->seshp, (ub4) 0,(ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status);
+#ifdef ORA_OCI_112
+ }
+#endif
+ }
- {
- ub4 cred_type = ora_parse_uid(imp_dbh, &uid, &pwd);
- SV **sess_mode_type_sv;
- ub4 sess_mode_type = OCI_DEFAULT;
- DBD_ATTRIB_GET_IV(attr, "ora_session_mode",16, sess_mode_type_sv, sess_mode_type);
- OCISessionBegin_log_stat( imp_dbh->svchp, imp_dbh->errhp, imp_dbh->authp,
- cred_type, sess_mode_type, status);
- }
- if (status == OCI_SUCCESS_WITH_INFO) {
- /* eg ORA-28011: the account will expire soon; change your password now */
- /* XXX trigger HandleEvent here in future */
- status = OCI_SUCCESS;
}
- if (status != OCI_SUCCESS) {
- oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
- OCIServerDetach_log_stat(imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status);
- OCIHandleFree_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,status);
- OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
- OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status);
- OCIHandleFree_log_stat(imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
- return 0;
- }
-
- OCIAttrSet_log_stat(imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX,
- imp_dbh->authp, (ub4) 0,
- (ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status);
- }
-#else
- if (DBIS->debug >= 6 )
- dump_env_to_trace();
-
- imp_dbh->lda = &imp_dbh->ldabuf;
- imp_dbh->hda = &imp_dbh->hdabuf[0];
- /* can give duplicate free errors (from Oracle) if connect fails */
- status = orlon(imp_dbh->lda, imp_dbh->hda, (text*)uid,-1, (text*)pwd,-1,0);
-
- if (status) {
- int rc = imp_dbh->lda->rc;
- char buf[100];
- char *msg;
- switch(rc) { /* add helpful hints to some errors */
- case 0: msg = "login failed, check your config, e.g. ORACLE_HOME/bin in your PATH/Registry etc"; break;
- case 1019: msg = "login failed, probably a symptom of a deeper problem"; break;
- default: msg = "login failed"; break;
- }
- if (ora_login_nomsg) {
- /* oerhms in ora_error may hang or corrupt memory (!) after a connect */
- /* failure in some specific versions of Oracle 7.3.x. So we provide a */
- /* way to skip the message lookup if ora_login_nomsg is true (set via */
- /* env var above). */
- sprintf(buf,
- "ORA-%05d: (Text for error %d not fetched. Use 'oerr ORA %d' command.)",
- rc, rc, rc);
- msg = buf;
- }
- ora_error(dbh, ora_login_nomsg ? NULL : imp_dbh->lda, rc, msg);
- return 0;
- }
- if (!set_sigint_handler) {
- set_sigint_handler = 1;
- /* perl's sign handler is sighandler */
- /* osnsui(??, sighandler, NULL?) */
- /* OCI8: osnsui(word *handlp, void (*astp), char * ctx)
- ** osnsui: Operating System dependent Network Set User-side
- ** Interrupt. Add an interrupt handling procedure astp.
- ** Whenever a user interrupt(such as a ^C) occurs, call astp
- ** with argument ctx. Put in *handlp handle for this
- ** handler so that it may be cleared with osncui.
- ** Note that there may be many handlers; each should
- ** be cleared using osncui. An error code is
- ** returned if an error occurs.
- */
- }
+ DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
+ DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
+ imp_dbh->ph_type = 1; /* SQLT_CHR "(ORANET TYPE) character string" */
+ imp_dbh->ph_csform = 0; /* meaning auto (see dbd_rebind_ph) */
-#ifdef SA_RESTART
-#ifndef SIGCLD
-#define SIGCLD SIGCHLD
-#endif
- /* If orlon has installed a handler for SIGCLD, then reinstall it */
- /* with SA_RESTART. We only do this if connected ok since I've */
- /* seen the process loop after being interrupted after connect failed. */
- if (ora_sigchld_restart) {
- struct sigaction act;
- if (sigaction( SIGCLD, (struct sigaction*)0, &act ) == 0
- && (act.sa_handler != SIG_DFL && act.sa_handler != SIG_IGN)
- && (act.sa_flags & SA_RESTART) == 0) {
- /* XXX we should also check that act.sa_handler is not the perl handler */
- act.sa_flags |= SA_RESTART;
- sigaction( SIGCLD, &act, (struct sigaction*)0 );
- if (DBIS->debug >= 3)
- warn("dbd_db_login: sigaction errno %d, handler %lx, flags %lx",
- errno,act.sa_handler,act.sa_flags);
- if (DBIS->debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_db_login: set SA_RESTART on Oracle SIGCLD handler.\n");
- }
- }
-#endif /* HAS_SIGACTION */
-
-#endif /* OCI_V8_SYNTAX */
-
-dbd_db_login6_out:
- DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
- DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
- imp_dbh->ph_type = 1; /* SQLT_CHR "(ORANET TYPE) character string" */
+ if (!imp_drh->envhp) /* cache first envhp info drh as future default */
+ imp_drh->envhp = imp_dbh->envhp;
#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar)
- if (shared_dbh_ssv && !shared_dbh) {
+ if (shared_dbh_ssv && !shared_dbh) {
/* much of this could be replaced with a single sv_setpvn() */
- SvUPGRADE(shared_dbh_priv_sv, SVt_PV) ;
- SvGROW(shared_dbh_priv_sv, sizeof(imp_dbh_t) + 1) ;
- SvCUR (shared_dbh_priv_sv) = sizeof(imp_dbh_t) ;
- imp_dbh->refcnt = 1 ;
- imp_dbh->shared_dbh_priv_sv = shared_dbh_priv_sv ;
- memcpy(SvPVX(shared_dbh_priv_sv) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ;
- SvSETMAGIC(shared_dbh_priv_sv);
- imp_dbh->shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv->sv);
- }
+ (void)SvUPGRADE(shared_dbh_priv_sv, SVt_PV);
+ SvGROW(shared_dbh_priv_sv, sizeof(imp_dbh_t) + 1) ;
+ SvCUR (shared_dbh_priv_sv) = sizeof(imp_dbh_t) ;
+ imp_dbh->refcnt = 1 ;
+ imp_dbh->shared_dbh_priv_sv = shared_dbh_priv_sv ;
+ memcpy(SvPVX(shared_dbh_priv_sv) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ;
+ SvSETMAGIC(shared_dbh_priv_sv);
+ imp_dbh->shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv->sv);
+ }
#endif
- return 1;
+ /* set up TAF callback if wanted */
+
+ if (imp_dbh->taf_function){
+ if (enable_taf(dbh, imp_dbh) == 0) return 0;
+ }
+
+ return 1;
}
int
-dbd_db_commit(dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
+dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh)
{
-#ifdef OCI_V8_SYNTAX
- sword status;
- OCITransCommit_log_stat(imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, imp_dbh->errhp, status, "OCITransCommit");
-#else
- if (ocom(imp_dbh->lda)) {
- ora_error(dbh, imp_dbh->lda, imp_dbh->lda->rc, "commit failed");
-#endif
- return 0;
- }
- return 1;
+ dTHX;
+ sword status;
+ OCITransCommit_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCITransCommit");
+ return 0;
+ }
+ return 1;
}
-
-
int
-dbd_st_cancel(sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
+dbd_st_cancel(SV *sth, imp_sth_t *imp_sth)
{
-#ifdef OCI_V8_SYNTAX
- sword status;
- status = OCIBreak(imp_sth->svchp, imp_sth->errhp);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBreak");
- return 0;
- }
-#else
- D_imp_dbh_from_sth;
- if (obreak(imp_dbh->lda)) {
- ora_error(sth, imp_dbh->lda, imp_dbh->lda->rc, "obreak");
- return 0;
- }
-#endif
- return 1;
+ dTHX;
+ sword status;
+ status = OCIBreak(imp_sth->svchp, imp_sth->errhp);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBreak");
+ return 0;
+ }
+
+ /* if we are using a scrolling cursor we should get rid of the
+ cursor by fetching row 0 */
+ if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY){
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status);
+ }
+ return 1;
}
int
-dbd_db_rollback(dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
+dbd_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
{
-#ifdef OCI_V8_SYNTAX
- sword status;
- OCITransRollback_log_stat(imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS) {
+ dTHX;
+ sword status;
+ OCITransRollback_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCITransRollback");
-#else
- if (orol(imp_dbh->lda)) {
- ora_error(dbh, imp_dbh->lda, imp_dbh->lda->rc, "rollback failed");
-#endif
return 0;
- }
- return 1;
+ }
+ return 1;
}
+int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs) {
+ dTHX;
+ int field;
+
+ if (!SvIOK(col)) {
+ croak ("Invalid column number") ;
+ }
+
+ field = SvIV(col);
+
+ if ((field < 1) || (field > DBIc_NUM_FIELDS(imp_sth))) {
+ croak("cannot bind to non-existent field %d", field);
+ }
+
+ if (type != 0) {
+ imp_sth->fbh[field-1].req_type = type;
+ }
+ if (attribs) {
+ imp_sth->fbh[field-1].bind_flags = 0; /* default to none */
+ }
+
+#if DBIXS_REVISION >= 13590
+ /* DBIXS 13590 added StrictlyTyped and DiscardString attributes */
+ if (attribs) {
+ HV *attr_hash;
+ SV **attr;
+
+ if (!SvROK(attribs)) {
+ croak ("attributes is not a reference");
+ }
+ else if (SvTYPE(SvRV(attribs)) != SVt_PVHV) {
+ croak ("attributes not a hash reference");
+ }
+ attr_hash = (HV *)SvRV(attribs);
+
+ attr = hv_fetch(attr_hash, "StrictlyTyped", (U32)13, 0);
+ if (attr && SvTRUE(*attr)) {
+ imp_sth->fbh[field-1].bind_flags |= DBIstcf_STRICT;
+ }
+
+ attr = hv_fetch(attr_hash, "DiscardString", (U32)13, 0);
+ if (attr && SvTRUE(*attr)) {
+ imp_sth->fbh[field-1].bind_flags |= DBIstcf_DISCARD_STRING;
+ }
+ }
+#endif /* DBIXS_REVISION >= 13590 */
+ return 1;
+}
int
-dbd_db_disconnect(dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
+dbd_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh)
{
- dTHR;
- int refcnt = 1 ;
+ dTHX;
+ dTHR;
+ int refcnt = 1 ;
#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar)
- if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) {
- SvLOCK (imp_dbh->shared_dbh_priv_sv) ;
- refcnt = imp_dbh -> shared_dbh -> refcnt ;
- }
+ if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) {
+ SvLOCK (imp_dbh->shared_dbh_priv_sv) ;
+ refcnt = imp_dbh -> shared_dbh -> refcnt ;
+ }
#endif
- /* We assume that disconnect will always work */
- /* since most errors imply already disconnected. */
- DBIc_ACTIVE_off(imp_dbh);
+ /* We assume that disconnect will always work */
+ /* since most errors imply already disconnected. */
+ DBIc_ACTIVE_off(imp_dbh);
- /* Oracle will commit on an orderly disconnect. */
- /* See DBI Driver.xst file for the DBI approach. */
+ /* Oracle will commit on an orderly disconnect. */
+ /* See DBI Driver.xst file for the DBI approach. */
-#ifdef OCI_V8_SYNTAX
- if (refcnt == 1) {
- sword s_se, s_sd;
- OCISessionEnd_log_stat(imp_dbh->svchp, imp_dbh->errhp, imp_dbh->authp,
+ if (refcnt == 1 ) {
+ sword s_se, s_sd;
+#ifdef ORA_OCI_112
+ if (imp_dbh->using_drcp) {
+ OCISessionRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp,s_se);
+ }
+ else {
+#endif
+ OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,
OCI_DEFAULT, s_se);
- if (s_se) oci_error(dbh, imp_dbh->errhp, s_se, "OCISessionEnd");
- OCIServerDetach_log_stat(imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, s_sd);
- if (s_sd) oci_error(dbh, imp_dbh->errhp, s_sd, "OCIServerDetach");
- if (s_se || s_sd)
- return 0;
- }
-#else
- if (ologof(imp_dbh->lda)) {
- ora_error(dbh, imp_dbh->lda, imp_dbh->lda->rc, "disconnect error");
- return 0;
- }
+#ifdef ORA_OCI_112
+ }
#endif
- /* We don't free imp_dbh since a reference still exists */
- /* The DESTROY method is the only one to 'free' memory. */
- /* Note that statement objects may still exists for this dbh! */
- return 1;
+ if (s_se) oci_error(dbh, imp_dbh->errhp, s_se, "OCISessionEnd");
+ OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, s_sd);
+ if (s_sd) oci_error(dbh, imp_dbh->errhp, s_sd, "OCIServerDetach");
+ if (s_se || s_sd)
+ return 0;
+ }
+ /* We don't free imp_dbh since a reference still exists */
+ /* The DESTROY method is the only one to 'free' memory. */
+ /* Note that statement objects may still exists for this dbh! */
+ return 1;
}
void
-dbd_db_destroy(dbh, imp_dbh)
- SV *dbh;
- imp_dbh_t *imp_dbh;
+dbd_db_destroy(SV *dbh, imp_dbh_t *imp_dbh)
{
- dTHX ;
- int refcnt = 1 ;
-
+ dTHX ;
+ int refcnt = 1 ;
+ sword status;
+
#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar)
if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) {
SvLOCK (imp_dbh->shared_dbh_priv_sv) ;
@@ -609,649 +1033,1965 @@ dbd_db_destroy(dbh, imp_dbh)
}
#endif
- if (refcnt == 1) {
- if (DBIc_ACTIVE(imp_dbh))
- dbd_db_disconnect(dbh, imp_dbh);
-#ifdef OCI_V8_SYNTAX
- { sword status;
- OCIHandleFree_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,status);
- OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
- OCIHandleFree_log_stat(imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
- }
-#else
- /* Nothing in imp_dbh to be freed */
-#endif
- }
-#ifdef OCI_V8_SYNTAX
- { sword status; /* error handle is not shared, so always free it */
- OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status);
- }
-#endif
- DBIc_IMPSET_off(imp_dbh);
-}
+ if (refcnt == 1) {
+ sword status;
+ if (DBIc_ACTIVE(imp_dbh))
+ dbd_db_disconnect(dbh, imp_dbh);
+ if (is_extproc)
+ goto dbd_db_destroy_out;
-int
-dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- SV *keysv;
- SV *valuesv;
-{
- STRLEN kl;
- char *key = SvPV(keysv,kl);
- SV *cachesv = NULL;
- int on = SvTRUE(valuesv);
-
- if (kl==10 && strEQ(key, "AutoCommit")) {
-#ifndef OCI_V8_SYNTAX
- if ( (on) ? ocon(imp_dbh->lda) : ocof(imp_dbh->lda) ) {
- ora_error(dbh, imp_dbh->lda, imp_dbh->lda->rc, "ocon/ocof failed");
- /* XXX um, we can't return FALSE and true isn't acurate so we croak */
- croak(SvPV(DBIc_ERRSTR(imp_dbh),na));
- }
-#endif /* OCI V8 handles this as OCIExecuteStmt */
- DBIc_set(imp_dbh,DBIcf_AutoCommit, on);
- }
- else if (kl==12 && strEQ(key, "RowCacheSize")) {
- imp_dbh->RowCacheSize = SvIV(valuesv);
- }
- else if (kl==11 && strEQ(key, "ora_ph_type")) {
- if (SvIV(valuesv)!=1 && SvIV(valuesv)!=5 && SvIV(valuesv)!=96 && SvIV(valuesv)!=97)
- croak("ora_ph_type must be 1 (VARCHAR2), 5 (STRING), 96 (CHAR), or 97 (CHARZ)");
- imp_dbh->ph_type = SvIV(valuesv);
- }
- else {
- return FALSE;
- }
- if (cachesv) /* cache value for later DBI 'quick' fetch? */
- hv_store((HV*)SvRV(dbh), key, kl, cachesv, 0);
- return TRUE;
-}
+ if (imp_dbh->taf_function){
+ disable_taf(imp_dbh);
+ }
+ if (imp_dbh->taf_function) {
+ SvREFCNT_dec(imp_dbh->taf_function);
+ imp_dbh->taf_function = NULL;
+ }
+ if (imp_dbh->taf_ctx.dbh_ref) {
+ SvREFCNT_dec(SvRV(imp_dbh->taf_ctx.dbh_ref));
+ imp_dbh->taf_ctx.dbh_ref = NULL;
+ }
-SV *
-dbd_db_FETCH_attrib(dbh, imp_dbh, keysv)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- SV *keysv;
-{
- STRLEN kl;
- char *key = SvPV(keysv,kl);
- SV *retsv = Nullsv;
- /* Default to caching results for DBI dispatch quick_FETCH */
- int cacheit = FALSE;
- /* AutoCommit FETCH via DBI */
+#ifdef ORA_OCI_112
+ if (imp_dbh->using_drcp) {
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION,status);
+ OCISessionPoolDestroy_log_stat(imp_dbh, imp_dbh->poolhp, imp_dbh->errhp,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status);
+ }
+ else {
+#endif
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
- if (kl==10 && strEQ(key, "AutoCommit")) {
- retsv = boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit));
- }
- else if (kl==12 && strEQ(key, "RowCacheSize")) {
- retsv = newSViv(imp_dbh->RowCacheSize);
- }
- else if (kl==11 && strEQ(key, "ora_ph_type")) {
- retsv = newSViv(imp_dbh->ph_type);
- }
- if (!retsv)
- return Nullsv;
- if (cacheit) { /* cache for next time (via DBI quick_FETCH) */
- SV **svp = hv_fetch((HV*)SvRV(dbh), key, kl, 1);
- sv_free(*svp);
- *svp = retsv;
- (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */
- }
- if (retsv == &sv_yes || retsv == &sv_no)
- return retsv; /* no need to mortalize yes or no */
- return sv_2mortal(retsv);
+#ifdef ORA_OCI_112
+ }
+#endif
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
+
+ }
+ OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
+dbd_db_destroy_out:
+ DBIc_IMPSET_off(imp_dbh);
}
+int
+dbd_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
+{
+ dTHX;
+ STRLEN kl;
+ STRLEN vl;
+ sword status;
+ char *key = SvPV(keysv,kl);
+ int on = SvTRUE(valuesv);
+ int cacheit = 1;
-/* ================================================================== */
+ if (kl==17 && strEQ(key, "ora_ncs_buff_mtpl") ) {
+ ora_ncs_buff_mtpl = SvIV (valuesv);
+ }
+#ifdef ORA_OCI_112
+ else if (kl==15 && strEQ(key, "ora_driver_name") ) {
+ imp_dbh->driver_name = (char *) SvPV (valuesv, vl );
+ OCIAttrSet_log_stat(
+ imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, imp_dbh->driver_name,
+ (ub4)vl, OCI_ATTR_DRIVER_NAME, imp_dbh->errhp, status);
+ }
+ else if (kl==8 && strEQ(key, "ora_drcp") ) {
+ imp_dbh->using_drcp = 1;
+ }
+ else if (kl==14 && strEQ(key, "ora_drcp_class") ) {
+ STRLEN vl;
+ imp_dbh->pool_class = (text *) SvPV (valuesv, vl );
+ imp_dbh->pool_classl= (ub4) vl;
+ }
+ else if (kl==12 && strEQ(key, "ora_drcp_min") ) {
+ imp_dbh->pool_min = SvIV (valuesv);
+ }
+ else if (kl==12 && strEQ(key, "ora_drcp_max") ) {
+ imp_dbh->pool_max = SvIV (valuesv);
+ }
+ else if (kl==13 && strEQ(key, "ora_drcp_incr") ) {
+ imp_dbh->pool_incr = SvIV (valuesv);
+ }
+#endif
+ else if (kl==16 && strEQ(key, "ora_taf_function") ) {
+ if (imp_dbh->taf_function)
+ SvREFCNT_dec(imp_dbh->taf_function);
+ imp_dbh->taf_function = newSVsv(valuesv);
+
+ if (SvTRUE(valuesv)) {
+ enable_taf(dbh, imp_dbh);
+ } else {
+ disable_taf(imp_dbh);
+ }
+ }
+#ifdef OCI_ATTR_ACTION
+ else if (kl==10 && strEQ(key, "ora_action") ) {
+ imp_dbh->action = (char *) SvPV (valuesv, vl );
+ imp_dbh->actionl= (ub4) vl;
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status);
+ }
+#endif
+ else if (kl==21 && strEQ(key, "ora_client_identifier") ) {
+ imp_dbh->client_identifier = (char *) SvPV (valuesv, vl );
+ imp_dbh->client_identifierl= (ub4) vl;
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_identifier,imp_dbh->client_identifierl,OCI_ATTR_CLIENT_IDENTIFIER,imp_dbh->errhp, status);
+ }
+#ifdef OCI_ATTR_CLIENT_INFO
+ else if (kl==15 && strEQ(key, "ora_client_info") ) {
+ imp_dbh->client_info = (char *) SvPV (valuesv, vl );
+ imp_dbh->client_infol= (ub4) vl;
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_info,imp_dbh->client_infol,OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status);
+ }
+#endif
+#ifdef OCI_ATTR_MODULE
+ else if (kl==15 && strEQ(key, "ora_module_name") ) {
+ imp_dbh->module_name = (char *) SvPV (valuesv, vl );
+ imp_dbh->module_namel= (ub4) vl;
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->module_name,imp_dbh->module_namel,OCI_ATTR_MODULE,imp_dbh->errhp, status);
-void
-dbd_preparse(imp_sth, statement)
- imp_sth_t *imp_sth;
- char *statement;
-{
- D_imp_dbh_from_sth;
- bool in_literal = FALSE;
- char in_comment = '\0';
- char *src, *start, *dest;
- phs_t phs_tpl;
- SV *phs_sv;
- int idx=0;
- char *style="", *laststyle=Nullch;
- STRLEN namelen;
-
- /* allocate room for copy of statement with spare capacity */
- /* for editing '?' or ':1' into ':p1' so we can use obndrv. */
- /* XXX should use SV and append to it */
- imp_sth->statement = (char*)safemalloc(strlen(statement) * 10);
-
- /* initialise phs ready to be cloned per placeholder */
- memset(&phs_tpl, 0, sizeof(phs_tpl));
- phs_tpl.imp_sth = imp_sth;
- phs_tpl.ftype = imp_dbh->ph_type; /* ph_type in effect at prepare() */
- phs_tpl.maxlen_bound = -1; /* not yet bound */
- phs_tpl.sv = &sv_undef;
-
- src = statement;
- dest = imp_sth->statement;
- while(*src) {
-
- if (in_comment) {
- /* 981028-jdl on mocha. Adding all code which deals with */
- /* in_comment variable (its declaration plus 2 code blocks). */
- /* Text appearing within comments should be scanned for neither */
- /* placeholders nor for single quotes (which toggle the in_literal */
- /* boolean). Comments like "3:00" demonstrate the former problem, */
- /* and contractions like "don't" demonstrate the latter problem. */
- /* The comment style is stored in in_comment; each style is */
- /* terminated in a different way. */
- if (in_comment == '-' && *src == '\n') {
- in_comment = '\0';
- }
- else if (in_comment == '/' && *src == '*' && *(src+1) == '/') {
- *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
- in_comment = '\0';
- }
- *dest++ = *src++;
- continue;
- }
-
- if (in_literal) {
- if (*src == in_literal)
- in_literal = 0;
- *dest++ = *src++;
- continue;
- }
-
- /* Look for comments: '-- oracle-style' or C-style */
- if ((*src == '-' && *(src+1) == '-') ||
- (*src == '/' && *(src+1) == '*'))
+ }
+#endif
+ else if (kl==20 && strEQ(key, "ora_oci_success_warn") ) {
+ oci_warn = SvIV (valuesv);
+ }
+ else if (kl==11 && strEQ(key, "ora_objects")) {
+ ora_objects = SvIV (valuesv);
+ }
+ else if (kl==11 && (strEQ(key, "ora_verbose") || strEQ(key, "dbd_verbose"))) {
+ dbd_verbose = SvIV (valuesv);
+ }
+ else if (kl==10 && strEQ(key, "AutoCommit")) {
+ DBIc_set(imp_dbh,DBIcf_AutoCommit, on);
+ }
+ else if (kl==12 && strEQ(key, "RowCacheSize")) {
+ imp_dbh->RowCacheSize = SvIV(valuesv);
+ }
+ else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) {
+ imp_dbh->max_nested_cursors = SvIV(valuesv);
+ }
+ else if (kl==20 && strEQ(key, "ora_array_chunk_size")) {
+ imp_dbh->array_chunk_size = SvIV(valuesv);
+ }
+ else if (kl==11 && strEQ(key, "ora_ph_type")) {
+ if (SvIV(valuesv)!=1 && SvIV(valuesv)!=5 && SvIV(valuesv)!=96 && SvIV(valuesv)!=97)
+ warn("ora_ph_type must be 1 (VARCHAR2), 5 (STRING), 96 (CHAR), or 97 (CHARZ)");
+ else
+ imp_dbh->ph_type = SvIV(valuesv);
+ }
+
+ else if (kl==13 && strEQ(key, "ora_ph_csform")) {
+ if (SvIV(valuesv)!=SQLCS_IMPLICIT && SvIV(valuesv)!=SQLCS_NCHAR)
+ warn("ora_ph_csform must be 1 (SQLCS_IMPLICIT) or 2 (SQLCS_NCHAR)");
+ else
+ imp_dbh->ph_csform = (ub1)SvIV(valuesv);
+ }
+ else
{
- in_comment = *src;
- /* We know *src & the next char are to be copied, so do */
- /* it. In the case of C-style comments, it happens to */
- /* help us avoid slash-asterisk-slash oddities. */
- *dest++ = *src++;
- *dest++ = *src++;
- continue;
+ return FALSE;
}
- if (*src != ':' && *src != '?') {
+ if (cacheit) /* cache value for later DBI 'quick' fetch? */
+ (void)hv_store((HV*)SvRV(dbh), key, kl, newSVsv(valuesv), 0);
- if (*src == '\'' || *src == '"')
- in_literal = *src;
+ return TRUE;
+}
- *dest++ = *src++;
- continue;
- }
- /* only here for : or ? outside of a comment or literal */
+SV *
+dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
+{
+ dTHX;
+ STRLEN kl;
+ char *key = SvPV(keysv,kl);
+ SV *retsv = Nullsv;
+ /* Default to caching results for DBI dispatch quick_FETCH */
+ int cacheit = FALSE;
- start = dest; /* save name inc colon */
- *dest++ = *src++;
- if (*start == '?') { /* X/Open standard */
- sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */
- dest = start+strlen(start);
- style = "?";
+ /* AutoCommit FETCH via DBI */
- } else if (isDIGIT(*src)) { /* ':1' */
- idx = atoi(src);
- *dest++ = 'p'; /* ':1'->':p1' */
- if (idx <= 0)
- croak("Placeholder :%d invalid, placeholders must be >= 1", idx);
- while(isDIGIT(*src))
- *dest++ = *src++;
- style = ":1";
+ if (kl==18 && strEQ(key, "ora_ncs_buff_mtpl") ) {
+ retsv = newSViv (ora_ncs_buff_mtpl);
+ }
+#ifdef ORA_OCI_112
+ else if (kl==15 && strEQ(key, "ora_driver_name") ) {
+ retsv = newSVpv((char *)imp_dbh->driver_name,0);
+ }
+ else if (kl==8 && strEQ(key, "ora_drcp") ) {
+ retsv = newSViv(imp_dbh->using_drcp);
+ }
+ else if (kl==14 && strEQ(key, "ora_drcp_class") ) {
+ retsv = newSVpv((char *)imp_dbh->pool_class, 0);
+ }
+ else if (kl==12 && strEQ(key, "ora_drcp_min") ) {
+ retsv = newSViv(imp_dbh->pool_min);
+ }
+ else if (kl==12 && strEQ(key, "ora_drcp_max") ) {
+ retsv = newSViv(imp_dbh->pool_max);
+ }
+ else if (kl==13 && strEQ(key, "ora_drcp_incr") ) {
+ retsv = newSViv(imp_dbh->pool_incr);
+ }
+#endif
+ else if (kl==16 && strEQ(key, "ora_taf_function") ) {
+ if (imp_dbh->taf_function) {
+ retsv = newSVsv(imp_dbh->taf_function);
+ }
+ }
+#ifdef OCI_ATTR_ACTION
+ else if (kl==10 && strEQ(key, "ora_action")) {
+ retsv = newSVpv((char *)imp_dbh->action,0);
+ }
+#endif
+ else if (kl==21 && strEQ(key, "ora_client_identifier")) {
+ retsv = newSVpv((char *)imp_dbh->client_identifier,0);
+ }
+ else if (kl==15 && strEQ(key, "ora_client_info")) {
+ retsv = newSVpv((char *)imp_dbh->client_info,0);
+ }
+ else if (kl==15 && strEQ(key, "ora_module_name")) {
+ retsv = newSVpv((char *)imp_dbh->module_name,0);
+ }
+ else if (kl==20 && strEQ(key, "ora_oci_success_warn")) {
+ retsv = newSViv (oci_warn);
+ }
+ else if (kl==11 && strEQ(key, "ora_objects")) {
+ retsv = newSViv (ora_objects);
+ }
+ else if (kl==11 && (strEQ(key, "ora_verbose") || strEQ(key, "dbd_verbose"))) {
+ retsv = newSViv (dbd_verbose);
+ }
+ else if (kl==10 && strEQ(key, "AutoCommit")) {
+ retsv = boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit));
+ }
+ else if (kl==12 && strEQ(key, "RowCacheSize")) {
+ retsv = newSViv(imp_dbh->RowCacheSize);
+ }
+ else if (kl==11 && strEQ(key, "RowsInCache")) {
+ retsv = newSViv(imp_dbh->RowsInCache);
+ }
+ else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) {
+ retsv = newSViv(imp_dbh->max_nested_cursors);
+ }
+ else if (kl==11 && strEQ(key, "ora_ph_type")) {
+ retsv = newSViv(imp_dbh->ph_type);
+ }
+ else if (kl==13 && strEQ(key, "ora_ph_csform")) {
+ retsv = newSViv(imp_dbh->ph_csform);
+ }
+ else if (kl==22 && strEQ(key, "ora_parse_error_offset")) {
+ retsv = newSViv(imp_dbh->parse_error_offset);
+ }
+ if (!retsv)
+ return Nullsv;
+ if (cacheit) { /* cache for next time (via DBI quick_FETCH) */
+ SV **svp = hv_fetch((HV*)SvRV(dbh), key, kl, 1);
+ sv_free(*svp);
+ *svp = retsv;
+ (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */
+ }
- } else if (isALNUM(*src)) { /* ':foo' */
- while(isALNUM(*src)) /* includes '_' */
- *dest++ = *src++;
- style = ":foo";
- } else { /* perhaps ':=' PL/SQL construct */
- /* if (src == ':') *dest++ = *src++; XXX? move past '::'? */
- continue;
- }
- *dest = '\0'; /* handy for debugging */
- namelen = (dest-start);
- if (laststyle && style != laststyle)
- croak("Can't mix placeholder styles (%s/%s)",style,laststyle);
- laststyle = style;
- if (imp_sth->all_params_hv == NULL)
- imp_sth->all_params_hv = newHV();
- phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
- hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
- strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start);
- }
- *dest = '\0';
- if (imp_sth->all_params_hv) {
- DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
- if (DBIS->debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n",
- (int)DBIc_NUM_PARAMS(imp_sth));
- }
+ if (retsv == &PL_sv_yes || retsv == &PL_sv_no)
+ return retsv; /* no need to mortalize yes or no */
+
+ return sv_2mortal(retsv);
}
-int
-calc_cache_rows(num_fields, est_width, cache_rows, has_longs)
- int num_fields, est_width, cache_rows, has_longs;
-{
- /* Use guessed average on-the-wire row width calculated above */
- /* and add in overhead of 5 bytes per field plus 8 bytes per row. */
- /* The n*5+8 was determined by studying SQL*Net v2 packets. */
- /* It could probably benefit from a more detailed analysis. */
- est_width += num_fields*5 + 8;
-
- if (has_longs) /* override/disable caching */
- cache_rows = 1; /* else read_blob can't work */
-
- else if (cache_rows < 1) { /* automatically size the cache */
- int txfr_size;
- /* 0 == try to pick 'optimal' cache for this query (default) */
- /* <0 == base cache on target transfer size of -n bytes. */
- if (cache_rows == 0) {
- /* Oracle packets on ethernet have max size of around 1460. */
- /* We'll aim to fill our row cache with around 10 per go. */
- /* Using 10 means any 'runt' packets will have less impact. */
- txfr_size = 10 * 1460; /* default transfer/cache size */
- }
- else { /* user is specifying desired transfer size in bytes */
- txfr_size = -cache_rows;
- }
- cache_rows = txfr_size / est_width; /* maybe 1 or 0 */
- /* To ensure good performance with large rows (near or larger */
- /* than our target transfer size) we set a minimum cache size. */
- if (cache_rows < 6) /* is cache a 'useful' size? */
- cache_rows = (cache_rows>0) ? 6 : 4;
- }
- if (cache_rows > 32767) /* keep within Oracle's limits */
- cache_rows = 32767;
- return cache_rows;
+/* ================================================================== */
+
+#define MAX_OCISTRING_LEN 32766
+
+SV *
+createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){
+
+ dTHX;
+ dTHR;
+ OCIXMLType *xml = NULL;
+ STRLEN len;
+ ub4 buflen;
+ sword status;
+ ub1 src_type;
+ dvoid* src_ptr = NULL;
+ D_imp_dbh_from_sth;
+ SV* sv_dest;
+ dvoid *bufp;
+ ub1 csform;
+ ub2 csid;
+ csid = 0;
+ csform = SQLCS_IMPLICIT;
+ len = SvLEN(source);
+ bufp = SvPV(source, len);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >=3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " creating xml from string that is %lu long\n",(unsigned long)len);
+ if(len > MAX_OCISTRING_LEN) {
+ src_type = OCI_XMLTYPE_CREATE_CLOB;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >=5 || dbd_verbose >= 5 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " use a temp lob locator for large xml \n");
+
+ OCIDescriptorAlloc_ok(imp_dbh, imp_dbh->envhp, &src_ptr, OCI_DTYPE_LOB);
+
+ OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp,
+ (OCILobLocator *) src_ptr, (ub2) OCI_DEFAULT,
+ (ub1) OCI_DEFAULT, OCI_TEMP_CLOB, FALSE, OCI_DURATION_SESSION, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary");
+ }
+ csid = (SvUTF8(source) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
+ buflen = len;
+ OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, src_ptr,
+ &buflen, bufp, (ub4)len, OCI_ONE_PIECE,
+ NULL, NULL,
+ csid, csform, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobWriteAppend");
+ }
+
+ } else {
+ src_type = OCI_XMLTYPE_CREATE_OCISTRING;
+ if (DBIc_DBISTATE(imp_sth)->debug >=5 || dbd_verbose >= 5 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " use a OCIStringAssignText for small xml \n");
+ OCIStringAssignText(imp_dbh->envhp,
+ imp_dbh->errhp,
+ bufp,
+ (ub2) (ub4)len,
+ (OCIString **) &src_ptr);
+ }
+
+
+
+ OCIXMLTypeCreateFromSrc_log_stat(imp_dbh,
+ imp_dbh->svchp,
+ imp_dbh->errhp,
+ (OCIDuration)OCI_DURATION_CALLOUT,
+ (ub1)src_type,
+ (dvoid *)src_ptr,
+ (sb4)OCI_IND_NOTNULL,
+ &xml,
+ status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIXMLTypeCreateFromSrc");
+ }
+
+/* free temporary resources */
+ if ( src_type == OCI_XMLTYPE_CREATE_CLOB ) {
+ OCILobFreeTemporary(imp_dbh->svchp, imp_dbh->errhp,
+ (OCILobLocator*) src_ptr);
+
+ OCIDescriptorFree_log(imp_dbh, (dvoid *) src_ptr, (ub4) OCI_DTYPE_LOB);
+ }
+
+
+ sv_dest = newSViv(0);
+ sv_setref_pv(sv_dest, "OCIXMLTypePtr", xml);
+ return sv_dest;
+
+}
+
+
+void
+dbd_preparse(imp_sth_t *imp_sth, char *statement)
+{
+dTHX;
+D_imp_dbh_from_sth;
+char in_literal = '\0';
+char in_comment = '\0';
+char *src, *start, *dest;
+phs_t phs_tpl;
+SV *phs_sv;
+int idx=0;
+char *style="", *laststyle=Nullch;
+STRLEN namelen;
+phs_t *phs;
+ /* allocate room for copy of statement with spare capacity */
+ /* for editing '?' or ':1' into ':p1' so we can use obndrv. */
+ /* XXX should use SV and append to it */
+ Newz(0,imp_sth->statement,strlen(statement) * 10,char);
+
+ /* initialise phs ready to be cloned per placeholder */
+ memset(&phs_tpl, 0, sizeof(phs_tpl));
+ phs_tpl.imp_sth = imp_sth;
+ phs_tpl.ftype = imp_dbh->ph_type;
+ phs_tpl.csform = imp_dbh->ph_csform;
+ phs_tpl.sv = &PL_sv_undef;
+
+ src = statement;
+ dest = imp_sth->statement;
+ while(*src) {
+
+ if (in_comment) {
+ /* 981028-jdl on mocha. Adding all code which deals with */
+ /* in_comment variable (its declaration plus 2 code blocks). */
+ /* Text appearing within comments should be scanned for neither */
+ /* placeholders nor for single quotes (which toggle the in_literal */
+ /* boolean). Comments like "3:00" demonstrate the former problem, */
+ /* and contractions like "don't" demonstrate the latter problem. */
+ /* The comment style is stored in in_comment; each style is */
+ /* terminated in a different way. */
+ if (in_comment == '-' && *src == '\n') {
+ in_comment = '\0';
+ }
+ else if (in_comment == '/' && *src == '*' && *(src+1) == '/') {
+ *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
+ in_comment = '\0';
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ if (in_literal) {
+ if (*src == in_literal)
+ in_literal = '\0';
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* Look for comments: '-- oracle-style' or C-style */
+ if ((*src == '-' && *(src+1) == '-') ||
+ (*src == '/' && *(src+1) == '*'))
+ {
+ in_comment = *src;
+ /* We know *src & the next char are to be copied, so do */
+ /* it. In the case of C-style comments, it happens to */
+ /* help us avoid slash-asterisk-slash oddities. */
+ *dest++ = *src++;
+ *dest++ = *src++;
+ continue;
+ }
+
+ if (*src != ':' && *src != '?') {
+
+ if (*src == '\'' || *src == '"')
+ in_literal = *src;
+
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* only here for : or ? outside of a comment or literal */
+
+ start = dest; /* save name inc colon */
+ *dest++ = *src++;
+ if (*start == '?') { /* X/Open standard */
+ sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */
+ dest = start+strlen(start);
+ style = "?";
+
+ }
+ else if (isDIGIT(*src)) { /* ':1' */
+ idx = atoi(src);
+ *dest++ = 'p'; /* ':1'->':p1' */
+ if (idx <= 0)
+ croak("Placeholder :%d invalid, placeholders must be >= 1", idx);
+
+ while(isDIGIT(*src))
+ *dest++ = *src++;
+ style = ":1";
+
+ }
+ else if (isALNUM(*src)) { /* ':foo' */
+ while(isALNUM(*src)) /* includes '_' */
+ *dest++ = toLOWER(*src), src++;
+ style = ":foo";
+
+ } else { /* perhaps ':=' PL/SQL construct */
+ /* if (src == ':') *dest++ = *src++; XXX? move past '::'? */
+ continue;
+ }
+
+ *dest = '\0'; /* handy for debugging */
+ namelen = (dest-start);
+ if (laststyle && style != laststyle)
+ croak("Can't mix placeholder styles (%s/%s)",style,laststyle);
+ laststyle = style;
+ if (imp_sth->all_params_hv == NULL)
+ imp_sth->all_params_hv = newHV();
+ phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
+ phs = (phs_t*)(void*)SvPVX(phs_sv);
+ (void)hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
+ phs->idx = idx-1; /* Will be 0 for :1, -1 for :foo. */
+ strcpy(phs->name, start);
+ }
+ *dest = '\0';
+ if (imp_sth->all_params_hv) {
+ DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
+ if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " dbd_preparse scanned %d distinct placeholders\n",
+ (int)DBIc_NUM_PARAMS(imp_sth));
+ }
}
static int
-ora_sql_type(imp_sth, name, sql_type)
- imp_sth_t *imp_sth;
- char *name;
- int sql_type;
+ora_sql_type(imp_sth_t *imp_sth, char *name, int sql_type)
{
- /* XXX should detect DBI reserved standard type range here */
-
- switch (sql_type) {
- case SQL_NUMERIC:
- case SQL_DECIMAL:
- case SQL_INTEGER:
- case SQL_BIGINT:
- case SQL_TINYINT:
- case SQL_SMALLINT:
- case SQL_FLOAT:
- case SQL_REAL:
- case SQL_DOUBLE:
- case SQL_VARCHAR:
+ /* XXX should detect DBI reserved standard type range here */
+
+ switch (sql_type) {
+ case SQL_NUMERIC:
+ case SQL_DECIMAL:
+ case SQL_INTEGER:
+ case SQL_BIGINT:
+ case SQL_TINYINT:
+ case SQL_SMALLINT:
+ case SQL_FLOAT:
+ case SQL_REAL:
+ case SQL_DOUBLE:
+ case SQL_VARCHAR:
return 1; /* Oracle VARCHAR2 */
- case SQL_CHAR:
+ case SQL_CHAR:
return 96; /* Oracle CHAR */
- case SQL_BINARY:
- case SQL_VARBINARY:
+ case SQL_BINARY:
+ case SQL_VARBINARY:
return 23; /* Oracle RAW */
- case SQL_LONGVARBINARY:
+ case SQL_LONGVARBINARY:
return 24; /* Oracle LONG RAW */
- case SQL_LONGVARCHAR:
+ case SQL_LONGVARCHAR:
return 8; /* Oracle LONG */
- case SQL_DATE:
- case SQL_TIME:
- case SQL_TIMESTAMP:
- default:
+ case SQL_UDT:
+ return 108; /* Oracle NTY */
+
+ case SQL_CLOB:
+ return 112; /* Oracle CLOB */
+
+ case SQL_BLOB:
+ return 113; /* Oracle BLOB */
+
+ case SQL_DATE:
+ case SQL_TIME:
+ case SQL_TIMESTAMP:
+ default:
if (imp_sth && DBIc_WARN(imp_sth) && name)
- warn("SQL type %d for '%s' is not fully supported, bound as SQL_VARCHAR instead",
+ warn("SQL type %d for '%s' is not fully supported, bound as SQL_VARCHAR instead",
sql_type, name);
return ora_sql_type(imp_sth, name, SQL_VARCHAR);
- }
+ }
}
-static int
-dbd_rebind_ph_char(sth, imp_sth, phs, alen_ptr_ptr)
- SV *sth;
- imp_sth_t *imp_sth;
- phs_t *phs;
- ub2 **alen_ptr_ptr;
+/* ############### Array bind ######################################### */
+/* Added by Alexander V Alekseev. alex@alemate.ru */
+/*
+ *
+ * Realloc temporary array buffer to match required number of entries
+ * and buffer size.
+ *
+ * Return value: croaks on error. false (=0 ) on success.
+ * */
+int ora_realloc_phs_array(phs_t *phs,int newentries, int newbufsize){
+
+ dTHX;
+ dTHR;
+ int i; /* Loop variable */
+ unsigned short *newal;
+
+ if( newbufsize < 0 ){
+ newbufsize=0;
+ }
+ if( newentries > phs->array_numallocated ){
+ OCIInd *newind=(OCIInd *)realloc(phs->array_indicators,newentries*sizeof(OCIInd) );
+ if( newind ){
+ phs->array_indicators=newind;
+ /* Init all indicators to NULL values. */
+ for( i=phs->array_numallocated; i < newentries ; i++ ){
+ newind[i]=1;
+ }
+ }else{
+ croak("Not enough memory to allocate %d OCI indicators.",newentries);
+ }
+ newal=(unsigned short *)realloc(phs->array_lengths, newentries*sizeof(unsigned short));
+ if( newal ){
+ phs->array_lengths=newal;
+ /* Init all new lengths to zero */
+ if( newentries > phs->array_numallocated ){
+ memset(
+ &(newal[phs->array_numallocated]),
+ 0,
+ (newentries-(phs->array_numallocated))*sizeof(unsigned short)
+ );
+ }
+ }else{
+ croak("Not enough memory to allocate %d entries in OCI array of lengths.",newentries);
+ }
+ phs->array_numallocated=newentries;
+ }
+ if( phs->array_buflen < newbufsize ){
+ char * newbuf=(char *)realloc( phs->array_buf, (unsigned) newbufsize );
+ if( newbuf ){
+ phs->array_buf=newbuf;
+ }else{
+ croak("Not enough memory to allocate OCI array buffer of %d bytes.",newbufsize);
+ }
+ phs->array_buflen=newbufsize;
+ }
+ return 0;
+}
+/* bind of SYS.DBMS_SQL.VARCHAR2_TABLE */
+int
+dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
- STRLEN value_len;
- int at_exec = 0;
-#ifdef OCI_V8_SYNTAX
- at_exec = (phs->desc_h == NULL);
-#endif
+ dTHX;
+ /*D_imp_dbh_from_sth ;*/
+ sword status;
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ AV *arr;
+ ub1 csform;
+ ub2 csid;
+ int flag_data_is_utf8=0;
+ int need_allocate_rows;
+ int buflen;
+ int numarrayentries;
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
+ croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ arr=(AV*)(SvRV(phs->sv));
- if (!SvPOK(phs->sv)) { /* normalizations for special cases */
- if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
- if (!(SvROK(phs->sv) && phs->is_inout))
- sv_2pv(phs->sv, &na);
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): array_numstruct=%d\n",
+ phs->array_numstruct);
+ }
+ /* If no number of entries to bind specified,
+ * set phs->array_numstruct to the scalar(@array) bound.
+ */
+ /* av_len() returns last array index, or -1 is array is empty */
+ numarrayentries=av_len( arr );
+
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): array_numstruct=%d (calculated) \n",
+ phs->array_numstruct);
+ }
+ }
+ /* Fix charset */
+ csform = phs->csform;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): original csform=%d\n",
+ (int)csform);
+ }
+ /* Calculate each bound structure maxlen.
+ * If maxlen<=0, let maxlen=MAX ( length($$_) each @array );
+ *
+ * Charset calculation is done inside this loop either.
+ */
+ {
+ unsigned int maxlen=0;
+ int i;
+
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ if( phs->maxlen <=0 ){ /* Analyze maxlength only if not forced */
+ STRLEN length=0;
+ if (!SvPOK(item)) { /* normalizations for special cases */
+ if (SvOK(item)) { /* ie a number, convert to string ASAP */
+ if (!(SvROK(item) && phs->is_inout)){
+ sv_2pv(item, &length);
+ }
+ } else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */
+ (void)SvUPGRADE(item, SVt_PV);
+ }
+ }
+ if( length == 0 ){
+ length=SvCUR(item);
+ }
+ if( length+1 > maxlen ){
+ maxlen=length+1;
+ }
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n",
+ i,(int)length);
+ }
+ }
+ if(SvUTF8(item) ){
+ flag_data_is_utf8=1;
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i);
+ }
+ if (csform != SQLCS_NCHAR) {
+ /* try to default csform to avoid translation through non-unicode */
+ if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) /* prefer NCHAR */
+ csform = SQLCS_NCHAR;
+ else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
+ csform = SQLCS_IMPLICIT;
+ /* else leave csform == 0 */
+ if (trace_level || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s",
+ phs->name,
+ (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are unicode\n");
+ }
+ }else{
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i);
+ }
+ }
+ }
+ }
+ if( phs->maxlen <=0 ){
+ phs->maxlen=maxlen;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): phs->maxlen calculated =%ld\n",
+ (long)maxlen);
+ }
+ } else{
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n",
+ (long)maxlen);
+ }
+ }
+ }
+ /* Do not allow string bind longer than max VARCHAR2=4000+1 */
+ if( phs->maxlen > 4001 ){
+ phs->maxlen=4001;
}
- else /* ensure we're at least an SVt_PV (so SvPVX etc work) */
- SvUPGRADE(phs->sv, SVt_PV);
- }
- if (DBIS->debug >= 2) {
- char *val = neatsvpv(phs->sv,0);
- PerlIO_printf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val);
- if (!SvOK(phs->sv))
- PerlIO_printf(DBILOGFP, "NULL, ");
- PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ",
- (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen);
- PerlIO_printf(DBILOGFP, "ptype %d, otype %d%s)\n",
- (int)SvTYPE(phs->sv), phs->ftype,
- (phs->is_inout) ? ", inout" : "");
- }
+ if( phs->array_numstruct == 0 ){
+ /* Oracle doesn't allow NULL buffers even for empty tables. Don't know why. */
+ phs->array_numstruct=1;
+ }
+ if( phs->ora_maxarray_numentries== 0 ){
+ /* Zero means "use current array length". */
+ phs->ora_maxarray_numentries=phs->array_numstruct;
+ }
+
+ need_allocate_rows=phs->ora_maxarray_numentries;
- /* At the moment we always do sv_setsv() and rebind. */
- /* Later we may optimise this so that more often we can */
- /* just copy the value & length over and not rebind. */
-
- if (phs->is_inout) { /* XXX */
- if (SvREADONLY(phs->sv))
- croak("Modification of a read-only value attempted");
- if (imp_sth->ora_pad_empty)
- croak("Can't use ora_pad_empty with bind_param_inout");
- if (1 || !at_exec) {
- /* phs->sv _is_ the real live variable, it may 'mutate' later */
- /* pre-upgrade high to reduce risk of SvPVX realloc/move */
- (void)SvUPGRADE(phs->sv, SVt_PVNV);
- /* ensure room for result, 28 is magic number (see sv_2pv) */
- SvGROW(phs->sv, (STRLEN)((phs->maxlen < 28) ? 28 : phs->maxlen)+1/*for null*/);
+ if( need_allocate_rows< phs->array_numstruct ){
+ need_allocate_rows=phs->array_numstruct;
}
- }
+ buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least ora_maxarray_numentries entries */
+ /* Upgrade array buffer to new length */
+ if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){
+ croak("Unable to bind %s - %d structures by %d bytes requires too much memory.",
+ phs->name, need_allocate_rows, buflen );
+ }else{
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): ora_realloc_phs_array(,"
+ "need_allocate_rows=%d,buflen=%d) succeeded.\n",
+ need_allocate_rows,buflen);
+ }
+ }
+ /* If maximum allowed bind numentries is less than allowed,
+ * do not bind full array
+ */
+ if( phs->array_numstruct > phs->ora_maxarray_numentries ){
+ phs->array_numstruct = phs->ora_maxarray_numentries;
+ }
+ /* Fill array buffer with string data */
- /* At this point phs->sv must be at least a PV with a valid buffer, */
- /* even if it's undef (null) */
- /* Here we set phs->progv, phs->indp, and value_len. */
- if (SvOK(phs->sv)) {
- phs->progv = SvPV(phs->sv, value_len);
- phs->indp = 0;
- }
- else { /* it's null but point to buffer incase it's an out var */
- phs->progv = (phs->is_inout) ? SvPVX(phs->sv) : NULL;
- phs->indp = -1;
- value_len = 0;
- }
- if (imp_sth->ora_pad_empty && value_len==0) {
- sv_setpv(phs->sv, " ");
- phs->progv = SvPV(phs->sv, value_len);
- }
- phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
- phs->maxlen = ((IV)SvLEN(phs->sv))-1; /* avail buffer space (64bit safe) */
- if (phs->maxlen < 0) /* can happen with nulls */
- phs->maxlen = 0;
+ {
+ int i; /* Not to require C99 mode */
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ STRLEN itemlen;
+ char *str=SvPV(item, itemlen);
+ if( str && (itemlen>0) ){
+ /* Limit string length to maxlen. FIXME: This may corrupt UTF-8 data. */
+ if( itemlen > (unsigned int) phs->maxlen-1 ){
+ itemlen=phs->maxlen-1;
+ }
+ memcpy( phs->array_buf+phs->maxlen*i,
+ str,
+ itemlen);
+ /* Set last byte to zero */
+ phs->array_buf[ phs->maxlen*i + itemlen ]=0;
+ phs->array_indicators[i]=0;
+ phs->array_lengths[i]=itemlen+1; /* Zero byte */
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%lu array[%d]='%s'.\n",
+ (unsigned long)itemlen,i,str);
+ }
+ }else{
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%lu array[%d]=NULL (length==0 or ! str) .\n",
+ (unsigned long)itemlen,i);
+ }
+ }
+ }else{
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3 || dbd_verbose >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): "
+ "Copying length=? array[%d]=NULL av_fetch failed.\n", i);
+ }
+ }
+ }
+ }
+ /* Do actual bind */
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ phs->array_buf,
+ phs->maxlen,
+ (ub2)SQLT_STR, phs->array_indicators,
+ phs->array_lengths, /* ub2 *alen_ptr not needed with OCIBindDynamic */
+ (ub2)0,
+ (ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */
+ (ub4 *)&(phs->array_numstruct), /* (ptr to) current number of elements in array */
+ OCI_DEFAULT, /* OCI_DATA_AT_EXEC (bind with callbacks) or OCI_DEFAULT */
+ status
+ );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
+ }
+ OCIBindArrayOfStruct_log_stat(imp_sth, phs->bndhp, imp_sth->errhp,
+ (unsigned)phs->maxlen, /* Skip parameter for the next data value */
+ (unsigned)sizeof (OCIInd), /* Skip parameter for the next indicator value */
+ (unsigned)sizeof(unsigned short), /* Skip parameter for the next actual length value */
+ 0, /* Skip parameter for the next column-level error code */
+ status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct");
+ return 0;
+ }
+ /* Fixup charset */
+ if (csform) {
+ /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)"));
+ return 0;
+ }
+ }
-#ifdef OCI_V8_SYNTAX
- phs->alen = value_len + phs->alen_incnull;
-#else
- if (value_len + phs->alen_incnull <= UB2MAXVAL) {
- phs->alen = value_len + phs->alen_incnull;
- *alen_ptr_ptr = &phs->alen;
- if (((IV)phs->alen) > phs->maxlen && phs->indp != -1)
- croak("panic: dbd_rebind_ph alen %ld > maxlen %ld (incnul %d)",
- phs->alen,phs->maxlen, phs->alen_incnull);
- }
- else {
- phs->alen = 0;
- *alen_ptr_ptr = NULL; /* Can't use alen for long LONGs (>64k) */
- if (phs->is_inout)
- croak("Can't bind LONG values (>%ld) as in/out parameters", (long)UB2MAXVAL);
- }
-#endif
+ if (!phs->csid_orig) { /* get the default csid Oracle would use */
+ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 ,
+ OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ }
- if (DBIS->debug >= 3) {
- PerlIO_printf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d, at_exec %d)\n",
- phs->name,
- (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen),
- (phs->progv) ? phs->progv : "",
- (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp, at_exec);
- }
+ /* if app has specified a csid then use that, else use default */
+ csid = (phs->csid) ? phs->csid : phs->csid_orig;
+
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ if ( flag_data_is_utf8 && !CS_IS_UTF8(csid))
+ csid = utf8_csid; /* not al32utf8_csid here on purpose */
+
+ if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_varchar2_table(): bind %s <== %s "
+ "(%s, %s, csid %d->%d->%d, ftype %d, csform %d (%s)->%d (%s), maxlen %lu, maxdata_size %lu)\n",
+ phs->name, neatsvpv(phs->sv,0),
+ (phs->is_inout) ? "inout" : "in",
+ flag_data_is_utf8 ? "is-utf8" : "not-utf8",
+ phs->csid_orig, phs->csid, csid,
+ phs->ftype, phs->csform,oci_csform_name(phs->csform), csform,oci_csform_name(csform),
+ (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
+
+
+ if (csid) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)"));
+ return 0;
+ }
+ }
- return 1;
+ if (phs->maxdata_size) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ phs->array_buf, (ub4)phs->array_buflen, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)"));
+ return 0;
+ }
+ }
+
+ return 2;
}
-#ifdef OCI_V8_SYNTAX
-/*
- * Rebind an "in" cursor ref to its real statement handle
- * This allows passing cursor refs as "in" to pl/sql (but only if you got the
- * cursor from pl/sql to begin with)
- */
-int
-pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+/* Copy array data from array buffer into perl array */
+/* Returns false on error, true on success */
+int dbd_phs_varchar_table_posy_exe(imp_sth_t *imp_sth, phs_t *phs){
+ dTHX;
+
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ AV *arr;
+
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
+ croak("dbd_phs_varchar_table_posy_exe(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ if (trace_level >= 1 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): Called for '%s' : array_numstruct=%d, maxlen=%ld \n",
+ phs->name,
+ phs->array_numstruct,
+ (long)phs->maxlen
+ );
+ }
+ arr=(AV*)(SvRV(phs->sv));
+
+ /* If no data is returned, just clear the array. */
+ if( phs->array_numstruct <= 0 ){
+ av_clear(arr);
+ return 1;
+ }
+ /* Delete extra data from array, if any */
+ while( av_len(arr) >= phs->array_numstruct ){
+ av_delete(arr,av_len(arr),G_DISCARD);
+ };
+ /* Extend array, if needed. */
+ if( av_len(arr)+1 < phs->array_numstruct ){
+ av_extend(arr,phs->array_numstruct-1);
+ }
+ /* Fill array with buffer data */
+ {
+ /* phs_t */
+ int i; /* Not to require C99 mode */
+ for(i=0;i<phs->array_numstruct;i++){
+ SV *item,**pitem;
+ pitem=av_fetch(arr,i,0);
+ if( pitem ){
+ item=*pitem;
+ }
+ else{
+ item=NULL;
+ }
+ if( phs->array_indicators[i] == -1 ){
+ /* NULL */
+ if( item ){
+ SvSetMagicSV(item,&PL_sv_undef);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): arr[%d] = undef; SvSetMagicSV(item,&PL_sv_undef);\n",i);
+ }
+ }
+ else{
+ av_store(arr,i,&PL_sv_undef);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n",i);
+ }
+ }
+ }
+ else{
+ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){
+ /* Truncation occurred */
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): Placeholder '%s': data truncated at %d row.\n",
+ phs->name,i);
+ }
+ }
+ else{
+ /* All OK. Just copy value.*/
+ }
+ if( item ){
+ sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]);
+ SvPOK_only_UTF8(item);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): arr[%d] = '%s'; "
+ "sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n",
+ i, phs->array_buf+phs->maxlen*i
+ );
+ }
+ }
+ else{
+ av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): arr[%d] = '%s'; "
+ "av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i])); \n",
+ i, phs->array_buf+phs->maxlen*i
+ );
+ }
+ }
+ }
+ }
+ }
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_varchar_table_posy_exe(): scalar(@arr)=%ld.\n",
+ (long)av_len(arr)+1);
+ }
+ return 1;
+}
+
+/* bind of SYS.DBMS_SQL.NUMBER_TABLE */
+int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) {
+ dTHX;
+ /*D_imp_dbh_from_sth ;*/
+ sword status;
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ AV *arr;
+ int need_allocate_rows;
+ int buflen;
+ int numarrayentries;
+ /*int flag_data_is_utf8=0;*/
+
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
+ croak("dbd_rebind_ph_number_table(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ /* Default bind type for number table is double. */
+ if( ! phs->ora_internal_type ){
+ phs->ora_internal_type=SQLT_FLT;
+ }else{
+ if( (phs->ora_internal_type != SQLT_FLT) &&
+ (phs->ora_internal_type != SQLT_INT) ){
+ croak("dbd_rebind_ph_number_table(): Specified internal bind type %d unsupported. "
+ "SYS.DBMS_SQL.NUMBER_TABLE can be bound only to SQLT_FLT or SQLT_INT datatypes.",
+ phs->ora_internal_type);
+ }
+ }
+ arr=(AV*)(SvRV(phs->sv));
+
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): array_numstruct=%d\n",
+ phs->array_numstruct);
+ }
+ /* If no number of entries to bind specified,*/
+ /* set phs->array_numstruct to the scalar(@array) bound.*/
+ /* av_len() returns last array index, or -1 is array is empty */
+ numarrayentries=av_len( arr );
+
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n",
+ phs->array_numstruct);
+ }
+ }
+
+ /* Calculate each bound structure maxlen.
+ * maxlen(int) = sizeof(int);
+ * maxlen(double) = sizeof(double);
+ */
+ switch( phs->ora_internal_type ){
+ case SQLT_INT:
+ phs->maxlen=sizeof(int);
+ break;
+ case SQLT_FLT:
+ default:
+ phs->maxlen=sizeof(double);
+ }
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): phs->maxlen calculated =%ld\n",
+ (long)phs->maxlen);
+ }
+
+ if( phs->array_numstruct == 0 ){
+ /* Oracle doesn't allow NULL buffers even for empty tables. Don't know why. */
+ phs->array_numstruct=1;
+ }
+ if( phs->ora_maxarray_numentries== 0 ){
+ /* Zero means "use current array length". */
+ phs->ora_maxarray_numentries=phs->array_numstruct;
+
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): ora_maxarray_numentries "
+ "assumed=phs->array_numstruct=%d\n",
+ phs->array_numstruct);
+ }
+ }else{
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): ora_maxarray_numentries=%d\n",
+ phs->ora_maxarray_numentries);
+ }
+ }
+
+ need_allocate_rows=phs->ora_maxarray_numentries;
+
+ if( need_allocate_rows< phs->array_numstruct ){
+ need_allocate_rows=phs->array_numstruct;
+ }
+ buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least ora_maxarray_numentries entries */
+
+ /* Upgrade array buffer to new length */
+ if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){
+ croak("Unable to bind %s - %d structures by %d bytes requires too much memory.",
+ phs->name, need_allocate_rows, buflen );
+ }else{
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): ora_realloc_phs_array(,"
+ "need_allocate_rows=%d,buflen=%d) succeeded.\n",
+ need_allocate_rows,buflen);
+ }
+ }
+ /* If maximum allowed bind numentries is less than allowed,
+ * do not bind full array
+ */
+ if( phs->array_numstruct > phs->ora_maxarray_numentries ){
+ phs->array_numstruct = phs->ora_maxarray_numentries;
+ }
+ /* Fill array buffer with data */
+
+ {
+ int i; /* Not to require C99 mode */
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ switch( phs->ora_internal_type ){
+ case SQLT_INT:
+ {
+ int ival =0;
+ int val_found=0;
+ /* Double values are converted as int(val) */
+ if( SvOK( item ) && ! SvIOK( item ) ){
+ double val=SvNVx( item );
+ if( SvNOK( item ) ){
+ ival=(int) val;
+ val_found=1;
+ }
+ }
+ /* Convert item, if possible. */
+ if( (!val_found) && SvOK( item ) && ! SvIOK( item ) ){
+ SvIVx( item );
+ }
+ if( SvIOK( item ) || val_found ){
+ if( ! val_found ){
+ ival=SvIV( item );
+ }
+ /* as phs->array_buf=malloc(), proper alignment is guaranteed */
+ *(int*)(phs->array_buf+phs->maxlen*i)=ival;
+ phs->array_indicators[i]=0;
+ }else{
+ if( SvOK( item ) ){
+ /* Defined NaN assumed =0 */
+ *(int*)(phs->array_buf+phs->maxlen*i)=0;
+ phs->array_indicators[i]=0;
+ }else{
+ /* NULL */
+ phs->array_indicators[i]=1;
+ }
+ }
+ phs->array_lengths[i]=sizeof(int);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): "
+ "(integer) array[%d]=%d%s\n",
+ i, *(int*)(phs->array_buf+phs->maxlen*i),
+ phs->array_indicators[i] ? " (NULL)" : "" );
+ }
+ }
+ break;
+ case SQLT_FLT:
+ default:
+ {
+ phs->ora_internal_type=SQLT_FLT; /* Just in case */
+ /* Convert item, if possible. */
+ if( SvOK( item ) && ! SvNOK( item ) ){
+ SvNVx( item );
+ }
+ if( SvNOK( item ) ){
+ double val=SvNVx( item );
+ /* as phs->array_buf=malloc(), proper alignment is guaranteed */
+ *(double*)(phs->array_buf+phs->maxlen*i)=val;
+ phs->array_indicators[i]=0;
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): "
+ "let (double) array[%d]=%f - NOT NULL\n",
+ i, val);
+ }
+ }else{
+ if( SvOK( item ) ){
+ /* Defined NaN assumed =0 */
+ *(double*)(phs->array_buf+phs->maxlen*i)=0;
+ phs->array_indicators[i]=0;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ STRLEN l;
+ char *p=SvPV(item,l);
+
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): "
+ "let (double) array[%d]=\"%s\" =NaN. Set =0 - NOT NULL\n",
+ i, p ? p : "<NULL>" );
+ }
+ }else{
+ /* NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): "
+ "let (double) array[%d] NULL\n",
+ i);
+ }
+ }
+ }
+ phs->array_lengths[i]=sizeof(double);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): "
+ "(double) array[%d]=%f%s\n",
+ i, *(double*)(phs->array_buf+phs->maxlen*i),
+ phs->array_indicators[i] ? " (NULL)" : "" );
+ }
+ }
+ break;
+ }
+ }else{
+ /* item not defined, mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_number_table(): "
+ "Copying length=? array[%d]=NULL av_fetch failed.\n", i);
+ }
+ }
+ }
+ }
+ /* Do actual bind */
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ phs->array_buf,
+ phs->maxlen,
+ (ub2)phs->ora_internal_type, phs->array_indicators,
+ phs->array_lengths,
+ (ub2)0,
+ (ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */
+ (ub4 *)&(phs->array_numstruct), /* (ptr to) current number of elements in array */
+ OCI_DEFAULT, /* OCI_DATA_AT_EXEC (bind with callbacks) or OCI_DEFAULT */
+ status
+ );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
+ }
+ OCIBindArrayOfStruct_log_stat(imp_sth, phs->bndhp, imp_sth->errhp,
+ (unsigned)phs->maxlen, /* Skip parameter for the next data value */
+ (unsigned)sizeof(OCIInd), /* Skip parameter for the next indicator value */
+ (unsigned)sizeof(unsigned short), /* Skip parameter for the next actual length value */
+ 0, /* Skip parameter for the next column-level error code */
+ status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct");
+ return 0;
+ }
+ if (phs->maxdata_size) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ phs->array_buf, (ub4)phs->array_buflen, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)"));
+ return 0;
+ }
+ }
+
+ return 2;
+}
+
+
+/* Copy array data from array buffer into perl array */
+/* Returns false on error, true on success */
+int dbd_phs_number_table_post_exe(imp_sth_t *imp_sth, phs_t *phs){
+ dTHX;
+
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ AV *arr;
+
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
+ croak("dbd_phs_number_table_post_exe(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ if (trace_level >= 1 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): Called for '%s' : array_numstruct=%d, maxlen=%ld \n",
+ phs->name,
+ phs->array_numstruct,
+ (long)phs->maxlen
+ );
+ }
+ /* At this point, ora_internal_type can't be default. It must be set at bind time. */
+ if( (phs->ora_internal_type != SQLT_FLT) &&
+ (phs->ora_internal_type != SQLT_INT) ){
+ croak("dbd_rebind_ph_number_table(): Specified internal bind type %d unsupported. "
+ "SYS.DBMS_SQL.NUMBER_TABLE can be bound only to SQLT_FLT, SQLT_INT datatypes.",
+ phs->ora_internal_type);
+ }
+ arr=(AV*)(SvRV(phs->sv));
+
+ /* If no data is returned, just clear the array. */
+ if( phs->array_numstruct <= 0 ){
+ av_clear(arr);
+ return 1;
+ }
+ /* Delete extra data from array, if any */
+ while( av_len(arr) >= phs->array_numstruct ){
+ av_delete(arr,av_len(arr),G_DISCARD);
+ };
+ /* Extend array, if needed. */
+ if( av_len(arr)+1 < phs->array_numstruct ){
+ av_extend(arr,phs->array_numstruct-1);
+ }
+ /* Fill array with buffer data */
+ {
+ /* phs_t */
+ int i; /* Not to require C99 mode */
+ for(i=0;i<phs->array_numstruct;i++){
+ SV *item,**pitem;
+ pitem=av_fetch(arr,i,0);
+ if( pitem ){
+ item=*pitem;
+ }else{
+ item=NULL;
+ }
+ if( phs->array_indicators[i] == -1 ){
+ /* NULL */
+ if( item ){
+ SvSetMagicSV(item,&PL_sv_undef);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): arr[%d] = undef; SvSetMagicSV(item,&PL_sv_undef);\n",
+ i
+ );
+ }
+ }else{
+ av_store(arr,i,&PL_sv_undef);
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n",
+ i
+ );
+ }
+ }
+ }else{
+ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){
+ /* Truncation occurred */
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): Placeholder '%s': data truncated at %d row.\n",
+ phs->name,i);
+ }
+ }else{
+ /* All OK. Just copy value.*/
+ }
+ if( item ){
+ switch(phs->ora_internal_type){
+ case SQLT_INT:
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): (int) set arr[%d] = %d \n",
+ i, *(int*)(phs->array_buf+phs->maxlen*i)
+ );
+ }
+ sv_setiv_mg(item,*(int*)(phs->array_buf+phs->maxlen*i));
+ break;
+ case SQLT_FLT:
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): (double) set arr[%d] = %f \n",
+ i, *(double*)(phs->array_buf+phs->maxlen*i)
+ );
+ }
+ sv_setnv_mg(item,*(double*)(phs->array_buf+phs->maxlen*i));
+ }
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ STRLEN l;
+ char *str= SvPOK(item) ? SvPV(item,l) : "<unprintable>" ;
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n",
+ i, str ? str : "<unprintable>"
+ );
+ }
+ }else{
+ switch(phs->ora_internal_type){
+ case SQLT_INT:
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): (int) store new arr[%d] = %d \n",
+ i, *(int*)(phs->array_buf+phs->maxlen*i)
+ );
+ }
+ av_store(arr,i,newSViv( *(int*)(phs->array_buf+phs->maxlen*i) ));
+ break;
+ case SQLT_FLT:
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): (double) store new arr[%d] = %f \n",
+ i, *(double*)(phs->array_buf+phs->maxlen*i)
+ );
+ }
+ av_store(arr,i,newSVnv( *(double*)(phs->array_buf+phs->maxlen*i) ));
+ }
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
+ STRLEN l;
+ char *str;
+ SV**pitem=av_fetch(arr,i,0);
+ if( pitem ){
+ item=*pitem;
+ }
+ str= item ? ( SvPOK(item) ? SvPV(item,l) : "<unprintable>" ) : "<undef>";
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n",
+ i, str ? str : "<unprintable>"
+ );
+ }
+ }
+ }
+ }
+ }
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "dbd_phs_number_table_post_exe(): scalar(@arr)=%ld.\n",
+ (long)av_len(arr)+1);
+ }
+ return 1;
+}
+
+
+
+
+static int
+dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs)
{
- /*dTHR; -- do we need to do this??? */
- SV * sth_csr = phs->sv;
- D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
- sword status;
+ dTHX;
+ STRLEN value_len;
+ int at_exec = 0;
+ at_exec = (phs->desc_h == NULL);
+
+ if (!SvPOK(phs->sv)) { /* normalizations for special cases */
+ if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
+ if (!(SvROK(phs->sv) && phs->is_inout))
+ sv_2pv(phs->sv, &PL_na);
+ }
+ else /* ensure we're at least an SVt_PV (so SvPVX etc work) */
+ (void) SvUPGRADE(phs->sv, SVt_PV);
+ }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " pp_rebind_ph_rset_in: BEGIN\n calling OCIBindByName(stmhp=%p, bndhp=%p, errhp=%p, name=%s, csrstmhp=%p, ftype=%d)\n", imp_sth->stmhp, phs->bndhp, imp_sth->errhp, phs->name, imp_sth_csr->stmhp, phs->ftype);
-
- OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
- (text*)phs->name, (sb4)strlen(phs->name),
- &imp_sth_csr->stmhp,
- 0,
- (ub2)phs->ftype, 0,
- NULL,
- 0, 0,
- NULL,
- (ub4)OCI_DEFAULT,
- status
- );
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
- return 0;
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " pp_rebind_ph_rset_in: END\n");
- return 2;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) {
+ char *val = neatsvpv(phs->sv,10);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_char() (1): bind %s <== %.1000s (", phs->name, val);
+ if (!SvOK(phs->sv))
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), "NULL, ");
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "size %ld/%ld/%ld, ",
+ (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),(long)phs->maxlen);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "ptype %d(%s), otype %d %s)\n",
+ (int)SvTYPE(phs->sv), sql_typecode_name(phs->ftype),
+ phs->ftype,(phs->is_inout) ? ", inout" : "");
+ }
+
+ /* At the moment we always do sv_setsv() and rebind. */
+ /* Later we may optimise this so that more often we can */
+ /* just copy the value & length over and not rebind. */
+
+ if (phs->is_inout) { /* XXX */
+ if (SvREADONLY(phs->sv))
+ croak("Modification of a read-only value attempted");
+ if (imp_sth->ora_pad_empty)
+ croak("Can't use ora_pad_empty with bind_param_inout");
+ if (SvTYPE(phs->sv)!=SVt_RV || !at_exec) {
+ if (phs->ftype == 96){
+ SvGROW(phs->sv,(STRLEN) (unsigned int)phs->maxlen-1);
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "Growing 96 phs sv to %ld resulted in buffer %ld\n", phs->maxlen - 1, SvLEN(phs->sv));
+ }
+ } else {
+ STRLEN min_len = 28;
+ (void)SvUPGRADE(phs->sv, SVt_PVNV);
+ /* ensure room for result, 28 is magic number (see sv_2pv) */
+ /* don't apply 28 char min to CHAR types - probably shouldn't */
+ /* apply it anywhere really, trying to be too helpful. */
+ /* phs->sv _is_ the real live variable, it may 'mutate' later */
+ /* pre-upgrade to high'ish type to reduce risk of SvPVX realloc/move */
+ /* NOTE SvGROW resets SvOOK_offset and we want to do this */
+ SvGROW(phs->sv, (STRLEN)(((unsigned int) phs->maxlen <= min_len) ? min_len : (unsigned int) phs->maxlen));
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "Growing phs sv to %ld resulted in buffer %ld\n", phs->maxlen +1, SvLEN(phs->sv));
+ }
+ }
+ }
+
+ }
+
+ /* At this point phs->sv must be at least a PV with a valid buffer, */
+ /* even if it's undef (null) */
+ /* Here we set phs->progv, phs->indp, and value_len. */
+
+ if (SvOK(phs->sv)) {
+ phs->progv = SvPV(phs->sv, value_len);
+ phs->indp = 0;
+ } else { /* it's null but point to buffer incase it's an out var */
+ phs->progv = (phs->is_inout) ? SvPVX(phs->sv) : NULL;
+ phs->indp = -1;
+ value_len = 0;
+ }
+
+
+ if (imp_sth->ora_pad_empty && value_len==0) {
+ sv_setpv(phs->sv, " ");
+ phs->progv = SvPV(phs->sv, value_len);
+ }
+
+ phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
+ if (SvTYPE(phs->sv) == SVt_RV && SvTYPE(SvRV(phs->sv)) == SVt_PVAV) { /* it is returning an array of scalars not a single scalar*/
+ phs->maxlen = 4000; /* Just make is a varchar max should be ok for most things*/
+
+ } else {
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6|| dbd_verbose >= 6 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ "Changing maxlen to %ld\n", SvLEN(phs->sv));
+ }
+ phs->maxlen = ((IV)SvLEN(phs->sv)); /* avail buffer space (64bit safe) Logicaly maxlen should never change but it does why I know not - MJE because SvGROW can allocate more than you ask for - anyway - I fixed that and it doesn't grow anymore */
+
+ }
+
+
+ if (phs->maxlen < 0) /* can happen with nulls */
+ phs->maxlen = 0;
+
+ phs->alen = value_len + phs->alen_incnull;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
+ /*UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;*/
+ char *val = neatsvpv(phs->sv,10);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph_char() (2): bind %s <== %.1000s (size %ld/%ld, "
+ "otype %d(%s), indp %d, at_exec %d)\n",
+ phs->name,
+ (phs->progv) ? val: "",
+ (long)phs->alen, (long)phs->maxlen,
+ phs->ftype,sql_typecode_name(phs->ftype), phs->indp, at_exec);
+ }
+
+ return 1;
}
-#endif
+/*
+* Rebind an "in" cursor ref to its real statement handle
+* This allows passing cursor refs as "in" to pl/sql (but only if you got the
+* cursor from pl/sql to begin with)
+*/
int
-pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
+pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
- if (pre_exec) { /* pre-execute - allocate a statement handle */
- dSP;
- D_imp_dbh_from_sth;
- SV *sth_i;
- HV *init_attr = newHV();
- int count;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name);
-#ifdef OCI_V8_SYNTAX
- /* extproc deallocates everything for us */
- if (is_extproc) return 1;
-
- {
+ dTHX;
+ dTHR;
+ SV * sth_csr = phs->sv;
+ D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
sword status;
- if (!phs->desc_h || 1) { /* XXX phs->desc_t != OCI_HTYPE_STMT) { */
- if (phs->desc_h) {
- OCIHandleFree_log_stat(phs->desc_h, phs->desc_t, status);
- phs->desc_h = NULL;
- }
- phs->desc_t = OCI_HTYPE_STMT;
- OCIHandleAlloc_ok(imp_sth->envhp, &phs->desc_h, phs->desc_t, status);
- }
- phs->progv = (void*)&phs->desc_h;
- phs->maxlen = 0;
- OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
- (text*)phs->name, (sb4)strlen(phs->name),
- phs->progv, 0,
- (ub2)phs->ftype, 0, /* using &phs->indp triggers ORA-01001 errors! */
- NULL, 0, 0, NULL, OCI_DEFAULT, status);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " pp_rebind_ph_rset_in: BEGIN\n calling OCIBindByName(stmhp=%p, "
+ "bndhp=%p, errhp=%p, name=%s, csrstmhp=%p, ftype=%d)\n",
+ imp_sth->stmhp, phs->bndhp, imp_sth->errhp, phs->name,
+ imp_sth_csr->stmhp, phs->ftype);
+
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ &imp_sth_csr->stmhp,
+ 0,
+ (ub2)phs->ftype, 0,
+ NULL,
+ 0, 0,
+ NULL,
+ (ub4)OCI_DEFAULT,
+ status
+ );
+
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
+ return 0;
}
- }
-#else
- {
- Cda_Def *cda;
- assert(phs->ftype == 102); /* SQLT_CUR */
- Newz(0, cda, 1, Cda_Def);
- if (oopen(cda, imp_dbh->lda, (text*)0, -1, -1, (text*)0, -1)) {
- ora_error(sth, cda, cda->rc, "oopen error for cursor");
- Safefree(cda);
- return 0;
- }
- if (obndra(imp_sth->cda, (text *)phs->name, -1,
- (ub1*)cda, (sword)-1, /* cast reduces max size */
- (sword)phs->ftype, -1, 0, 0, &phs->arcode, 0, (ub4 *)0, (text *)0, -1, -1)
- ) {
- D_imp_dbh_from_sth;
- ora_error(sth, imp_dbh->lda, imp_sth->cda->rc, "obndra failed for cursor");
- Safefree(cda);
- return 0;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " pp_rebind_ph_rset_in: END\n");
+
+ return 2;
+}
+
+
+int
+pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
+{
+ dTHX;
+
+ if (pre_exec) { /* pre-execute - throw away previous descriptor and rebind */
+ sword status;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " pp_exec_rset bind %s - allocating new sth...\n",
+ phs->name);
+
+ /* extproc deallocates everything for us */
+ if (is_extproc)
+ return 1;
+
+ if (!phs->desc_h || 1) { /* XXX phs->desc_t != OCI_HTYPE_STMT) */
+ if (phs->desc_h) {
+ OCIHandleFree_log_stat(imp_sth, phs->desc_h, phs->desc_t, status);
+ phs->desc_h = NULL;
+ }
+ phs->desc_t = OCI_HTYPE_STMT;
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t, status);
+ }
+
+ phs->progv = (char*)&phs->desc_h;
+ phs->maxlen = 0;
+
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name,
+ (sb4)strlen(phs->name),
+ phs->progv,
+ 0,
+ (ub2)phs->ftype,
+ /* I, MJE have no evidence that passing an indicator to this func
+ causes ORA-01001 (invalid cursor) errors. Also, without it
+ you cannot test the indicator to check we have a valid output
+ parameter. However, it would seem when you do specify an
+ indicator it always comes back as 0 so it is useless. */
+ NULL, /* using &phs->indp triggers ORA-01001 errors! */
+ NULL,
+ 0,
+ 0,
+ NULL,
+ OCI_DEFAULT,
+ status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
+ return 0;
+ }
+
+ /*
+ NOTE: The code used to magic a DBI stmt handle into existence
+ here before even knowing if the output parameter was going to
+ be a valid open cursor. The code to do this moved to post execute
+ below. See RT 82663 - Errors if a returned SYS_REFCURSOR is not opened
+ */
}
- phs->progv = (void*)cda;
- phs->maxlen = -1;
- }
-#endif
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh))));
- XPUSHs(sv_2mortal(newRV((SV*)init_attr)));
- PUTBACK;
- count = perl_call_pv("DBI::_new_sth", G_ARRAY);
- SPAGAIN;
- if (count != 2)
- croak("panic: DBI::_new_sth returned %d values instead of 2", count);
- sth_i = POPs; /* discard inner handle */
- sv_setsv(phs->sv, POPs); /* save outer handle */
- SvREFCNT_dec(init_attr);
- PUTBACK;
- FREETMPS;
- LEAVE;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - allocated %s...\n",
- phs->name, neatsvpv(phs->sv, 0));
+ else { /* post-execute - setup the statement handle */
+ dTHR;
+ dSP;
+ D_imp_dbh_from_sth;
+ HV *init_attr = newHV();
+ int count;
+ ub4 stmt_state = 99;
+ sword status;
+ SV * sth_csr;
+
+ /* Before we go to the bother of attempting to allocate a new sth
+ for this cursor make sure the Oracle sth is executed i.e.,
+ the returned cursor may never have been opened */
+ OCIAttrGet_stmhp_stat2(imp_sth, (OCIStmt*)phs->desc_h, &stmt_state, 0,
+ OCI_ATTR_STMT_STATE, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_STMT_STATE");
+ return 0;
+ }
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
+ /* initialized=1, executed=2, end of fetch=3 */
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " returned cursor/statement state: %u\n", stmt_state);
+ }
- }
- else { /* post-execute - setup the statement handle */
- dTHR;
- SV * sth_csr = phs->sv;
- D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
+ /* We seem to get an indp of 0 even for a cursor which was never
+ opened and set to NULL. If this is the case we check the stmt state
+ and find the cursor is initialized but not executed - there is no
+ point in going any further if it is not executed - just return undef.
+ See RT 82663 */
+ if (stmt_state == OCI_STMT_STATE_INITIALIZED) {
+ OCIHandleFree_log_stat(imp_sth, (OCIStmt *)phs->desc_h,
+ OCI_HTYPE_STMT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
+ return 0;
+ }
+ phs->desc_h = NULL;
+ phs->sv = newSV(0); /* undef */
+ return 1;
+ }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - initialising new %s for cursor 0x%lx...\n",
- phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv);
+ /* Now we know we have an executed cursor create a new sth */
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh))));
+ XPUSHs(sv_2mortal(newRV((SV*)init_attr)));
+ PUTBACK;
+ count = perl_call_pv("DBI::_new_sth", G_ARRAY);
+ SPAGAIN;
+
+ if (count != 2)
+ croak("panic: DBI::_new_sth returned %d values instead of 2", count);
+
+ (void)POPs; /* discard inner handle */
+ sv_setsv(phs->sv, POPs); /* save outer handle */
+ SvREFCNT_dec(init_attr);
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " pp_exec_rset bind %s - allocated %s...\n",
+ phs->name, neatsvpv(phs->sv, 0));
+
+ sth_csr = phs->sv;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " bind %s - initialising new %s for cursor 0x%lx...\n",
+ phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv);
+
+ {
+ D_impdata(imp_sth_csr, imp_sth_t, sth_csr); /* TO_DO */
+
+ /* copy appropriate handles and atributes from parent statement */
+ imp_sth_csr->envhp = imp_sth->envhp;
+ imp_sth_csr->errhp = imp_sth->errhp;
+ imp_sth_csr->srvhp = imp_sth->srvhp;
+ imp_sth_csr->svchp = imp_sth->svchp;
+ imp_sth_csr->auto_lob = imp_sth->auto_lob;
+ imp_sth_csr->pers_lob = imp_sth->pers_lob;
+ imp_sth_csr->clbk_lob = imp_sth->clbk_lob;
+ imp_sth_csr->piece_size = imp_sth->piece_size;
+ imp_sth_csr->piece_lob = imp_sth->piece_lob;
+ imp_sth_csr->is_child = 1; /*no prefetching on a cursor or sp*/
+
+
+ /* assign statement handle from placeholder descriptor */
+ imp_sth_csr->stmhp = (OCIStmt*)phs->desc_h;
+ phs->desc_h = NULL; /* tell phs that we own it now */
+
+ /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */
+ imp_sth_csr->stmt_type = OCI_STMT_SELECT;
+ DBIc_IMPSET_on(imp_sth_csr);
+
+ /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */
+ DBIc_ACTIVE_on(imp_sth_csr);
+ if (!dbd_describe(sth_csr, imp_sth_csr)) {
+ return 0;
+ }
+ }
+ }
-#ifdef OCI_V8_SYNTAX
- /* copy appropriate handles from parent statement */
- imp_sth_csr->envhp = imp_sth->envhp;
- imp_sth_csr->errhp = imp_sth->errhp;
- imp_sth_csr->srvhp = imp_sth->srvhp;
- imp_sth_csr->svchp = imp_sth->svchp;
+ return 1;
- /* assign statement handle from placeholder descriptor */
- imp_sth_csr->stmhp = phs->desc_h;
- phs->desc_h = NULL; /* tell phs that we own it now */
+}
- /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */
- imp_sth_csr->stmt_type = OCI_STMT_SELECT;
-#else
+static int
+dbd_rebind_ph_xml( SV* sth, imp_sth_t *imp_sth, phs_t *phs) {
+dTHX;
+dTHR;
+OCIType *tdo = NULL;
+sword status;
+ SV* ptr;
- imp_sth_csr->cda = (void*)phs->progv;
- imp_sth_csr->cda->ft = 4; /* persuade dbd_describe it's a SELECT */
- phs->progv = NULL; /* tell phs that we own it now */
-#endif
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " in dbd_rebind_ph_xml\n");
+
+/*go and create the XML dom from the passed in value*/
+
+ phs->sv=createxmlfromstring(sth, imp_sth, phs->sv );
- DBIc_IMPSET_on(imp_sth_csr);
+ if (phs->is_inout)
+ croak("OUT binding for NTY is currently unsupported");
+
+ /* ensure that the value is a support named object type */
+ /* (currently only OCIXMLType*) */
+ if ( sv_isa(phs->sv, "OCIXMLTypePtr") ) {
+ /* TO_DO not logging: */
+ OCITypeByName_log(
+ imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ imp_sth->svchp,
+ (CONST text*)"SYS", 3, /* schema_name, schema_length */
+ (CONST text*)"XMLTYPE", 7, /* type_name, type_length */
+ (CONST text*)0, 0, /* version_name, version_length */
+ OCI_DURATION_CALLOUT, /* pin_duration */
+ OCI_TYPEGET_HEADER, /* get_option */
+ &tdo, /* tdo */
+ status);
+ ptr = SvRV(phs->sv);
+ phs->progv = (void*) SvIV(ptr);
+ phs->maxlen = sizeof(OCIXMLType*);
+ }
+ else
+ croak("Unsupported named object type for bind parameter");
+
+
+ /* bind by name */
+
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ (dvoid *) NULL, /* value supplied in BindObject later */
+ 0,
+ (ub2)phs->ftype, 0,
+ NULL,
+ 0, 0,
+ NULL,
+ (ub4)OCI_DEFAULT,
+ status
+ );
- /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */
- DBIc_ACTIVE_on(imp_sth_csr);
- if (!dbd_describe(sth_csr, imp_sth_csr)) {
- return 0;
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY");
+ return 0;
}
-#ifndef OCI_V8_SYNTAX
- imp_sth_csr->cda->rpc= 0; /* nothing already fetched into cache */
-#endif
- }
- return 1;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " pp_rebind_ph_nty: END\n");
+
+
+ /* bind the object */
+ OCIBindObject(phs->bndhp, imp_sth->errhp,
+ (CONST OCIType*)tdo,
+ (dvoid **)&phs->progv,
+ (ub4*)NULL,
+ (dvoid **)NULL,
+ (ub4*)NULL);
+
+ return 2;
}
-#ifndef OCI_V8_SYNTAX
-static int
-dbd_rebind_ph_cursor(sth, imp_sth, phs)
- SV *sth;
- imp_sth_t *imp_sth;
- phs_t *phs;
+static int
+dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
- assert(phs->ftype == 102);
- phs->out_prepost_exec = pp_exec_rset;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s to cursor (at execute)\n", phs->name);
- return 2;
-}
-#endif
+ dTHX;
+ /*ub2 *alen_ptr = NULL;*/
+ sword status;
+ int done = 0;
+ int at_exec;
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ ub1 csform;
+ ub2 csid;
+
+ if (trace_level >= 5 || dbd_verbose >= 5 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph() (1): rebinding %s as %s (%s, ftype %d (%s), "
+ "csid %d, csform %d(%s), inout %d)\n",
+ phs->name, (SvPOK(phs->sv) ? neatsvpv(phs->sv,10) : "NULL"),
+ (SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
+ phs->ftype,sql_typecode_name(phs->ftype), phs->csid, phs->csform,
+ oci_csform_name(phs->csform), phs->is_inout);
+
+ switch (phs->ftype) {
+ case ORA_VARCHAR2_TABLE:
+ done = dbd_rebind_ph_varchar2_table(sth, imp_sth, phs);
+ break;
+ case ORA_NUMBER_TABLE:
+ done = dbd_rebind_ph_number_table(sth, imp_sth, phs);
+ break;
+ case SQLT_CLOB:
+ case SQLT_BLOB:
+ done = dbd_rebind_ph_lob(sth, imp_sth, phs);
+ break;
+ case SQLT_RSET:
+ done = dbd_rebind_ph_rset(sth, imp_sth, phs);
+ break;
+ case ORA_XMLTYPE:
+ done = dbd_rebind_ph_xml(sth, imp_sth, phs);
+ break;
+ default:
+ done = dbd_rebind_ph_char(imp_sth, phs);
+ }
+ if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself successfully */
+ if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " rebind %s done with ftype %d (%s)\n",
+ phs->name, phs->ftype,sql_typecode_name(phs->ftype));
+ return 1;
+ }
+ if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " bind %s as ftype %d (%s)\n",
+ phs->name, phs->ftype,sql_typecode_name(phs->ftype));
+ if (done != 1) {
+ return 0; /* the rebind failed */
+ }
-static int
-dbd_rebind_ph(sth, imp_sth, phs)
- SV *sth;
- imp_sth_t *imp_sth;
- phs_t *phs;
-{
- ub2 *alen_ptr = NULL;
- int done = 0;
-
- switch (phs->ftype) {
-#ifdef OCI_V8_SYNTAX
- case SQLT_CLOB:
- case SQLT_BLOB:
- done = dbd_rebind_ph_lob(sth, imp_sth, phs);
- break;
- case SQLT_RSET:
- done = dbd_rebind_ph_rset(sth, imp_sth, phs);
- break;
-#else
- case 102: /* SQLT_CUR */
- done = dbd_rebind_ph_cursor(sth, imp_sth, phs);
- break;
-#endif
- default:
- done = dbd_rebind_ph_char(sth, imp_sth, phs, &alen_ptr);
- }
- if (done != 1) {
- if (done == 2) { /* the rebind did the OCI bind call itself successfully */
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s done with ftype %d\n",
- phs->name, phs->ftype);
- return 1;
- }
- return 0; /* the rebind failed */
- }
+ at_exec = (phs->desc_h == NULL);
-#ifdef OCI_V8_SYNTAX
- if (phs->maxlen > phs->maxlen_bound) {
- sword status;
- int at_exec = (phs->desc_h == NULL);
- OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
phs->progv,
phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */
@@ -1264,234 +3004,388 @@ dbd_rebind_ph(sth, imp_sth, phs)
status
);
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
}
if (at_exec) {
- OCIBindDynamic_log(phs->bndhp, imp_sth->errhp,
+ OCIBindDynamic_log(imp_sth, phs->bndhp, imp_sth->errhp,
(dvoid *)phs, dbd_phs_in,
(dvoid *)phs, dbd_phs_out, status);
- if (status != OCI_SUCCESS) {
+
+ if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
return 0;
- }
}
- }
+ }
-#else
- /* Since we don't support LONG VAR types we must check */
- /* for lengths too big to pass to obndrv as an sword. */
- if (phs->maxlen > MINSWORDMAXVAL && sizeof(sword)<4) /* generally 32K */
- croak("Can't bind %s, value is too long (%ld bytes, max %d)",
- phs->name, phs->maxlen, MINSWORDMAXVAL);
-
- {
- sword progvl = (alen_ptr) ? phs->maxlen : SvCUR(phs->sv);
- if (obndra(imp_sth->cda, (text *)phs->name, -1,
- (ub1*)phs->progv, (progvl) ? progvl : 1,
- (sword)phs->ftype, -1,
- &phs->indp, alen_ptr, &phs->arcode,
- 0, (ub4 *)0,
- (text *)0, -1, -1)) {
- D_imp_dbh_from_sth;
- ora_error(sth, imp_dbh->lda, imp_sth->cda->rc, "obndra failed");
- return 0;
- }
- }
-#endif
- phs->maxlen_bound = phs->maxlen ? phs->maxlen : 1;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s done with ftype %d\n",
- phs->name, phs->ftype);
- return 1;
+ /* some/all of the following should perhaps move into dbd_phs_in() */
+
+ csform = phs->csform;
+
+ if (!csform && SvUTF8(phs->sv)) {
+ /* try to default csform to avoid translation through non-unicode */
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */
+ csform = SQLCS_IMPLICIT;
+ else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR))
+ csform = SQLCS_NCHAR; /* else leave csform == 0 */
+ if (trace_level || dbd_verbose >= 3)
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph() (2): rebinding %s with UTF8 value %s", phs->name,
+ (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are unicode\n");
+ }
+
+ if (csform) {
+ /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)"));
+ return 0;
+ }
+ }
+
+ if (!phs->csid_orig) { /* get the default csid Oracle would use */
+ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 ,
+ OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ }
+
+ /* if app has specified a csid then use that, else use default */
+ csid = (phs->csid) ? phs->csid : phs->csid_orig;
+
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ if (SvUTF8(phs->sv) && !CS_IS_UTF8(csid))
+ csid = utf8_csid; /* not al32utf8_csid here on purpose */
+
+ if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_rebind_ph(): bind %s <== %s "
+ "(%s, %s, csid %d->%d->%d, ftype %d (%s), csform %d(%s)->%d(%s), "
+ "maxlen %lu, maxdata_size %lu)\n",
+ phs->name, neatsvpv(phs->sv,10),
+ (phs->is_inout) ? "inout" : "in",
+ (SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
+ phs->csid_orig, phs->csid, csid,
+ phs->ftype, sql_typecode_name(phs->ftype), phs->csform,
+ oci_csform_name(phs->csform), csform, oci_csform_name(csform),
+ (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
+
+ if (csid) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)"));
+ return 0;
+ }
+ }
+
+ if (phs->maxdata_size) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ neatsvpv(phs->sv,0), (ub4)phs->maxdata_size, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)"));
+ return 0;
+ }
+ }
+
+ return 1;
}
int
-dbd_bind_ph(sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen)
- SV *sth;
- imp_sth_t *imp_sth;
- SV *ph_namesv;
- SV *newvalue;
- IV sql_type;
- SV *attribs;
- int is_inout;
- IV maxlen;
+dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue, IV sql_type, SV *attribs, int is_inout, IV maxlen)
{
- SV **phs_svp;
- STRLEN name_len;
- char *name = Nullch;
- char namebuf[30];
- phs_t *phs;
-
- /* check if placeholder was passed as a number */
-
- if (SvGMAGICAL(ph_namesv)) /* eg if from tainted expression */
- mg_get(ph_namesv);
- if (!SvNIOKp(ph_namesv)) {
- name = SvPV(ph_namesv, name_len);
- }
- if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
- sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
- name = namebuf;
- name_len = strlen(name);
- }
- assert(name != Nullch);
-
- if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue))
- /* dbi handle allowed for cursor variables */
- croak("Can't bind a reference (%s)", neatsvpv(newvalue,0));
- if (SvTYPE(newvalue) > SVt_PVLV) /* hook for later array logic? */
- croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
- if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */
- croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
-
- if (DBIS->debug >= 2) {
- PerlIO_printf(DBILOGFP, " bind %s <== %s (type %ld",
- name, neatsvpv(newvalue,0), (long)sql_type);
- if (is_inout)
- PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld",
- (long)newvalue, (long)maxlen);
- if (attribs)
- PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0));
- PerlIO_printf(DBILOGFP, ")\n");
- }
+ dTHX;
+ SV **phs_svp;
+ STRLEN name_len;
+ char *name = Nullch;
+ char namebuf[32];
+ phs_t *phs;
+
+ /* check if placeholder was passed as a number */
+ if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */
+ mg_get(ph_namesv);
+
+ if (!SvNIOKp(ph_namesv)) {
+ STRLEN i;
+ name = SvPV(ph_namesv, name_len);
+ if (name_len > sizeof(namebuf)-1)
+ croak("Placeholder name %s too long", neatsvpv(ph_namesv,0));
+
+ for (i=0; i<name_len; i++) namebuf[i] = toLOWER(name[i]);
+ namebuf[i] = '\0';
+ name = namebuf;
+ }
+
+ if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
+ sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
+ name = namebuf;
+ name_len = strlen(name);
+ }
+
+ assert(name != Nullch);
+
+ if (SvROK(newvalue)
+ && !IS_DBI_HANDLE(newvalue) /* dbi handle allowed for cursor variables */
+ && !SvAMAGIC(newvalue) /* overload magic allowed (untested) */
+ && !sv_derived_from(newvalue, "OCILobLocatorPtr" ) /* input LOB locator*/
+ && !(SvTYPE(SvRV(newvalue))==SVt_PVAV) /* Allow array binds */
+ )
+ croak("Can't bind a reference (%s)", neatsvpv(newvalue,0));
+
+ if (SvTYPE(newvalue) > SVt_PVAV) /* Array binding supported */
+ croak("Can't bind a non-scalar, non-array value (%s)", neatsvpv(newvalue,0));
+ if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */
+ croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), "dbd_bind_ph(1): bind %s <== %s (type %ld (%s)",
+ name, neatsvpv(newvalue,0), (long)sql_type,sql_typecode_name(sql_type));
+ if (is_inout)
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), ", inout 0x%lx, maxlen %ld",
+ (long)newvalue, (long)maxlen);
+ if (attribs)
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), ", attribs: %s", neatsvpv(attribs,0));
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), ")\n");
+ }
+
+ phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
+
+
+ if (phs_svp == NULL)
+ croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
+
+ /* This value is not a string, but a binary structure phs_st instead. */
+ phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
+
+ if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */
+ phs->is_inout = is_inout;
+ if (is_inout) {
+ /* phs->sv assigned in the code below */
+ ++imp_sth->has_inout_params;
+ /* build array of phs's so we can deal with out vars fast */
+ if (!imp_sth->out_params_av)
+ imp_sth->out_params_av = newAV();
+ av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
+ }
+
+ /*
+ * Init number of bound array entries to zero.
+ * If "ora_maxarray_numentries" bind parameter specified,
+ * it would be set below.
+ *
+ * If no ora_maxarray_numentries specified, let it be
+ * the same as scalar(@array) bound (see dbd_rebind_ph_varchar2_table() ).
+ */
+ phs->array_numstruct=0;
+
+ if (attribs) { /* only look for ora_type on first bind of var */
+ SV **svp;
+ /* Setup / Clear attributes as defined by attribs. */
+ /* XXX If attribs is EMPTY then reset attribs to default? */
+
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_type",8, 0)) != NULL) {
+ int ora_type = SvIV(*svp);
+ if (!oratype_bind_ok(ora_type))
+ croak("Can't bind %s, ora_type %d not supported by DBD::Oracle", phs->name, ora_type);
+ if (sql_type)
+ croak("Can't specify both TYPE (%"IVdf") and ora_type (%d) for %s", sql_type, ora_type, phs->name);
+ phs->ftype = ora_type;
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_field",9, 0)) != NULL) {
+ phs->ora_field = SvREFCNT_inc(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_csform", 10, 0)) != NULL) {
+ if (SvIV(*svp) == SQLCS_IMPLICIT || SvIV(*svp) == SQLCS_NCHAR)
+ phs->csform = (ub1)SvIV(*svp);
+ else warn("ora_csform must be 1 (SQLCS_IMPLICIT) or 2 (SQLCS_NCHAR), not %"IVdf"", SvIV(*svp));
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0)) != NULL) {
+ phs->maxdata_size = SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries", 23, 0)) != NULL) {
+ phs->ora_maxarray_numentries=SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0)) != NULL) {
+ phs->ora_internal_type=SvUV(*svp);
+ }
+ }
+
- phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
- if (phs_svp == NULL)
- croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
- phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
-
- if (phs->sv == &sv_undef) { /* first bind for this placeholder */
- phs->is_inout = is_inout;
- if (is_inout) {
- /* phs->sv assigned in the code below */
- ++imp_sth->has_inout_params;
- /* build array of phs's so we can deal with out vars fast */
- if (!imp_sth->out_params_av)
- imp_sth->out_params_av = newAV();
- av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
- }
-
- if (attribs) { /* only look for ora_type on first bind of var */
- SV **svp;
- /* Setup / Clear attributes as defined by attribs. */
- /* XXX If attribs is EMPTY then reset attribs to default? */
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_type",8, 0)) != NULL) {
- int ora_type = SvIV(*svp);
- if (!oratype_bind_ok(ora_type))
- croak("Can't bind %s, ora_type %d not supported by DBD::Oracle",
- phs->name, ora_type);
if (sql_type)
- croak("Can't specify both TYPE (%d) and ora_type (%d) for %s",
- sql_type, ora_type, phs->name);
- phs->ftype = ora_type;
- }
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_field",9, 0)) != NULL) {
- phs->ora_field = SvREFCNT_inc(*svp);
- }
- }
- if (sql_type)
- phs->ftype = ora_sql_type(imp_sth, phs->name, (int)sql_type);
-
-#ifndef OCI_V8_SYNTAX
- /* treat Oracle8 LOBS as simple LONGs for Oracle7 */
- if (phs->ftype==112 || phs->ftype==113)
- phs->ftype = 8;
- /* treat Oracle8 SQLT_RSET as SQLT_CUR for Oracle7 */
- if (phs->ftype==116)
- phs->ftype = 102;
-#else
+ phs->ftype = ora_sql_type(imp_sth, phs->name, (int)sql_type);
/* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
- if (phs->ftype==102)
- phs->ftype = 116;
-#endif
+ if (phs->ftype==102)
+ phs->ftype = ORA_RSET;
/* some types require the trailing null included in the length. */
/* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */
- phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC);
+ phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC);
- } /* was first bind for this placeholder */
+ } /* was first bind for this placeholder */
/* check later rebinds for any changes */
- else if (is_inout != phs->is_inout) {
- croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)",
- phs->name, phs->is_inout , is_inout);
- }
- else if (sql_type && phs->ftype != ora_sql_type(imp_sth, phs->name, (int)sql_type)) {
- croak("Can't change TYPE of param %s to %d after initial bind",
- phs->name, sql_type);
- }
+ else if (is_inout != phs->is_inout) {
+ croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)",
+ phs->name, phs->is_inout , is_inout);
- phs->maxlen = maxlen; /* 0 if not inout */
+ }
+ else if (sql_type && phs->ftype != ora_sql_type(imp_sth, phs->name, (int)sql_type)) {
+ croak("Can't change TYPE of param %s to %"IVdf" after initial bind",
+ phs->name, sql_type);
- if (!is_inout) { /* normal bind so take a (new) copy of current value */
- if (phs->sv == &sv_undef) /* (first time bind) */
- phs->sv = newSV(0);
- sv_setsv(phs->sv, newvalue);
- }
- else if (newvalue != phs->sv) {
- if (phs->sv)
- SvREFCNT_dec(phs->sv);
- phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
- }
+ }
+ /* Array binding is supported for a limited number of data types. */
+
+ if( SvROK(newvalue) ){
+ if( SvTYPE(SvRV(newvalue))==SVt_PVAV ){
+ if( (phs->ftype == ORA_VARCHAR2_TABLE) ||
+ (phs->ftype == ORA_NUMBER_TABLE) ||
+ (phs->ftype == 1)) /*ORA_VARCHAR2*/ {
+ /* Supported */
+
+ /* Reload array-size-related attributes */
+ if (attribs) {
+ SV **svp;
+
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0)) != NULL) {
+ phs->maxdata_size = SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries", 23, 0)) != NULL) {
+ phs->ora_maxarray_numentries=SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0)) != NULL) {
+ phs->ora_internal_type=SvUV(*svp);
+ }
+ }
+ }
+ else{
+ /* All the other types are not supported */
+ croak("Array bind is supported only for ORA_%%_TABLE types. Unable to bind '%s'.",phs->name);
+ }
+ }
+ }
+
+ /* Add checks for other reference types here ? */
+
+ phs->maxlen = maxlen; /* 0 if not inout */
+
+ if (!is_inout) { /* normal bind so take a (new) copy of current value */
+ if (phs->sv == &PL_sv_undef) /* (first time bind) */
+ phs->sv = newSV(0);
+ sv_setsv(phs->sv, newvalue);
+ if (SvAMAGIC(phs->sv)) /* overloaded. XXX hack, logic ought to be pushed deeper */
+ sv_pvn_force(phs->sv, &PL_na);
+ } else {
+ if (newvalue != phs->sv) {
+ if (phs->sv)
+ SvREFCNT_dec(phs->sv);
+
+ phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
+ }
+ /* Add space for NUL - do it now rather than in rebind as it cause problems
+ in rebind where maxlen continually grows. */
+ phs->maxlen = phs->maxlen + 1;
+ }
- return dbd_rebind_ph(sth, imp_sth, phs);
+ return dbd_rebind_ph(sth, imp_sth, phs);
}
/* --- functions to 'complete' the fetch of a value --- */
void
-dbd_phs_sv_complete(phs_t *phs, SV *sv, I32 debug)
+dbd_phs_sv_complete(imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug)
{
- /* XXX doesn't check arcode for error, caller is expected to */
- if (phs->indp == 0) { /* is okay */
-#ifdef UTF8_SUPPORT
- SvPOK_only_UTF8(sv);
+ dTHX;
+ char *note = "";
+ /* XXX doesn't check arcode for error, caller is expected to */
+
+ if (phs->indp == 0) { /* is okay */
+
+ if (phs->is_inout && phs->alen == SvLEN(sv)) {
+
+ /* if the placeholder has not been assigned to then phs->alen */
+ /* is left untouched: still set to SvLEN(sv). If we use that */
+ /* then we'll get garbage bytes beyond the original contents. */
+ phs->alen = SvCUR(sv);
+ note = " UNTOUCHED?";
+ }
+
+ if (SvPVX(sv)) {
+ SvCUR_set(sv, phs->alen);
+ *SvEND(sv) = '\0';
+ SvPOK_only_UTF8(sv);
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) {
+#ifdef sv_utf8_decode
+ sv_utf8_decode(sv);
#else
- SvPOK_only(sv);
+ SvUTF8_on(sv);
#endif
- SvCUR_set(sv, phs->alen);
- *SvEND(sv) = '\0';
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " out %s = %s (arcode %d, ind %d, len %d)\n",
- phs->name, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen);
- }
- else
- if (phs->indp > 0 || phs->indp == -2) { /* truncated */
-#ifdef UTF8_SUPPORT
- SvPOK_only_UTF8(sv);
+ }
+ }
+ else { /* shouldn't happen */
+ debug = 2;
+ dbd_verbose =3;
+ note = " [placeholder has no data buffer]";
+ }
+
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP, " out %s = %s (arcode %d, ind %d, len %d)%s\n",
+ phs->name, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen, note);
+ }
+ else {
+ if (phs->indp > 0 || phs->indp == -2) { /* truncated */
+ if (SvPVX(sv)) {
+ SvCUR_set(sv, phs->alen);
+ *SvEND(sv) = '\0';
+ SvPOK_only_UTF8(sv);
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) {
+#ifdef sv_utf8_decode
+ sv_utf8_decode(sv);
#else
- SvPOK_only(sv);
+ SvUTF8_on(sv);
#endif
- SvCUR(sv) = phs->alen;
- *SvEND(sv) = '\0';
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " out %s = %s\t(TRUNCATED from %d to %ld, arcode %d)\n",
- phs->name, neatsvpv(sv,0), phs->indp, (long)phs->alen, phs->arcode);
- }
- else
- if (phs->indp == -1) { /* is NULL */
- (void)SvOK_off(phs->sv);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " out %s = undef (NULL, arcode %d)\n",
- phs->name, phs->arcode);
- }
- else
- croak("panic dbd_phs_sv_complete: %s bad indp %d, arcode %d", phs->name, phs->indp, phs->arcode);
+ }
+ }
+ else { /* shouldn't happen */
+ debug = 2;
+ dbd_verbose =3;
+ note = " [placeholder has no data buffer]";
+ }
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP,
+ " out %s = %s\t(TRUNCATED from %d to %ld, arcode %d)%s\n",
+ phs->name, neatsvpv(sv,0), phs->indp, (long)phs->alen, phs->arcode, note);
+ }
+ else {
+ if (phs->indp == -1) { /* is NULL */
+ (void)SvOK_off(phs->sv);
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP,
+ " out %s = undef (NULL, arcode %d)\n",
+ phs->name, phs->arcode);
+ }
+ else {
+ croak("panic dbd_phs_sv_complete: %s bad indp %d, arcode %d", phs->name, phs->indp, phs->arcode);
+ }
+ }
+ }
}
-
void
-dbd_phs_avsv_complete(phs_t *phs, I32 index, I32 debug)
+dbd_phs_avsv_complete(imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug)
{
- AV *av = (AV*)SvRV(phs->sv);
- SV *sv = *av_fetch(av, index, 1);
- dbd_phs_sv_complete(phs, sv, 0);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n",
+ dTHX;
+ AV *av = (AV*)SvRV(phs->sv);
+ SV *sv = *av_fetch(av, index, 1);
+ dbd_phs_sv_complete(imp_sth, phs, sv, 0);
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " dbd_phs_avsv_complete out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n",
phs->name, (long)index, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen);
}
@@ -1500,659 +3394,1183 @@ dbd_phs_avsv_complete(phs_t *phs, I32 index, I32 debug)
int
-dbd_st_execute(sth, imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */
- SV *sth;
- imp_sth_t *imp_sth;
+dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */
{
- dTHR;
- ub4 row_count = 0;
- int debug = DBIS->debug;
- int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0;
+ dTHR;
+ dTHX;
+ ub4 row_count = 0;
+ int debug = DBIc_DBISTATE(imp_sth)->debug;
+ int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0;
+ D_imp_dbh_from_sth;
+ sword status;
+ int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
-#ifdef OCI_V8_SYNTAX
- D_imp_dbh_from_sth;
- sword status;
- int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
- oci_stmt_type_name(imp_sth->stmt_type), outparams, imp_sth->has_lobs);
-#else
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_execute %s (out%d, lob%d)...\n",
+ oci_stmt_type_name(imp_sth->stmt_type), outparams, imp_sth->has_lobs);
+
+ /* Don't attempt execute for nested cursor. It would be meaningless,
+ and Oracle code has been seen to core dump */
+ if (imp_sth->nested_cursor) {
+ oci_error(sth, NULL, OCI_ERROR,
+ "explicit execute forbidden for nested cursor");
+ return -2;
+ }
+
+
+ if (outparams) { /* check validity of bind_param_inout SV's */
+ int i = outparams;
+ while(--i >= 0) {
+ phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
+ /* Make sure we have the value in string format. Typically a number */
+ /* will be converted back into a string using the same bound buffer */
+ /* so the progv test below will not trip. */
+
+ /* is the value a null? */
+ phs->indp = (SvOK(sv)) ? 0 : -1;
+
+ if (phs->out_prepost_exec) {
+ if (!phs->out_prepost_exec(sth, imp_sth, phs, 1))
+ return -2; /* out_prepost_exec already called ora_error() */
+ }
+ else
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " with %s = [] (len %ld/%ld, indp %d, otype %d, ptype %d)\n",
+ phs->name,
+ (long)phs->alen, (long)phs->maxlen, phs->indp,
+ phs->ftype, (int)SvTYPE(sv));
+ av_clear((AV*)SvRV(sv));
+ }
+ else
+ /* Some checks for mutated storage since we pointed oracle at it. */
+ if (SvTYPE(sv) != phs->sv_type
+ || (SvOK(sv) && !SvPOK(sv))
+ /* SvROK==!SvPOK so cursor (SQLT_CUR) handle will call dbd_rebind_ph */
+ /* that suits us for now */
+ || SvPVX(sv) != phs->progv
+ || (SvPOK(sv) && SvCUR(sv) > UB2MAXVAL)
+ ) {
+ if (!dbd_rebind_ph(sth, imp_sth, phs))
+ croak("Can't rebind placeholder %s", phs->name);
+ }
+ else {
+ /* String may have grown or shrunk since it was bound */
+ /* so tell Oracle about it's current length */
+ ub2 prev_alen = phs->alen;
+ phs->alen = (SvOK(sv)) ? SvCUR(sv) + phs->alen_incnull : 0+phs->alen_incnull;
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " with %s = '%.*s' (len %ld(%ld)/%ld, indp %d, "
+ "otype %d, ptype %d)\n",
+ phs->name, (int)phs->alen,
+ (phs->indp == -1) ? "" : SvPVX(sv),
+ (long)phs->alen, (long)prev_alen,
+ (long)phs->maxlen, phs->indp,
+ phs->ftype, (int)SvTYPE(sv));
+ }
+ }
+ }
+
+
+ if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select) {
+ imp_sth->exe_mode=OCI_COMMIT_ON_SUCCESS;
+ /* we don't AutoCommit on select so LOB locators work */
+ } else if(imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY){
+
+ imp_sth->exe_mode=OCI_DEFAULT;
+ }
+
+
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Statement Execute Mode is %d (%s)\n",
+ imp_sth->exe_mode,oci_exe_mode(imp_sth->exe_mode));
+
+ OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ (ub4)(is_select ? 0: 1),
+ 0, 0, 0,(ub4)imp_sth->exe_mode,status);
+
+
+ if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO etc */
+ /* we record the error even for OCI_SUCCESS_WITH_INFO */
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIStmtExecute"));
+ /* but only bail out here if not OCI_SUCCESS_WITH_INFO */
+ if (status != OCI_SUCCESS_WITH_INFO)
+ return -2;
+ }
+
+ if (is_select) {
+ DBIc_ACTIVE_on(imp_sth);
+ DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */
+ row_count = 0;
+ /*reinit the rs_array as well
+ as we may have more thatn one exe on a prepare*/
+ rs_array_init(imp_sth);
+ }
+ else {
+ OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
+ }
+
+ if (debug >= 2 || dbd_verbose >= 3 ) {
+ ub2 sqlfncode;
+ OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n",
+ oci_stmt_type_name(imp_sth->stmt_type),
+ oci_status_name(status),
+ (long)row_count, sqlfncode, imp_sth->has_inout_params);
+ }
- if (!imp_sth->done_desc) {
+ if (is_select && !imp_sth->done_desc) {
/* describe and allocate storage for results (if any needed) */
- if (!dbd_describe(sth, imp_sth))
- return -2; /* dbd_describe already called ora_error() */
- }
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " dbd_st_execute (for sql f%d after oci f%d, out%d)...\n",
- imp_sth->cda->ft, imp_sth->cda->fc, outparams);
-#endif
+ if (!dbd_describe(sth, imp_sth))
+ return -2; /* dbd_describe already called oci_error() */
+ }
- if (outparams) { /* check validity of bind_param_inout SV's */
- int i = outparams;
- while(--i >= 0) {
- phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
- SV *sv = phs->sv;
-
- /* Make sure we have the value in string format. Typically a number */
- /* will be converted back into a string using the same bound buffer */
- /* so the progv test below will not trip. */
-
- /* is the value a null? */
- phs->indp = (SvOK(sv)) ? 0 : -1;
-
- /* Some checks for mutated storage since we pointed oracle at it. */
- if (phs->out_prepost_exec) {
- if (!phs->out_prepost_exec(sth, imp_sth, phs, 1))
- return -2; /* out_prepost_exec already called ora_error() */
- }
- else
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " with %s = [] (len %ld/%ld, indp %d, otype %d, ptype %d)\n",
- phs->name,
- (long)phs->alen, (long)phs->maxlen, phs->indp,
- phs->ftype, (int)SvTYPE(sv));
- av_clear((AV*)SvRV(sv));
- }
- else
- if (SvTYPE(sv) != phs->sv_type
- || (SvOK(sv) && !SvPOK(sv))
- /* SvROK==!SvPOK so cursor (SQLT_CUR) handle will call dbd_rebind_ph */
- /* that suits us for now */
- || SvPVX(sv) != phs->progv
- || (SvPOK(sv) && SvCUR(sv) > UB2MAXVAL)
- ) {
- if (!dbd_rebind_ph(sth, imp_sth, phs))
- croak("Can't rebind placeholder %s", phs->name);
- }
- else {
- /* String may have grown or shrunk since it was bound */
- /* so tell Oracle about it's current length */
- ub2 prev_alen = phs->alen;
- phs->alen = (SvOK(sv)) ? SvCUR(sv) + phs->alen_incnull : 0+phs->alen_incnull;
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " with %s = '%.*s' (len %ld(%ld)/%ld, indp %d, otype %d, ptype %d)\n",
- phs->name, (int)phs->alen,
- (phs->indp == -1) ? "" : SvPVX(sv),
- (long)phs->alen, (long)prev_alen, (long)phs->maxlen, phs->indp,
- phs->ftype, (int)SvTYPE(sv));
- }
+ if (imp_sth->has_lobs && imp_sth->stmt_type != OCI_STMT_SELECT) {
+ if (!post_execute_lobs(sth, imp_sth, row_count))
+ return -2; /* post_insert_lobs already called oci_error() */
}
- }
-#ifdef OCI_V8_SYNTAX
+ if (outparams) { /* check validity of bound output SV's */
+ int i = outparams;
+ while(--i >= 0) {
+ /* phs->alen has been updated by Oracle to hold the length of the result */
+ phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
+ if (debug >= 2 || dbd_verbose >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "dbd_st_execute(): Analyzing inout a parameter '%s"
+ " of type=%d name=%s'\n",
+ phs->name,phs->ftype,sql_typecode_name(phs->ftype));
+ }
+ if( phs->ftype == ORA_VARCHAR2_TABLE ){
+ dbd_phs_varchar_table_posy_exe(imp_sth, phs);
+ continue;
+ }
+ if( phs->ftype == ORA_NUMBER_TABLE ){
+ dbd_phs_number_table_post_exe(imp_sth, phs);
+ continue;
+ }
+
+ if (phs->out_prepost_exec) {
+ if (!phs->out_prepost_exec(sth, imp_sth, phs, 0))
+ return -2; /* out_prepost_exec already called ora_error() */
+ }
+ else {
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ AV *av = (AV*)SvRV(sv);
+ I32 avlen = AvFILL(av);
+ if (avlen >= 0)
+ dbd_phs_avsv_complete(imp_sth, phs, avlen, debug);
+ }
+ else {
+ dbd_phs_sv_complete(imp_sth, phs, sv, debug);
+ }
+ }
+ }
+ }
- OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
- (ub4)(is_select ? 0 : 1),
- 0, 0, 0,
- /* we don't AutoCommit on select so LOB locators work */
- (ub4)((DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select)
- ? OCI_COMMIT_ON_SUCCESS : OCI_DEFAULT),
- status);
- if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO etc */
- /* we record the error even for OCI_SUCCESS_WITH_INFO */
- oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIStmtExecute"));
- /* but only bail out here if not OCI_SUCCESS_WITH_INFO */
- if (status != OCI_SUCCESS_WITH_INFO)
- return -2;
- }
- if (is_select) {
- DBIc_ACTIVE_on(imp_sth);
- DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */
- row_count = 0;
- }
- else {
- OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
- }
+ return row_count; /* row count (0 will be returned as "0E0") */
+}
- if (debug >= 2) {
- ub2 sqlfncode;
- OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status);
- PerlIO_printf(DBILOGFP,
- " dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n",
- oci_stmt_type_name(imp_sth->stmt_type),
- oci_status_name(status),
- (long)row_count, sqlfncode, imp_sth->has_inout_params);
- }
+static int
+do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_status_av)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ phs_t *phs;
+ int utf8;
+ AV *tuples_utf8_av,*tuples_status_av;
+ int parma_index;
+ {
+ dTHX;
+ sword status;
+ ub1 csform;
+ ub2 csid;
+ int trace_level = DBIc_DBISTATE(imp_sth)->debug;
+ int i;
+ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ 0,
+ phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */
+ (ub2)phs->ftype, 0,
+ NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */
+ 0,
+ 0, /* max elements that can fit in allocated array */
+ NULL, /* (ptr to) current number of elements in array */
+ (ub4)OCI_DATA_AT_EXEC,
+ status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
+ }
- if (is_select && !imp_sth->done_desc) {
- /* describe and allocate storage for results (if any needed) */
- if (!dbd_describe(sth, imp_sth))
- return -2; /* dbd_describe already called oci_error() */
- }
- if (imp_sth->has_lobs && imp_sth->stmt_type != OCI_STMT_SELECT) {
- if (!post_execute_lobs(sth, imp_sth, row_count))
- return -2; /* post_insert_lobs already called oci_error() */
- }
-#else
+ OCIBindDynamic_log(imp_sth, phs->bndhp, imp_sth->errhp,
+ (dvoid *)phs, dbd_phs_in,
+ (dvoid *)phs, dbd_phs_out, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
+ return 0;
+ }
+ /* copied and adapted from dbd_rebind_ph */
+
+ csform = phs->csform;
+
+ if (!csform && (utf8 & ARRAY_BIND_UTF8)) {
+ /* try to default csform to avoid translation through non-unicode */
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */
+ csform = SQLCS_IMPLICIT;
+ else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR))
+ csform = SQLCS_NCHAR; /* else leave csform == 0 */
+ if (trace_level || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "do_bind_array_exec() (2): rebinding %s with UTF8 value %s", phs->name,
+ (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are unicode\n");
+ }
- /* reset cache counters */
- imp_sth->in_cache = 0;
- imp_sth->next_entry = 0;
- imp_sth->eod_errno = 0;
-
- /* Trigger execution of the statement */
- if (DBIc_NUM_FIELDS(imp_sth) > 0) { /* is a SELECT */
- /* The number of fields is used because imp_sth->cda->ft is unreliable. */
- /* Specifically an update (5) may change to select (4) after odesc(). */
- if (oexfet(imp_sth->cda, (ub4)imp_sth->cache_rows, 0, 0)
- && imp_sth->cda->rc != 1403 /* other than no more data */ ) {
- char * hint = "oexfet error";
- if (imp_sth->cda->rc == 932) /* inconsistent data types */
- hint = "oexfet error, e.g., can't select LOB fields using DBD::Oracle built for Oracle 7";
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, hint);
- return -2;
- }
- DBIc_ACTIVE_on(imp_sth);
- imp_sth->in_cache = imp_sth->cda->rpc; /* cache loaded */
- if (imp_sth->cda->rc == 1403)
- imp_sth->eod_errno = 1403;
- }
- else { /* NOT a select */
- if (oexec(imp_sth->cda)) {
- char *msg = "oexec error";
- switch(imp_sth->cda->rc) {
- case 3108:
- msg = "perhaps you're using Oracle 8 functionality but this DBD::Oracle was built for Oracle 7";
- break;
- }
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, msg);
- return -2;
+ if (csform) {
+ /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)"));
+ return 0;
+ }
}
- }
- row_count = imp_sth->cda->rpc;
-
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " dbd_st_execute complete (rc%d, w%02x, rpc%ld, eod%d, out%d)\n",
- imp_sth->cda->rc, imp_sth->cda->wrn,
- (long)row_count, imp_sth->eod_errno,
- imp_sth->has_inout_params);
-#endif
- if (outparams) { /* check validity of bound output SV's */
- int i = outparams;
- while(--i >= 0) {
- /* phs->alen has been updated by Oracle to hold the length of the result */
- phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
- SV *sv = phs->sv;
-
- if (phs->out_prepost_exec) {
- if (!phs->out_prepost_exec(sth, imp_sth, phs, 0))
- return -2; /* out_prepost_exec already called ora_error() */
- }
- else
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- AV *av = (AV*)SvRV(sv);
- I32 avlen = AvFILL(av);
- if (avlen >= 0)
- dbd_phs_avsv_complete(phs, avlen, debug);
- }
- else
- dbd_phs_sv_complete(phs, sv, debug);
+ if (!phs->csid_orig) { /* get the default csid Oracle would use */
+ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 ,
+ OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
}
- }
- return row_count; /* row count (0 will be returned as "0E0") */
-}
+ /* if app has specified a csid then use that, else use default */
+ csid = (phs->csid) ? phs->csid : phs->csid_orig;
+ /* if data is utf8 but charset isn't then switch to utf8 csid if possible */
+ if ((utf8 & ARRAY_BIND_UTF8) && !CS_IS_UTF8(csid)) {
+ /* if the specified or default csid is not utf8 _compatible_ AND we have
+ * mixed utf8 and native (non-utf8) data, then it's a fatal problem
+ * utf8 _compatible_ means, can be upgraded to utf8, ie. utf8 or ascii */
+ if ((utf8 & ARRAY_BIND_NATIVE) && CS_IS_NOT_UTF8_COMPATIBLE(csid)) {
+ oratext charsetname[OCI_NLS_MAXBUFSZ];
+ OCINlsCharSetIdToName(imp_sth->envhp,charsetname, sizeof(charsetname),csid );
+
+ for(i=0;i<av_len(tuples_utf8_av)+1;i++){
+ SV *err_svs[3];
+ SV *item;
+ item=*(av_fetch(tuples_utf8_av,i,0));
+ err_svs[0] = newSViv((IV)0);
+ err_svs[1] = newSVpvf("DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#%d. This may result in corrupt data. The Query charset id=%d, name=%s",parma_index+1,csid,charsetname);
+ err_svs[2] = newSVpvn("S1000", 0);
+ av_store(tuples_status_av,SvIV(item),newRV_noinc((SV *)(av_make(3, err_svs))));
+ }
+
+
+
+ }
+ csid = utf8_csid; /* not al32utf8_csid here on purpose */
+ }
+ if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "do_bind_array_exec(): bind %s <== [array of values] "
+ "(%s, %s, csid %d->%d->%d, ftype %d (%s), csform %d (%s)->%d (%s)"
+ ", maxlen %lu, maxdata_size %lu)\n",
+ phs->name,
+ (phs->is_inout) ? "inout" : "in",
+ (utf8 ? "is-utf8" : "not-utf8"),
+ phs->csid_orig, phs->csid, csid,
+ phs->ftype, sql_typecode_name(phs->ftype),
+ phs->csform,oci_csform_name(phs->csform), csform,oci_csform_name(csform),
+ (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
+
+ if (csid) {
+ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)"));
+ return 0;
+ }
+ }
+ return 1;
+}
+static void
+init_bind_for_array_exec(phs)
+ phs_t *phs;
+{
+ dTHX;
+ if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */
+ phs->is_inout = 0;
+ phs->maxlen = 1;
+ /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
+ if (phs->ftype==102)
+ phs->ftype = ORA_RSET;
+ /* some types require the trailing null included in the length. */
+ /* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */
+ phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC);
+ }
+}
int
-dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset)
- SV *sth;
- imp_sth_t *imp_sth;
- int field;
- long offset;
- long len;
- SV *destrv;
- long destoffset;
+ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, err_count)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ SV *tuples;
+ SV *tuples_status;
+ SV *columns;
+ ub4 exe_count;
+ SV *err_count;
{
- ub4 retl = 0;
- SV *bufsv;
- imp_fbh_t *fbh = &imp_sth->fbh[field];
- int ftype = fbh->ftype;
+ dTHX;
+ dTHR;
+ ub4 row_count = 0;
+ int debug = DBIc_DBISTATE(imp_sth)->debug;
+ D_imp_dbh_from_sth;
+ sword status, exe_status;
+ int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
+ AV *tuples_av, *tuples_status_av, *columns_av,*tuples_utf8_av;
+ ub4 oci_mode;
+ ub4 num_errs;
+ int i,j;
+ int autocommit = DBIc_has(imp_dbh,DBIcf_AutoCommit);
+ SV **sv_p;
+ phs_t **phs;
+ SV *sv;
+ AV *av;
+ int param_count;
+ char namebuf[30];
+ STRLEN len;
+ int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0;
+ int *utf8_flgs;
+ tuples_utf8_av = newAV();
+ sv_2mortal((SV*)tuples_utf8_av);
+
+ if (debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " ora_st_execute_array %s count=%d (%s %s %s)...\n",
+ oci_stmt_type_name(imp_sth->stmt_type), exe_count,
+ neatsvpv(tuples,0), neatsvpv(tuples_status,0),
+ neatsvpv(columns, 0));
+
+ if (is_select) {
+ croak("ora_st_execute_array(): SELECT statement not supported "
+ "for array operation.");
+ }
- bufsv = SvRV(destrv);
- sv_setpvn(bufsv,"",0); /* ensure it's writable string */
+ if (imp_sth->has_lobs) {
+ croak("ora_st_execute_array(): LOBs not "
+ "supported for array operation.");
+ }
-#ifdef OCI_V8_SYNTAX
-#ifdef UTF8_SUPPORT
- if (ftype == 112 && cs_is_utf8) {
- return ora_blob_read_mb_piece(sth, imp_sth, fbh, bufsv,
- offset, len, destoffset);
- }
+ /* Check that the `tuples' parameter is an array ref, find the length,
+ and store it in the statement handle for the OCI callback. */
+ if(!SvROK(tuples) || SvTYPE(SvRV(tuples)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): Not an array reference.");
+ }
+ tuples_av = (AV*)SvRV(tuples);
+
+ /* Check the `columns' parameter. */
+ if(SvTRUE(columns)) {
+ if(!SvROK(columns) || SvTYPE(SvRV(columns)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): columns not an array peference.");
+ }
+ columns_av = (AV*)SvRV(columns);
+ } else {
+ columns_av = NULL;
+ }
+ /* Check the `tuples_status' parameter. */
+ if(SvTRUE(tuples_status)) {
+ if(!SvROK(tuples_status) || SvTYPE(SvRV(tuples_status)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): tuples_status not an array reference.");
+ }
+ tuples_status_av = (AV*)SvRV(tuples_status);
+ av_fill(tuples_status_av, exe_count - 1);
+
+ } else {
+ tuples_status_av = NULL;
+ }
-#endif /* UTF8_SUPPORT */
-#endif /* ifdef OCI_V8_SYNTAX */
+ /* Nothing to do if no tuples. */
+ if(exe_count <= 0)
+ return 0;
+
+ /* Ensure proper OCIBindByName() calls for all placeholders.
+ if(!ora_st_bind_for_array_exec(sth, imp_sth, tuples_av, exe_count,
+ DBIc_NUM_PARAMS(imp_sth), columns_av))
+ return -2;
+
+ fix for Perl undefined warning. Moved out of function back out to main code
+ Still ensures proper OCIBindByName*/
+
+ param_count=DBIc_NUM_PARAMS(imp_sth);
+ Newz(0,phs,param_count*sizeof(*phs),phs_t *);
+ Newz(0,utf8_flgs,param_count*sizeof(int),int);
+
+ for(j = 0; (unsigned int) j < exe_count; j++) {
+ /* Fill in 'unknown' exe count in every element (know not how to get
+ individual execute row counts from OCI).
+ Moved it here as there is no need to iterate twice over it
+ this should speed it up somewhat for large binds*/
+
+ if (SvTRUE(tuples_status)){
+ av_store(tuples_status_av, j, newSViv((IV)-1));
+ }
+ sv_p = av_fetch(tuples_av, j, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ Safefree(utf8_flgs);
+ croak("Cannot fetch tuple %d", j);
+ }
+ sv = *sv_p;
+ if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
+ Safefree(phs);
+ Safefree(utf8_flgs);
+ croak("Not an array ref in element %d", j);
+ }
+ av = (AV*)SvRV(sv);
+ for(i = 0; i < param_count; i++) {
+ if(!phs[i]) {
+ SV **phs_svp;
+ sprintf(namebuf, ":p%d", i+1);
+ phs_svp = hv_fetch(imp_sth->all_params_hv,
+ namebuf, strlen(namebuf), 0);
+ if (phs_svp == NULL) {
+ Safefree(utf8_flgs);
+ Safefree(phs);
+ croak("Can't execute for non-existent placeholder :%d", i);
+ }
+ phs[i] = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
+ if(phs[i]->idx < 0) {
+ Safefree(phs);
+ croak("Placeholder %d not of ?/:1 type", i);
+ }
+ init_bind_for_array_exec(phs[i]);
+ }
+ sv_p = av_fetch(av, phs[i]->idx, 0);
+ if(sv_p == NULL) {
+ Safefree(utf8_flgs);
+ Safefree(phs);
+ croak("Cannot fetch value for param %d in entry %d", i, j);
+ }
+
+ sv = *sv_p;
+
+ /*check to see if value sv is a null (undef) if it is upgrade it*/
+ if (!SvOK(sv)) {
+ (void)SvUPGRADE(sv, SVt_PV);
+ }
+ else {
+ SvPV(sv, len);
+ }
+
+
+ /* Find the value length, and increase maxlen if needed. */
+ if(SvROK(sv)) {
+ Safefree(phs);
+ Safefree(utf8_flgs);
+ croak("Can't bind a reference (%s) for param %d, entry %d",
+ neatsvpv(sv,0), i, j);
+ }
+ if(len > (unsigned int) phs[i]->maxlen)
+ phs[i]->maxlen = len;
+
+ /* update the utf8_flgs for this value */
+ if (SvUTF8(sv)) {
+ utf8_flgs[i] |= ARRAY_BIND_UTF8;
+ if (SvTRUE(tuples_status)){
+ av_push(tuples_utf8_av,newSViv(j));
+ }
+
+
+ }
+ else {
+ utf8_flgs[i] |= ARRAY_BIND_NATIVE;
+
+ }
+ /* Do OCI bind calls on last iteration. */
+ if( ((unsigned int) j ) == exe_count - 1 ) {
+ do_bind_array_exec(sth, imp_sth, phs[i], utf8_flgs[i],i,tuples_utf8_av,tuples_status_av);
+ }
+ }
+ }
+ /* Store array of bind typles, for use in OCIBindDynamic() callback. */
+ imp_sth->bind_tuples = tuples_av;
+ imp_sth->rowwise = (columns_av == NULL);
- SvGROW(bufsv, (STRLEN)destoffset+len+1); /* SvGROW doesn't do +1 */
+ oci_mode = OCI_BATCH_ERRORS;
+ if(autocommit)
+ oci_mode |= OCI_COMMIT_ON_SUCCESS;
-#ifdef OCI_V8_SYNTAX
- retl = ora_blob_read_piece(sth, imp_sth, fbh, bufsv,
- offset, len, destoffset);
- if (!SvOK(bufsv)) /* ora_blob_read_piece recorded error */
- return 0;
- ftype = ftype; /* no unused */
+ OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ exe_count, 0, 0, 0, oci_mode, exe_status);
-#else
+ OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
- if (len > 65535) {
- warn("Oracle OCI7 doesn't allow blob_read to reliably fetch chunks longer than 65535 bytes");
- len = 65535;
- }
- switch (fbh->ftype) {
- case 94: ftype = 8; break;
- case 95: ftype = 24; break;
+ imp_sth->bind_tuples = NULL;
+
+ if (exe_status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, exe_status, ora_sql_error(imp_sth,"OCIStmtExecute"));
+ if(exe_status != OCI_SUCCESS_WITH_INFO)
+ return -2;
+ }
+ if (outparams){
+ i=outparams;
+ while(--i >= 0) {
+ phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ AV *av = (AV*)SvRV(sv);
+ I32 avlen = AvFILL(av);
+ for (j=0;j<=avlen;j++){
+ dbd_phs_avsv_complete(imp_sth, phs, j, debug);
+ }
+ }
+ }
+ }
+
+ OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS, status);
+
+ if (debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " ora_st_execute_array %d errors in batch.\n",
+ num_errs);
+ if (num_errs) {
+ sv_setiv(err_count,num_errs);
}
- /* The +1 on field was a mistake that's too late to fix :-( */
- if (oflng(imp_sth->cda, (sword)field+1,
- ((ub1*)SvPVX(bufsv)) + destoffset, len,
- ftype, &retl, offset)) {
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, "oflng error");
- /* XXX database may have altered the buffer contents */
+ if(num_errs && tuples_status_av) {
+ OCIError *row_errhp, *tmp_errhp;
+ ub4 row_off;
+ SV *err_svs[3];
+ /*AV *err_av;*/
+ sb4 err_code;
+
+ err_svs[0] = newSViv((IV)0);
+ err_svs[1] = newSVpvn("", 0);
+ err_svs[2] = newSVpvn("S1000",5);
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &row_errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &tmp_errhp, OCI_HTYPE_ERROR, status);
+ for(i = 0; (unsigned int) i < num_errs; i++) {
+ OCIParamGet_log_stat(imp_sth, imp_sth->errhp, OCI_HTYPE_ERROR,
+ tmp_errhp, (dvoid *)&row_errhp,
+ (ub4)i, status);
+ OCIAttrGet_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, &row_off, 0,
+ OCI_ATTR_DML_ROW_OFFSET, imp_sth->errhp, status);
+ if (debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " ora_st_execute_array error in row %d.\n",
+ row_off);
+ sv_setpv(err_svs[1], "");
+ err_code = oci_error_get((imp_xxh_t *)imp_sth, row_errhp, exe_status, NULL, err_svs[1], debug);
+ sv_setiv(err_svs[0], (IV)err_code);
+ av_store(tuples_status_av, row_off,
+ newRV_noinc((SV *)(av_make(3, err_svs))));
+ }
+ OCIHandleFree_log_stat(imp_sth, tmp_errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleFree_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, status);
+
+ /* Do a commit here if autocommit is set, since Oracle
+ doesn't do that for us when some rows are in error. */
+ if(autocommit) {
+ OCITransCommit_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
+ OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCITransCommit");
+ return -2;
+ }
+ }
+ }
+
+ if(num_errs) {
+ return -2;
+ } else {
+
+ return row_count;
+ }
+}
+
+
+
+
+int
+dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, SV *destrv, long destoffset)
+{
+ dTHX;
+ ub4 retl = 0;
+ SV *bufsv;
+ imp_fbh_t *fbh = &imp_sth->fbh[field];
+ int ftype = fbh->ftype;
+
+ bufsv = SvRV(destrv);
+ sv_setpvn(bufsv,"",0); /* ensure it's writable string */
+
+#ifdef UTF8_SUPPORT
+ if (ftype == 112 && CS_IS_UTF8(ncharsetid) ) {
+ return ora_blob_read_mb_piece(sth, imp_sth, fbh, bufsv,
+ offset, len, destoffset);
+ }
+#endif /* UTF8_SUPPORT */
+
+ SvGROW(bufsv, (STRLEN)destoffset+len+1); /* SvGROW doesn't do +1 */
+
+ retl = ora_blob_read_piece(sth, imp_sth, fbh, bufsv,
+ offset, len, destoffset);
+ if (!SvOK(bufsv)) { /* ora_blob_read_piece recorded error */
+ ora_free_templob(sth, imp_sth, (OCILobLocator*)fbh->desc_h);
return 0;
- }
-#endif
+ }
+ ftype = ftype; /* no unused */
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " blob_read field %d+1, ftype %d, offset %ld, len %ld, destoffset %ld, retlen %ld\n",
- field, imp_sth->fbh[field].ftype, offset, len, destoffset, (long)retl);
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " blob_read field %d+1, ftype %d, offset %ld, len %ld, "
+ "destoffset %ld, retlen %ld\n",
+ field, imp_sth->fbh[field].ftype, offset, len, destoffset, (long)retl);
- SvCUR_set(bufsv, destoffset+retl);
+ SvCUR_set(bufsv, destoffset+retl);
- *SvEND(bufsv) = '\0'; /* consistent with perl sv_setpvn etc */
+ *SvEND(bufsv) = '\0'; /* consistent with perl sv_setpvn etc */
- return 1;
+ return 1;
}
int
-dbd_st_rows(sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
+dbd_st_rows(SV *sth, imp_sth_t *imp_sth)
{
-#ifdef OCI_V8_SYNTAX
- ub4 row_count = 0;
- sword status;
- OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
- if (status != OCI_SUCCESS) {
+ dTHX;
+ ub4 row_count = 0;
+ sword status;
+ OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
+ if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_ROW_COUNT");
return -1;
- }
- return row_count;
-#else
- /* spot common mistake of checking $h->rows just after ->execute */
- if ( imp_sth->in_cache > 0 /* has unfetched rows */
- && imp_sth->in_cache== imp_sth->cda->rpc /* NO rows fetched yet */
- && DBIc_WARN(imp_sth) /* provide a way to disable warning */
- ) {
- warn("$h->rows count is incomplete before all rows fetched.\n");
- }
- /* imp_sth->in_cache should always be 0 for non-select statements */
- return imp_sth->cda->rpc - imp_sth->in_cache; /* fetched rows */
-#endif
+ }
+ return row_count;
}
int
-dbd_st_finish(sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
+dbd_st_finish(SV *sth, imp_sth_t *imp_sth)
{
- dTHR;
- D_imp_dbh_from_sth;
+ dTHR;
+ dTHX;
+ D_imp_dbh_from_sth;
+ sword status;
+ int num_fields = DBIc_NUM_FIELDS(imp_sth);
+ int i;
- if (!DBIc_ACTIVE(imp_sth))
- return 1;
- /* Cancel further fetches from this cursor. */
- /* We don't close the cursor till DESTROY (dbd_st_destroy). */
- /* The application may re execute(...) it. */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_finish\n");
- /* Turn off ACTIVE here regardless of errors below. */
- DBIc_ACTIVE_off(imp_sth);
+ if (!DBIc_ACTIVE(imp_sth))
+ return 1;
- if (imp_sth->disable_finish) /* see ref cursors */
- return 1;
+ /* Cancel further fetches from this cursor. */
+ /* We don't close the cursor till DESTROY (dbd_st_destroy). */
+ /* The application may re execute(...) it. */
- if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
- return 1;
+ /* Turn off ACTIVE here regardless of errors below. */
+ DBIc_ACTIVE_off(imp_sth);
- if (dirty) /* don't walk on the wild side */
- return 1;
+ for(i=0; i < num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh);
+ }
-#ifdef OCI_V8_SYNTAX
-{ sword status;
- OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp, 0,
- OCI_FETCH_NEXT, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS && status != OCI_SUCCESS_WITH_INFO) {
- oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch");
- return 0;
- }
-}
-#else
- if (ocan(imp_sth->cda)) {
- /* oracle 7.3 code can core dump looking up an error message */
- /* if we have logged out of the database. This typically */
- /* happens during global destruction. This should catch most: */
- if (dirty && imp_sth->cda->rc == 3114)
- ora_error(sth, NULL, imp_sth->cda->rc,
- "ORA-03114: not connected to ORACLE (ocan)");
- else
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, "ocan error");
- return 0;
- }
-#endif
- return 1;
+ if (PL_dirty) /* don't walk on the wild side */
+ return 1;
+
+ if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
+ return 1;
+
+ /*fetching on a cursor with row =0 will explicitly free any
+ server side resources this is what the next statment does,
+ not sure if we need this for non scrolling cursors they should die on
+ a OER(1403) no records)*/
+
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,
+ OCI_FETCH_NEXT,0, status);
+
+ if (status != OCI_SUCCESS && status != OCI_SUCCESS_WITH_INFO) {
+ oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch");
+ return 0;
+ }
+ return 1;
}
void
-ora_free_fbh_contents(fbh)
- imp_fbh_t *fbh;
+ora_free_fbh_contents(SV *sth, imp_fbh_t *fbh)
{
- if (fbh->fb_ary)
+ dTHX;
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth;
+
+ if (fbh->fb_ary)
fb_ary_free(fbh->fb_ary);
- sv_free(fbh->name_sv);
-#ifdef OCI_V8_SYNTAX
- if (fbh->desc_h)
- OCIDescriptorFree_log(fbh->desc_h, fbh->desc_t);
-#endif
+ sv_free(fbh->name_sv);
+
+ /* see rt 75163 */
+ if (fbh->desc_h) {
+ boolean is_open;
+ sword status;
+
+ OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, fbh->desc_h, &is_open, status);
+ if (status == OCI_SUCCESS && is_open) {
+ OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
+ fbh->desc_h, status);
+ }
+
+
+ OCIDescriptorFree_log(imp_sth, fbh->desc_h, fbh->desc_t);
+ }
+
+ if (fbh->obj) {
+ if (fbh->obj->obj_value)
+ OCIObjectFree(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->obj->obj_value, (ub2)0);
+ Safefree(fbh->obj);
+ }
+
}
void
-ora_free_phs_contents(phs)
- phs_t *phs;
+ora_free_phs_contents(imp_sth_t *imp_sth, phs_t *phs)
{
-#ifdef OCI_V8_SYNTAX
- if (phs->desc_h)
- OCIDescriptorFree_log(phs->desc_h, phs->desc_t);
-#else
- if (phs->ftype == 102 && phs->progv) { /* SQLT_CUR */
- /* should not normally happen since new child sth takes */
- /* ownership of the cursor and sets phs->progv to NULL. */
- oclose((Cda_Def*)phs->progv);
- Safefree(phs->progv);
- phs->progv = NULL;
- }
+ dTHX;
+ if (phs->desc_h)
+ OCIDescriptorFree_log(imp_sth, phs->desc_h, phs->desc_t);
+ if( phs->array_buf ){
+ free(phs->array_buf);
+ phs->array_buf=NULL;
+ }
+ if( phs->array_indicators ){
+ free(phs->array_indicators);
+ phs->array_indicators=NULL;
+ }
+ if( phs->array_lengths ){
+ free(phs->array_lengths);
+ phs->array_lengths=NULL;
+ }
+
+ phs->array_buflen=0;
+ phs->array_numallocated=0;
+ sv_free(phs->ora_field);
+ sv_free(phs->sv);
+}
+
+void
+ora_free_templob(SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc)
+{
+ dTHX;
+#if defined(OCI_HTYPE_DIRPATH_FN_CTX) /* >= 9.0 */
+ boolean is_temporary = 0;
+ sword status;
+ OCILobIsTemporary_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobloc, &is_temporary, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobIsTemporary");
+ return;
+ }
+
+ if (is_temporary) {
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobFreeTemporary %s\n", oci_status_name(status));
+ }
+ OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobFreeTemporary");
+ return;
+ }
+ }
#endif
- sv_free(phs->ora_field);
- sv_free(phs->sv);
}
void
-dbd_st_destroy(sth, imp_sth)
- SV *sth;
- imp_sth_t *imp_sth;
+dbd_st_destroy(SV *sth, imp_sth_t *imp_sth)
{
- int fields;
- int i;
- dTHX ;
-
-#ifdef OCI_V8_SYNTAX
- {
+ int fields;
+ int i;
sword status;
- if (imp_sth->lob_refetch)
- ora_free_lob_refetch(sth, imp_sth);
- OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
- if (status != OCI_SUCCESS)
- oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
- }
-#else
- oclose(imp_sth->cda); /* ignore error ? */
- if (imp_sth->cda != &imp_sth->cdabuf) {
- /* we assume that the cda was allocated for a ref cursor */
- /* bound to a placeholder on a different statement. */
- /* We own the cda buffer now so we need to free it. */
- Safefree(imp_sth->cda);
- }
- imp_sth->cda = NULL;
-#endif
+ dTHX ;
- /* Free off contents of imp_sth */
+ /* Don't free the OCI statement handle for a nested cursor. It will
+ be reused by Oracle on the next fetch. Indeed, we never
+ free these handles. Experiment shows that Oracle frees them
+ when they are no longer needed.
+ */
+ /* get rid of describe handle if used*/
- fields = DBIc_NUM_FIELDS(imp_sth);
- imp_sth->in_cache = 0;
- imp_sth->eod_errno = 1403;
- for(i=0; i < fields; ++i) {
- imp_fbh_t *fbh = &imp_sth->fbh[i];
- ora_free_fbh_contents(fbh);
- }
- Safefree(imp_sth->fbh);
- if (imp_sth->fbh_cbuf)
- Safefree(imp_sth->fbh_cbuf);
- Safefree(imp_sth->statement);
+ /* if we are using a scrolling cursor we should get rid of the
+ cursor by fetching row 0 */
- if (imp_sth->out_params_av)
- sv_free((SV*)imp_sth->out_params_av);
+ if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY){
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status);
+ }
- if (imp_sth->all_params_hv) {
- HV *hv = imp_sth->all_params_hv;
- SV *sv;
- char *key;
- I32 retlen;
- hv_iterinit(hv);
- while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
- if (sv != &sv_undef) {
- phs_t *phs = (phs_t*)(void*)SvPVX(sv);
- ora_free_phs_contents(phs);
- }
- }
- sv_free((SV*)imp_sth->all_params_hv);
- }
+ if (imp_sth->dschp){
+ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ }
+
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_destroy %s\n",
+ (PL_dirty) ? "(OCIHandleFree skipped during global destruction)" :
+ (imp_sth->nested_cursor) ?"(OCIHandleFree skipped for nested cursor)" : "");
+
+ if (!PL_dirty) { /* XXX not ideal, leak may be a problem in some cases */
+ if (!imp_sth->nested_cursor) {
+ OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status);
+ if (status != OCI_SUCCESS)
+ oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
+ }
+ }
+
+ /* Free off contents of imp_sth */
+
+ if (imp_sth->lob_refetch)
+ ora_free_lob_refetch(sth, imp_sth);
+
+ fields = DBIc_NUM_FIELDS(imp_sth);
+ imp_sth->in_cache = 0;
+ imp_sth->eod_errno = 1403;
+ for(i=0; i < fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ ora_free_fbh_contents(sth, fbh);
+ }
+ Safefree(imp_sth->fbh);
+ if (imp_sth->fbh_cbuf)
+ Safefree(imp_sth->fbh_cbuf);
+ Safefree(imp_sth->statement);
+
+ if (imp_sth->out_params_av)
+ sv_free((SV*)imp_sth->out_params_av);
+
+ if (imp_sth->all_params_hv) {
+ HV *hv = imp_sth->all_params_hv;
+ SV *sv;
+ char *key;
+ I32 retlen;
+ hv_iterinit(hv);
+ while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
+ if (sv != &PL_sv_undef) {
+ phs_t *phs = (phs_t*)(void*)SvPVX(sv);
+ if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB)
+ ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h);
+ ora_free_phs_contents(imp_sth, phs);
+ }
+ }
+ sv_free((SV*)imp_sth->all_params_hv);
+ }
+
+ DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
- DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
}
int
-dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)
- SV *sth;
- imp_sth_t *imp_sth;
- SV *keysv;
- SV *valuesv;
+dbd_st_STORE_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)
{
- STRLEN kl;
- SV *cachesv = NULL;
- char *key = SvPV(keysv,kl);
-/*
- int on = SvTRUE(valuesv);
- int oraperl = DBIc_COMPAT(imp_sth); */
-
- if (strEQ(key, "ora_fetchtest")) {
- ora_fetchtest = SvIV(valuesv);
- }
- else
- return FALSE;
+ dTHX;
+ STRLEN kl;
+ SV *cachesv = NULL;
+ char *key = SvPV(keysv,kl);
+ if( imp_sth ) { /* For GCC not to warn on unused argument */}
+/* int on = SvTRUE(valuesv);
+ int oraperl = DBIc_COMPAT(imp_sth); */
+ if (strEQ(key, "ora_fetchtest")) {
+ ora_fetchtest = SvIV(valuesv);
+ }
+ else
+ return FALSE;
- if (cachesv) /* cache value for later DBI 'quick' fetch? */
- hv_store((HV*)SvRV(sth), key, kl, cachesv, 0);
- return TRUE;
+ if (cachesv) /* cache value for later DBI 'quick' fetch? */
+ (void)hv_store((HV*)SvRV(sth), key, kl, cachesv, 0);
+ return TRUE;
}
SV *
-dbd_st_FETCH_attrib(sth, imp_sth, keysv)
- SV *sth;
- imp_sth_t *imp_sth;
- SV *keysv;
+dbd_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv)
{
- STRLEN kl;
- char *key = SvPV(keysv,kl);
- int i;
- SV *retsv = NULL;
- /* Default to caching results for DBI dispatch quick_FETCH */
- int cacheit = TRUE;
- /* int oraperl = DBIc_COMPAT(imp_sth); */
-
- if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) /* handled by DBI */
- return Nullsv;
-
- if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) {
- STRLEN lna;
+ dTHX;
+ STRLEN kl;
+ char *key = SvPV(keysv,kl);
+ int i;
+ SV *retsv = NULL;
+ /* Default to caching results for DBI dispatch quick_FETCH */
+ int cacheit = TRUE;
+ /* int oraperl = DBIc_COMPAT(imp_sth); */
+
+ if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) /* handled by DBI */
+ return Nullsv;
+
+ if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) {
+ STRLEN lna;
/* dbd_describe has already called ora_error() */
/* we can't return Nullsv here because the xs code will */
/* then just pass the attribute name to DBI for FETCH. */
- croak("Describe failed during %s->FETCH(%s): %ld: %s",
- SvPV(sth,na), key, (long)SvIV(DBIc_ERR(imp_sth)),
- SvPV(DBIc_ERRSTR(imp_sth),lna)
- );
- }
+ croak("Describe failed during %s->FETCH(%s): %ld: %s",
+ SvPV(sth,PL_na), key, (long)SvIV(DBIc_ERR(imp_sth)),
+ SvPV(DBIc_ERRSTR(imp_sth),lna)
+ );
+ }
- i = DBIc_NUM_FIELDS(imp_sth);
+ i = DBIc_NUM_FIELDS(imp_sth);
- if (kl==4 && strEQ(key, "NAME")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSVpv((char*)imp_sth->fbh[i].name,0));
+ if (kl==4 && strEQ(key, "NAME")) {
+ AV *av = newAV();
+ SV *x;
+ D_imp_dbh_from_sth;
- } else if (kl==11 && strEQ(key, "ParamValues")) {
- HV *pvhv = newHV();
- if (imp_sth->all_params_hv) {
- SV *sv;
- char *key;
- I32 keylen;
- hv_iterinit(imp_sth->all_params_hv);
- while ( (sv = hv_iternextsv(imp_sth->all_params_hv, &key, &keylen)) ) {
- phs_t *phs = (phs_t*)(void*)SvPVX(sv); /* placeholder struct */
- hv_store(pvhv, key, keylen, newSVsv(phs->sv), 0);
- }
- }
- retsv = newRV_noinc((SV*)pvhv);
- cacheit = FALSE;
-
- } else if (kl==11 && strEQ(key, "ora_lengths")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSViv((IV)imp_sth->fbh[i].disize));
-
- } else if (kl==9 && strEQ(key, "ora_types")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSViv(imp_sth->fbh[i].dbtype));
-
- } else if (kl==4 && strEQ(key, "TYPE")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).dbtype));
-
- } else if (kl==5 && strEQ(key, "SCALE")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).scale));
-
- } else if (kl==9 && strEQ(key, "PRECISION")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).prec));
-
-#ifndef OCI_V8_SYNTAX
-#ifdef XXXXX
- } else if (kl==9 && strEQ(key, "ora_rowid")) {
- /* return current _binary_ ROWID (oratype 11) uncached */
- /* Use { ora_type => 11 } when binding to a placeholder */
- retsv = newSVpv((char*)&imp_sth->cda->rid, sizeof(imp_sth->cda->rid));
- cacheit = FALSE;
-#endif
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ x = newSVpv((char*)imp_sth->fbh[i].name,0);
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) {
+#ifdef sv_utf8_decode
+ sv_utf8_decode(x);
+#else
+ SvUTF8_on(x);
#endif
+ }
+ av_store(av, i, x);
+ }
+ }
+ else if (kl==11 && strEQ(key, "ParamValues")) {
+ HV *pvhv = newHV();
+ if (imp_sth->all_params_hv) {
+ SV *sv;
+ char *key;
+ I32 keylen;
+ hv_iterinit(imp_sth->all_params_hv);
+ while ( (sv = hv_iternextsv(imp_sth->all_params_hv, &key, &keylen)) ) {
+ phs_t *phs = (phs_t*)(void*)SvPVX(sv); /* placeholder struct */
+ (void)hv_store(pvhv, key, keylen, newSVsv(phs->sv), 0);
+ }
+ }
+ retsv = newRV_noinc((SV*)pvhv);
+ cacheit = FALSE;
- } else if (kl==17 && strEQ(key, "ora_est_row_width")) {
- retsv = newSViv(imp_sth->est_width);
- cacheit = TRUE;
-
- } else if (kl==8 && strEQ(key, "NULLABLE")) {
- AV *av = newAV();
- retsv = newRV(sv_2mortal((SV*)av));
- while(--i >= 0)
- av_store(av, i, boolSV(imp_sth->fbh[i].nullok));
+ }
+ else if (kl==11 && strEQ(key, "ora_lengths")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv((IV)imp_sth->fbh[i].disize));
+ }
+ else if (kl==9 && strEQ(key, "ora_types")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv(imp_sth->fbh[i].dbtype));
+ }
+ else if (kl==4 && strEQ(key, "TYPE")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).dbtype));
+ }
+ else if (kl==5 && strEQ(key, "SCALE")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).scale));
+ }
+ else if (kl==9 && strEQ(key, "PRECISION")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).prec));
+#ifdef XXX
+ }
+ else if (kl==9 && strEQ(key, "ora_rowid")) {
+ /* return current _binary_ ROWID (oratype 11) uncached */
+ /* Use { ora_type => 11 } when binding to a placeholder */
+ retsv = newSVpv((char*)&imp_sth->cda->rid, sizeof(imp_sth->cda->rid));
+ cacheit = FALSE;
+#endif
+ }
+ else if (kl==17 && strEQ(key, "ora_est_row_width")) {
+ retsv = newSViv(imp_sth->est_width);
+ cacheit = TRUE;
+ }
+ else if (kl==11 && strEQ(key, "RowsInCache")) {
+ retsv = newSViv(imp_sth->RowsInCache);
+ cacheit = FALSE;
- } else {
- return Nullsv;
- }
- if (cacheit) { /* cache for next time (via DBI quick_FETCH) */
- SV **svp = hv_fetch((HV*)SvRV(sth), key, kl, 1);
- sv_free(*svp);
- *svp = retsv;
- (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */
- }
- return sv_2mortal(retsv);
+ }else if (kl==12 && strEQ(key, "RowCacheSize")) {
+ retsv = newSViv(imp_sth->RowCacheSize);
+ cacheit = FALSE;
+ }
+ else if (kl==8 && strEQ(key, "NULLABLE")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, boolSV(imp_sth->fbh[i].nullok));
+ }
+ else if (kl==13 && strEQ(key, "len_char_size")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0)
+ av_store(av, i, newSViv(imp_sth->fbh[i].len_char_size));
+ }
+ else {
+ return Nullsv;
+ }
+ if (cacheit) { /* cache for next time (via DBI quick_FETCH) */
+ SV **svp = hv_fetch((HV*)SvRV(sth), key, kl, 1);
+ sv_free(*svp);
+ *svp = retsv;
+ (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */
+ }
+ return sv_2mortal(retsv);
}
/* --------------------------------------- */
static sql_fbh_t
ora2sql_type(imp_fbh_t* fbh) {
- sql_fbh_t sql_fbh;
- sql_fbh.dbtype = fbh->dbtype;
- sql_fbh.prec = fbh->prec;
- sql_fbh.scale = fbh->scale;
-
- switch(fbh->dbtype) { /* oracle Internal (not external) types */
- case SQLT_NUM:
- if (fbh->scale == -127) { /* FLOAT, REAL, DOUBLE_PRECISION */
- sql_fbh.dbtype = SQL_DOUBLE;
- sql_fbh.scale = 0; /* better: undef */
- }
- else if (fbh->scale == 0) {
- if (fbh->prec == 0) { /* NUMBER */
- sql_fbh.dbtype = SQL_DOUBLE;
- sql_fbh.prec = 126;
- }
- else { /* INTEGER, NUMBER(p,0) */
- sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_INTEGER */
- }
+ sql_fbh_t sql_fbh;
+ sql_fbh.dbtype = fbh->dbtype;
+ sql_fbh.prec = fbh->prec;
+ sql_fbh.scale = fbh->scale;
+
+ switch(fbh->dbtype) { /* oracle Internal (not external) types */
+ case SQLT_NUM:
+ if (fbh->scale == -127) { /* FLOAT, REAL, DOUBLE_PRECISION */
+ sql_fbh.dbtype = SQL_DOUBLE;
+ sql_fbh.scale = 0; /* better: undef */
+ if (fbh->prec == 0) { /* NUMBER; s. Oracle Bug# 2755842, 2235818 */
+ sql_fbh.prec = 126;
+ }
+ }
+ else if (fbh->scale == 0) {
+ if (fbh->prec == 0) { /* NUMBER */
+ sql_fbh.dbtype = SQL_DOUBLE;
+ sql_fbh.prec = 126;
+ }
+ else { /* INTEGER, NUMBER(p,0) */
+ sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_INTEGER */
+ }
}
- else { /* NUMBER(p,s) */
- sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_NUMERIC */
- }
- break;
- case SQLT_CHR: sql_fbh.dbtype = SQL_VARCHAR; break;
- case SQLT_LNG: sql_fbh.dbtype = SQL_LONGVARCHAR; break; /* long */
- case SQLT_DAT: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP;break;
- case SQLT_BIN: sql_fbh.dbtype = SQL_BINARY; break; /* raw */
- case SQLT_LBI: sql_fbh.dbtype = SQL_LONGVARBINARY; break; /* long raw */
- case SQLT_AFC: sql_fbh.dbtype = SQL_CHAR; break; /* Ansi fixed char */
-#ifdef OCI_V8_SYNTAX
- case SQLT_CLOB: sql_fbh.dbtype = SQL_CLOB; break;
- case SQLT_BLOB: sql_fbh.dbtype = SQL_BLOB; break;
+ else { /* NUMBER(p,s) */
+ sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_NUMERIC */
+ }
+ break;
+#ifdef SQLT_IBDOUBLE
+ case SQLT_BDOUBLE:
+ case SQLT_BFLOAT:
+ case SQLT_IBDOUBLE:
+ case SQLT_IBFLOAT:
+ sql_fbh.dbtype = SQL_DOUBLE;
+ sql_fbh.prec = 126;
+ break;
#endif
+ case SQLT_CHR: sql_fbh.dbtype = SQL_VARCHAR; break;
+ case SQLT_LNG: sql_fbh.dbtype = SQL_LONGVARCHAR; break; /* long */
+ case SQLT_DAT: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP;break;
+ case SQLT_BIN: sql_fbh.dbtype = SQL_BINARY; break; /* raw */
+ case SQLT_LBI: sql_fbh.dbtype = SQL_LONGVARBINARY; break; /* long raw */
+ case SQLT_AFC: sql_fbh.dbtype = SQL_CHAR; break; /* Ansi fixed char */
+ case SQLT_CLOB: sql_fbh.dbtype = SQL_CLOB; break;
+ case SQLT_BLOB: sql_fbh.dbtype = SQL_BLOB; break;
#ifdef SQLT_TIMESTAMP_TZ
- case SQLT_TIMESTAMP_TZ: sql_fbh.dbtype = SQL_TIMESTAMP; break;
+ case SQLT_DATE: sql_fbh.dbtype = SQL_DATE; break;
+ case SQLT_TIME: sql_fbh.dbtype = SQL_TIME; break;
+ case SQLT_TIME_TZ: sql_fbh.dbtype = SQL_TYPE_TIME_WITH_TIMEZONE; break;
+ case SQLT_TIMESTAMP: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP; break;
+ case SQLT_TIMESTAMP_TZ: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE; break;
+ case SQLT_TIMESTAMP_LTZ: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE; break;
+ case SQLT_INTERVAL_YM: sql_fbh.dbtype = SQL_INTERVAL_YEAR_TO_MONTH; break;
+ case SQLT_INTERVAL_DS: sql_fbh.dbtype = SQL_INTERVAL_DAY_TO_SECOND; break;
#endif
- default: sql_fbh.dbtype = -9000 - fbh->dbtype; /* else map type into DBI reserved standard range */
- }
- return sql_fbh;
+ default: sql_fbh.dbtype = -9000 - fbh->dbtype; /* else map type into DBI reserved standard range */
+ }
+ return sql_fbh;
}
static void
-dump_env_to_trace() {
- PerlIO *fp = DBILOGFP;
- int i = 0;
- char *p;
-#ifndef __BORLANDC__
- extern char **environ;
+dump_env_to_trace(imp_dbh_t *imp_dbh) {
+ dTHX;
+ int i = 0;
+ char *p;
+
+#if defined (__APPLE__)
+ #include <crt_externs.h>
+ #define environ (*_NSGetEnviron())
+#elif defined (__BORLANDC__)
+ extern char **environ;
+#endif
+
+
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Environment variables:\n");
+ do {
+ p = (char*)environ[i++];
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh),"\t%s\n",p);
+ } while ((char*)environ[i] != '\0');
+}
+
+static void disable_taf(
+ imp_dbh_t *imp_dbh) {
+
+ sword status;
+ OCIFocbkStruct tafailover;
+
+ tafailover.fo_ctx = NULL;
+ tafailover.callback_function = NULL;
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER,
+ (dvoid *) &tafailover, (ub4) 0,
+ (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
+ return;
+}
+
+static int enable_taf(
+ SV *dbh,
+ imp_dbh_t *imp_dbh) {
+
+ bool can_taf = 0;
+ sword status;
+
+#ifdef OCI_ATTR_TAF_ENABLED
+ OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
+ OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
#endif
- PerlIO_printf(fp, "Environment variables:\n");
- do {
- p = (char*)environ[i++];
- PerlIO_printf(fp,"\t%s\n",p);
- } while ((char*)environ[i] != '\0');
+
+ if (!can_taf){
+ croak("You are attempting to enable TAF on a server that is not TAF Enabled \n");
+ }
+
+ status = reg_taf_callback(dbh, imp_dbh);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status, "Setting TAF Callback Failed! ");
+ return 0;
+ }
+ return 1;
}
+
+
@@ -1,313 +1,402 @@
/*
- $Id: dbdimp.h,v 1.45 2003/03/21 17:27:44 timbo Exp $
+ Copyright (c) 1994-2006 Tim Bunce
+ Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada
- Copyright (c) 1994,1995,1996,1997,1998,1999 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,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
+ See the COPYRIGHT section in the Oracle.pm file for terms.
*/
+/* ====== define data types ====== */
+typedef struct taf_callback_st taf_callback_t;
-/* ====== Include Oracle Header Files ====== */
-
-#ifndef CAN_PROTOTYPE
-#define signed /* Oracle headers use signed */
-#endif
-
-/* The following define avoids a problem with Oracle >=7.3 where
- * ociapr.h has the line:
- * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ...
- * In some compilers that clashes with perls 'opcode' enum definition.
- */
-#define opcode opcode_redefined
-
-/* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */
-#if defined(__osf__) && defined(__alpha)
-#ifndef A_OSF
-#define A_OSF
-#endif
-#endif
-
-/* egcs-1.1.2 does not have _int64 */
-#if defined(__MINGW32__) || defined(__CYGWIN32__)
-#define _int64 long long
-#endif
-
-
-/* This is slightly backwards because we want to auto-detect OCI8 */
-/* and thus the existance of oci.h while still working for Oracle7 */
-#include <oratypes.h>
-#include <ocidfn.h>
-
-#if defined(SQLT_NTY) && !defined(NO_OCI8) /* === use Oracle 8 === */
-
-/* ori.h uses 'dirty' as an arg name in prototypes so we use this */
-/* hack to prevent ori.h being read (since we don't need it) */
-#define ORI_ORACLE
-
-#include <oci.h>
-
-#else /* === use Oracle 7 === */
-
-#ifdef CAN_PROTOTYPE
-# include <ociapr.h>
-#else
-# include <ocikpr.h>
-#endif
-
-#ifndef HDA_SIZE
-#define HDA_SIZE 512
-#endif
-
-#endif /* === ------------ === */
-
-/* ------ end of Oracle include files ------ */
-
-
-
-/* ====== define data types ====== */
+struct taf_callback_st {
+ SV *function; /*User supplied TAF functiomn*/
+ SV *dbh_ref;
+};
typedef struct imp_fbh_st imp_fbh_t;
struct imp_drh_st {
- dbih_drc_t com; /* MUST be first element in structure */
-#ifdef OCI_V8_SYNTAX
- OCIEnv *envhp;
-#endif
- SV *ora_long;
- SV *ora_trunc;
- SV *ora_cache;
- SV *ora_cache_o; /* for ora_open() cache override */
+ dbih_drc_t com; /* MUST be first element in structure */
+ OCIEnv *envhp;
+ SV *ora_long;
+ SV *ora_trunc;
+ SV *ora_cache;
+ SV *ora_cache_o; /* for ora_open() cache override */
};
-
/* Define dbh implementor data structure */
struct imp_dbh_st {
- dbih_dbc_t com; /* MUST be first element in structure */
+ dbih_dbc_t com; /* MUST be first element in structure */
#ifdef USE_ITHREADS
- int refcnt ; /* keep track of duped handles. MUST be first after com */
- struct imp_dbh_st * shared_dbh ; /* pointer to shared space from which to dup and keep refcnt */
- SV * shared_dbh_priv_sv ;
+ int refcnt ; /* keep track of duped handles. MUST be first after com */
+ struct imp_dbh_st * shared_dbh ; /* pointer to shared space from which to dup and keep refcnt */
+ SV * shared_dbh_priv_sv ;
#endif
-#ifdef OCI_V8_SYNTAX
- void *(*get_oci_handle) _((imp_dbh_t *imp_dbh, int handle_type, int flags));
- OCIEnv *envhp; /* copy of drh pointer */
- OCIError *errhp;
- OCIServer *srvhp;
- OCISvcCtx *svchp;
- OCISession *authp;
-#else
- Lda_Def ldabuf;
- Lda_Def *lda; /* points to ldabuf */
- ub1 hdabuf[HDA_SIZE];
- ub1 *hda; /* points to hdabuf */
+ void *(*get_oci_handle) _((imp_dbh_t *imp_dbh, int handle_type, int flags));
+ OCIEnv *envhp; /* copy of drh pointer */
+ OCIError *errhp;
+ OCIServer *srvhp;
+ OCISvcCtx *svchp;
+ OCISession *seshp;
+#ifdef ORA_OCI_112
+ OCIAuthInfo *authp;
+ OCISPool *poolhp;
+ text *pool_name;
+ ub4 pool_namel;
+ bool using_drcp;
+ text *pool_class;
+ ub4 pool_classl;
+ ub4 pool_min;
+ ub4 pool_max;
+ ub4 pool_incr;
+ char *driver_name;/*driver name user defined*/
#endif
-
- int RowCacheSize;
- int ph_type; /* default oratype for placeholders */
-
+ SV *taf_function; /*User supplied TAF functiomn*/
+ taf_callback_t taf_ctx;
+ char *client_info; /*user defined*/
+ ub4 client_infol;
+ char *module_name; /*module user defined */
+ ub4 module_namel;
+ char *client_identifier; /*user defined*/
+ ub4 client_identifierl;
+ char *action; /*user defined*/
+ ub4 actionl;
+ int RowCacheSize; /* both of these are defined by DBI spec*/
+ int RowsInCache; /* this vaue is RO and cannot be set*/
+ int ph_type; /* default oratype for placeholders */
+ ub1 ph_csform; /* default charset for placeholders */
+ int parse_error_offset; /* position in statement of last error */
+ int max_nested_cursors; /* limit on cached nested cursors per stmt */
+ int array_chunk_size; /* the max size for an array bind */
+ ub4 server_version; /* version of Oracle server */
};
#define DBH_DUP_OFF sizeof(dbih_dbc_t)
#define DBH_DUP_LEN (sizeof(struct imp_dbh_st) - sizeof(dbih_dbc_t))
-typedef struct lob_refetch_st lob_refetch_t;
-/* Define sth implementor data structure */
+typedef struct lob_refetch_st lob_refetch_t; /* Define sth implementor data structure */
+
+
+/*statement structure */
struct imp_sth_st {
- dbih_stc_t com; /* MUST be first element in structure */
-
-#ifdef OCI_V8_SYNTAX
- void *(*get_oci_handle) _((imp_sth_t *imp_sth, int handle_type, int flags));
- OCIEnv *envhp; /* copy of dbh pointer */
- OCIError *errhp; /* copy of dbh pointer */
- OCIServer *srvhp; /* copy of dbh pointer */
- OCISvcCtx *svchp; /* copy of dbh pointer */
- OCIStmt *stmhp;
- ub2 stmt_type; /* OCIAttrGet OCI_ATTR_STMT_TYPE */
- U16 auto_lob;
- int has_lobs;
- lob_refetch_t *lob_refetch;
-#else
- Cda_Def *cda; /* normally just points to cdabuf below */
- Cda_Def cdabuf;
-#endif
- int disable_finish; /* fetched cursors can core dump in finish */
-
- /* Input Details */
- char *statement; /* sql (see sth_scan) */
- HV *all_params_hv; /* all params, keyed by name */
- AV *out_params_av; /* quick access to inout params */
- int ora_pad_empty; /* convert ""->" " when binding */
-
- /* Select Column Output Details */
- int done_desc; /* have we described this sth yet ? */
- imp_fbh_t *fbh; /* array of imp_fbh_t structs */
- char *fbh_cbuf; /* memory for all field names */
- int t_dbsize; /* raw data width of a row */
- IV long_readlen; /* local copy to handle oraperl */
-
- /* Select Row Cache Details */
- int cache_rows;
- int in_cache;
- int next_entry;
- int eod_errno;
- int est_width; /* est'd avg row width on-the-wire */
-
- /* (In/)Out Parameter Details */
- bool has_inout_params;
+
+ dbih_stc_t com; /* MUST be first element in structure */
+
+ void *(*get_oci_handle) _((imp_sth_t *imp_sth, int handle_type, int flags));
+ OCIEnv *envhp; /* copy of dbh pointer */
+ OCIError *errhp; /* copy of dbh pointer */
+ OCIServer *srvhp; /* copy of dbh pointer */
+ OCISvcCtx *svchp; /* copy of dbh pointer */
+ OCIStmt *stmhp; /* oci statement handle */
+ OCIDescribe *dschp; /* oci describe handle */
+ int is_child; /* if this is child from a ref cursor or SP*/
+ ub2 stmt_type; /* OCIAttrGet OCI_ATTR_STMT_TYPE */
+ U16 auto_lob; /* use auto lobs*/
+ int pers_lob; /*use dblink for lobs only for 10g Release 2. or later*/
+ int clbk_lob; /*use dblink for lobs only for 10g Release 2. or later*/
+ int piece_lob; /*use piece fetch for lobs*/
+ ub4 piece_size; /*used in callback to set the size of the piece to get*/
+ int has_lobs; /*Statement has bound LOBS */
+ int ret_lobs; /*Statement returns LOBS */
+ lob_refetch_t *lob_refetch;
+ int nested_cursor; /* cursors fetched from SELECTs */
+ AV *bind_tuples; /* Bind tuples in array execute, or NULL */
+ int rowwise; /* If true, bind_tuples is list of */
+ /* tuples, otherwise list of columns. */
+ /* Input Details */
+ char *statement; /* sql (see sth_scan) */
+ HV *all_params_hv; /* all params, keyed by name */
+ AV *out_params_av; /* quick access to inout params */
+ int ora_pad_empty; /* convert ""->" " when binding */
+
+ /* Select Column Output Details */
+ int done_desc; /* have we described this sth yet ? */
+ imp_fbh_t *fbh; /* array of imp_fbh_t structs */
+ char *fbh_cbuf; /* memory for all field names */
+ int t_dbsize; /* raw data width of a row */
+ UV long_readlen; /* local copy to handle oraperl */
+ HV *fbh_tdo_hv; /* hash of row #(0 based) and tdo object name from ora_oci_type_names hash */
+ /* Select Row Cache Details */
+ sb4 cache_rows;
+ int in_cache;
+ int next_entry;
+ int eod_errno;
+ int est_width; /* est'd avg row width on-the-wire */
+ /* (In/)Out Parameter Details */
+ bool has_inout_params;
+ /* execute mode*/
+ /* will be using this alot later me thinks */
+ ub4 exe_mode;
+ /* fetch scrolling values */
+ int fetch_orient;
+ int fetch_offset;
+ int fetch_position;
+ int prefetch_memory; /* OCI_PREFETCH_MEMORY*/
+ int prefetch_rows; /* OCI_PREFETCH_ROWS */
+ /* array fetch: state variables */
+ int row_cache_off;
+ int rs_fetch_count; /*fetch count*/
+ int rs_array_size; /*array size local value for RowCacheSize as I do not want to change RowCacheSize */
+ int rs_array_num_rows; /* num rows in last fetch */
+ int rs_array_idx; /* index of current row */
+ sword rs_array_status; /* status of last fetch */
+ int RowCacheSize; /* both of these are defined by DBI spec*/
+ int RowsInCache; /* this vaue is RO and cannot be set*/
+
};
#define IMP_STH_EXECUTING 0x0001
-typedef struct fb_ary_st fb_ary_t; /* field buffer array */
+typedef struct fb_ary_st fb_ary_t; /* field buffer array */
struct fb_ary_st { /* field buffer array EXPERIMENTAL */
- ub2 bufl; /* length of data buffer */
- sb2 *aindp; /* null/trunc indicator variable */
- ub1 *abuf; /* data buffer (points to sv data) */
- ub2 *arlen; /* length of returned data */
- ub2 *arcode; /* field level error status */
+ ub4 bufl; /* length of data buffer */
+ ub4 cb_bufl; /* length of piece of data fetched in callback.*/
+ ub4 piece_count;/*# of pieces retrieved*/
+ sb2 *aindp; /* null/trunc indicator variable */
+ ub1 *abuf; /* data buffer (points to sv data) */
+ ub1 *cb_abuf; /*yet another buffer for picewise callbacks this means I only need to allocate memory once a prepare rather than at each fetch*/
+ ub2 *arlen; /* length of returned data */
+ ub2 *arcode; /* field level error status */
};
-struct imp_fbh_st { /* field buffer EXPERIMENTAL */
- imp_sth_t *imp_sth; /* 'parent' statement */
- int field_num; /* 0..n-1 */
-
- /* Oracle's description of the field */
-#ifdef OCI_V8_SYNTAX
- OCIParam *parmdp;
- OCIDefine *defnp;
- void *desc_h; /* descriptor if needed (LOBs etc) */
- ub4 desc_t; /* OCI type of descriptorh */
- int (*fetch_func) _((SV *sth, imp_fbh_t *fbh, SV *dest_sv));
- ub2 dbsize;
- ub2 dbtype; /* actual type of field (see ftype) */
- ub2 prec; /* XXX docs say ub1 but ub2 is needed */
- sb1 scale;
- ub1 nullok;
- char *bless; /* for Oracle::OCI style handle data */
- void *special; /* hook for special purposes (LOBs etc) */
-#else
- sb4 dbsize;
- sb2 dbtype; /* actual type of field (see ftype) */
- sb2 prec;
- sb2 scale;
- sb2 nullok;
- sb4 cbufl; /* length of select-list item 'name' */
-#endif
- SV *name_sv; /* only set for OCI8 */
- char *name;
- sb4 disize; /* max display/buffer size */
- /* Our storage space for the field data as it's fetched */
- sword ftype; /* external datatype we wish to get */
- fb_ary_t *fb_ary; /* field buffer array */
-};
+typedef struct fbh_obj_st fbh_obj_t; /*Ebbedded Object Descriptor */
+
+struct fbh_obj_st { /* embedded object or table will work recursively*/
+ text *type_name; /*object's name (TDO)*/
+ ub4 type_namel; /*length of the name*/
+ OCIParam *parmdp; /*Describe attributes of the object OCI_DTYPE_PARAM*/
+ OCIParam *parmap; /*Describe attributes of the object OCI_ATTR_COLLECTION_ELEMENT OCI_ATTR_PARAM*/
+ OCIType *tdo; /*object's TDO handle */
+ OCITypeCode typecode; /*object's OOCI_ATTR_TYPECODE */
+ OCITypeCode col_typecode; /*if collection this is its OCI_ATTR_COLLECTION_TYPECODE */
+ OCITypeCode element_typecode; /*if collection this is its element's OCI_ATTR_TYPECODE*/
+ OCIRef *obj_ref; /*if an embeded object this is ref handle to its TDO*/
+ OCIInd *obj_ind; /*Null indictator for object */
+ OCIComplexObject *obj_value; /*the actual value from the DB*/
+ OCIType *obj_type; /*if an embeded object this is the OCIType returned by a OCIObjectPin*/
+ ub1 is_final_type; /*object's OCI_ATTR_IS_FINAL_TYPE*/
+ fbh_obj_t *fields; /*one object for each field/property*/
+ ub2 field_count; /*The number of fields Not really needed but nice to have*/
+ fbh_obj_t *next_subtype; /*There is strored information about subtypes for inteherited objects*/
+ AV *value; /*The value to send back to Perl This way there are no memory leaks*/
+ SV *full_type_name; /*Perl value of full type name = schema_name "." type_name*/
+};
-typedef struct phs_st phs_t; /* scalar placeholder */
+struct imp_fbh_st { /* field buffer EXPERIMENTAL */
+ imp_sth_t *imp_sth; /* 'parent' statement */
+ int field_num; /* 0..n-1 */
+
+ /* Oracle's description of the field */
+ OCIParam *parmdp;
+ OCIDefine *defnp;
+ void *desc_h; /* descriptor if needed (LOBs, cursors etc) */
+ ub4 desc_t; /* OCI type of descriptor */
+ ub4 define_mode; /*the normal case for a define*/
+ int (*fetch_func) _((SV *sth, imp_fbh_t *fbh, SV *dest_sv));
+ void (*fetch_cleanup) _((SV *sth, imp_fbh_t *fbh));
+ ub2 dbtype; /* actual type of field (see ftype) */
+ ub2 dbsize;
+ ub2 prec; /* XXX docs say ub1 but ub2 is needed */
+ sb1 scale;
+ ub1 nullok;
+ char *name;
+ SV *name_sv; /* only set for OCI8 */
+ /* OCI docs say OCI_ATTR_CHAR_USED is ub4, they're wrong */
+ ub1 len_char_used; /* OCI_ATTR_CHAR_USED */
+ ub2 len_char_size; /* OCI_ATTR_CHAR_SIZE */
+ ub2 csid; /* OCI_ATTR_CHARSET_ID */
+ ub1 csform; /* OCI_ATTR_CHARSET_FORM */
+ ub4 disize; /* max display/buffer size */
+ ub4 piece_size; /*used in callback to set the size of the piece to get*/
+ char *bless; /* for Oracle::OCI style handle data */
+ void *special; /* hook for special purposes (LOBs etc) */
+ int pers_lob; /*for persistant lobs 10g Release 2. or later*/
+ int clbk_lob; /*for persistant lobs 10g Release 2. or later*/
+ int piece_lob; /*use piecewise fetch for lobs*/
+
+ /* Our storage space for the field data as it's fetched */
+
+ sword ftype; /* external datatype we wish to get */
+ IV req_type; /* type passed to bind_col */
+ UV bind_flags; /* flags passed to bind_col */
+ fb_ary_t *fb_ary ; /* field buffer array */
+ /* if this is an embedded object we use this */
+ fbh_obj_t *obj;
+
+
+ };
+
+ /* Placeholder structure */
+ /* Note: phs_t is serialized into scalar value, and de-serialized then. */
+ /* Be carefull! */
+
+typedef struct phs_st phs_t; /* scalar placeholder */
+
+struct phs_st { /* scalar placeholder EXPERIMENTAL */
+ imp_sth_t *imp_sth; /* 'parent' statement */
+ sword ftype; /* external OCI field type */
+
+ SV *sv; /* the scalar holding the value */
+ U32 sv_type; /* original sv type at time of bind */
+ ub2 csid_orig; /* original oracle default csid */
+ ub2 csid; /* 0 for automatic */
+ ub1 csform; /* 0 for automatic */
+ ub4 maxdata_size; /* set OCI_ATTR_MAXDATA_SIZE if >0 */
+ bool is_inout;
+
+ IV maxlen; /* max possible len (=allocated buffer) */
+ /* Note: for array bind = buffer for each entry */
+ OCIBind *bndhp;
+ void *desc_h; /* descriptor if needed (LOBs etc) */
+ ub4 desc_t; /* OCI type of desc_h */
+ ub4 alen;
+ ub2 arcode;
+ int idx; /* 0-based index for ?/:1 style, or -1 */
+
+ sb2 indp; /* null indicator */
+ char *progv;
+
+ int(*out_prepost_exec)_((SV *, imp_sth_t *, phs_t *, int pre_exec));
+ SV *ora_field; /* from attribute (for LOB binds) */
+ ub4 alen_incnull; /* 0 or 1 if alen should include null */
+ /* Array bind support */
+ char *array_buf; /* Temporary buffer = malloc(array_buflen) */
+ int array_buflen; /* Allocated length of array_buf */
+ int array_numstruct; /* Number of bound structures in buffer */
+ OCIInd *array_indicators; /* Indicator array = malloc( array_numallocated * sizeof(OCIInd) ) */
+ unsigned short *array_lengths; /* Array entries lengths = malloc( array_numallocated * sizeof(unsigned short) ) */
+ int array_numallocated; /* Allocated number of indicators/lengths */
+ int ora_maxarray_numentries; /* Number of entries to send allocated to Oracle. (may be less, than total allocated) */
+
+ /* Support for different internal C-types, representing Oracle data */
+ int ora_internal_type; /* Which C-type would be bound instead of SQLT_CHR. */
+
+ char name[1]; /* struct is malloc'd bigger as needed */
+};
-struct phs_st { /* scalar placeholder EXPERIMENTAL */
- imp_sth_t *imp_sth; /* 'parent' statement */
- sword ftype; /* external OCI field type */
- SV *sv; /* the scalar holding the value */
- int sv_type; /* original sv type at time of bind */
- bool is_inout;
+/* ------ define functions and external variables ------ */
- IV maxlen; /* max possible len (=allocated buffer) */
- sb4 maxlen_bound; /* and Oracle bind has been called */
+extern int ora_fetchtest;
+extern int dbd_verbose;
+extern int oci_warn;
+extern int ora_objects;
+extern int ora_ncs_buff_mtpl;
+extern ub2 charsetid;
+extern ub2 ncharsetid;
+extern ub2 us7ascii_csid;
+extern ub2 utf8_csid;
+extern ub2 al32utf8_csid;
+extern ub2 al16utf16_csid;
-#ifdef OCI_V8_SYNTAX
- OCIBind *bndhp;
- void *desc_h; /* descriptor if needed (LOBs etc) */
- ub4 desc_t; /* OCI type of desc_h */
- ub4 alen;
-#else
- ub2 alen; /* effective length ( <= maxlen ) */
-#endif
- ub2 arcode;
+#define CS_IS_UTF8( cs ) \
+ ( ( cs == utf8_csid ) || ( cs == al32utf8_csid ) )
- sb2 indp; /* null indicator */
- char *progv;
+#define CS_IS_NOT_UTF8_COMPATIBLE( cs ) \
+ ( cs == us7ascii_csid )
- int (*out_prepost_exec)_((SV *, imp_sth_t *, phs_t *, int pre_exec));
- SV *ora_field; /* from attribute (for LOB binds) */
- int alen_incnull; /* 0 or 1 if alen should include null */
- char name[1]; /* struct is malloc'd bigger as needed */
-};
+ #define CS_IS_UTF16( cs ) ( cs == al16utf16_csid )
-/* ------ define functions and external variables ------ */
+#define CSFORM_IMPLIED_CSID(csform) \
+ ((csform==SQLCS_NCHAR) ? ncharsetid : charsetid)
-extern int ora_fetchtest;
+#define CSFORM_IMPLIES_UTF8(csform) \
+ CS_IS_UTF8( CSFORM_IMPLIED_CSID( csform ) )
-#ifdef UTF8_SUPPORT
-extern int cs_is_utf8;
-#endif
void dbd_init_oci _((dbistate_t *dbistate));
void dbd_preparse _((imp_sth_t *imp_sth, char *statement));
-void dbd_fbh_dump _((imp_fbh_t *fbh, int i, int aidx));
-void ora_free_fbh_contents _((imp_fbh_t *fbh));
+void dbd_fbh_dump(imp_sth_t *imp_sth, imp_fbh_t *fbh, int i, int aidx);
+void ora_free_fbh_contents _((SV *sth, imp_fbh_t *fbh));
+void ora_free_templob _((SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc));
int ora_dbtype_is_long _((int dbtype));
-int calc_cache_rows _((int num_fields, int est_width, int cache_rows, int has_longs));
-fb_ary_t *fb_ary_alloc _((int bufl, int size));
+fb_ary_t *fb_ary_alloc _((ub4 bufl, int size));
+fb_ary_t *fb_ary_cb_alloc _((ub4 piece_size,ub4 max_len, int size));
+
int ora_db_reauthenticate _((SV *dbh, imp_dbh_t *imp_dbh, char *uid, char *pwd));
-void dbd_phs_sv_complete _((phs_t *phs, SV *sv, I32 debug));
-void dbd_phs_avsv_complete _((phs_t *phs, I32 index, I32 debug));
+void dbd_phs_sv_complete _((imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug));
+void dbd_phs_avsv_complete _((imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug));
-#define OTYPE_IS_LONG(t) ((t)==8 || (t)==24 || (t)==94 || (t)==95)
+int pp_exec_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec));
+int pp_rebind_ph_rset_in _((SV *sth, imp_sth_t *imp_sth, phs_t *phs));
-#ifdef OCI_V8_SYNTAX
+#define OTYPE_IS_LONG(t) ((t)==8 || (t)==24 || (t)==94 || (t)==95)
-int oci_error _((SV *h, OCIError *errhp, sword status, char *what));
+int oci_error_err _((SV *h, OCIError *errhp, sword status, char *what, sb4 force_err));
+#define oci_error(h, errhp, status, what) oci_error_err(h, errhp, status, what, 0)
char *oci_stmt_type_name _((int stmt_type));
+char *oci_typecode_name _((int typecode));
+char *sql_typecode_name _((int dbtype));
char *oci_status_name _((sword status));
-char * oci_hdtype_name _((ub4 hdtype));
+char *oci_mode _((ub4 mode));
+char *oci_bind_options _((ub4 options));
+char *oci_define_options _((ub4 options));
+char *oci_hdtype_name _((ub4 hdtype));
+char *oci_attr_name _((ub4 attr));
+char *oci_exe_mode _((ub4 mode));
+char *dbd_yes_no _((int yes_no));
+char *oci_col_return_codes _((int rc));
+char *oci_csform_name _((ub4 attr));
+/*char *oci_sql_function_code_name _((int sqlfncode));
+ char *oci_ptype_name _((int ptype));*/
+
int dbd_rebind_ph_lob _((SV *sth, imp_sth_t *imp_sth, phs_t *phs));
+
+int dbd_rebind_ph_nty _((SV *sth, imp_sth_t *imp_sth, phs_t *phs));
+
+int ora_st_execute_array _((SV *sth, imp_sth_t *imp_sth, SV *tuples,
+ SV *tuples_status, SV *columns, ub4 exe_count, SV *err_count));
+
+
+SV * ora_create_xml _((SV *dbh, char *source));
+
void ora_free_lob_refetch _((SV *sth, imp_sth_t *imp_sth));
-void dbd_phs_avsv_complete _((phs_t *phs, I32 index, I32 debug));
-void dbd_phs_sv_complete _((phs_t *phs, SV *sv, I32 debug));
+void dbd_phs_avsv_complete _((imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug));
+void dbd_phs_sv_complete _((imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug));
int post_execute_lobs _((SV *sth, imp_sth_t *imp_sth, ub4 row_count));
ub4 ora_parse_uid _((imp_dbh_t *imp_dbh, char **uidp, char **pwdp));
char *ora_sql_error _((imp_sth_t *imp_sth, char *msg));
+char *ora_env_var(char *name, char *buf, unsigned long size);
+
+#ifdef __CYGWIN32__
+void ora_cygwin_set_env(char *name, char *value);
+
+#endif /* __CYGWIN32__ */
sb4 dbd_phs_in _((dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index,
- dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp));
+ dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp));
sb4 dbd_phs_out _((dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index,
- dvoid **bufpp, ub4 **alenpp, ub1 *piecep,
- dvoid **indpp, ub2 **rcodepp));
+ dvoid **bufpp, ub4 **alenpp, ub1 *piecep,
+ dvoid **indpp, ub2 **rcodepp));
+sb4 presist_lob_fetch_cbk _((dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp,
+ ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcpp));
int dbd_rebind_ph_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs));
void * oci_db_handle(imp_dbh_t *imp_dbh, int handle_type, int flags);
void * oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags);
+void fb_ary_free(fb_ary_t *fb_ary);
+void rs_array_init(imp_sth_t *imp_sth);
-#else /* is OCI 7 */
-
-void ora_error _((SV *h, Lda_Def *lda, int rc, char *what));
-
-#endif /* OCI_V8_SYNTAX */
-
-#include "ocitrace.h"
-
-
+ub4 ora_db_version _((SV *dbh, imp_dbh_t *imp_dbh));
+sb4 reg_taf_callback _((SV *dbh, imp_dbh_t *imp_dbh));
/* These defines avoid name clashes for multiple statically linked DBD's */
-#define dbd_init ora_init
+#define dbd_init ora_init
#define dbd_db_login ora_db_login
#define dbd_db_login6 ora_db_login6
-#define dbd_db_do ora_db_do
+#define dbd_db_do ora_db_do
#define dbd_db_commit ora_db_commit
#define dbd_db_rollback ora_db_rollback
#define dbd_db_cancel ora_db_cancel
@@ -316,7 +405,7 @@ void ora_error _((SV *h, Lda_Def *lda, int rc, char *what));
#define dbd_db_STORE_attrib ora_db_STORE_attrib
#define dbd_db_FETCH_attrib ora_db_FETCH_attrib
#define dbd_st_prepare ora_st_prepare
-#define dbd_st_rows ora_st_rows
+#define dbd_st_rows ora_st_rows
#define dbd_st_cancel ora_st_cancel
#define dbd_st_execute ora_st_execute
#define dbd_st_fetch ora_st_fetch
@@ -326,7 +415,9 @@ void ora_error _((SV *h, Lda_Def *lda, int rc, char *what));
#define dbd_st_STORE_attrib ora_st_STORE_attrib
#define dbd_st_FETCH_attrib ora_st_FETCH_attrib
#define dbd_describe ora_describe
-#define dbd_bind_ph ora_bind_ph
+#define dbd_bind_ph ora_bind_ph
+#define dbd_st_bind_col ora_st_bind_col
+#include "ocitrace.h"
/* end */
@@ -0,0 +1,52 @@
+/* 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 */
@@ -0,0 +1,38 @@
+This directory contains a few sample DBI/DBD::Oracle scripts. Some are
+genuinely useful while others are just demonstrations of different things.
+They are adapted from the Oraperl example scripts in ../Oraperl.ex/ to
+show how to do the same things in Perl 5 and DBI.
+
+$dbh->{RaiseError} is set to 1 in all scripts for automatic error checking.
+
+bind.pl Demonstrates how execute() and fetchrow_array() may be
+ combined to make a simple table lookup program with placeholders.
+
+commit.pl Demonstrates the use of commit() and rollback().
+
+curref.pl Demonstrates how to use a cursor bind variable.
+
+ex.pl Reads data from a table and prints it using a format.
+ Also illustrates how to recognise NULL fields and bind_columns
+ with known column names.
+
+japh Just another Perl hacker, written for DBI.
+ This is no one-liner, but it demonstrates a few things.
+
+mktable.pl Creates a table, puts some data into it, drops it.
+ Demonstrates do(), placeholders, inserting and reading NULL values,
+ and bind_columns() with known columns.
+
+oradump.pl Dumps an Oracle table as a set of INSERT statements.
+ Demonstrates the use of $sth->{TYPE}, $dbh->quote(),
+ and bind_columns() with unknown column names.
+
+proc.pl Demonstrates how to get values into and out of stored procedures
+ and how to receive result sets.
+
+sql Demonstrates the use of $sth->{NUM_OF_FIELDS}, $sth->{NAME},
+ $sth->{PRECISION}, and bind_columns() with unknown column names.
+
+tabinfo.pl Displays the structure of the specified table.
+ Demonstrates the use of $sth->{NAME}, $sth->{PRECISION},
+ $sth->{TYPE}, and type_info_all().
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+#
+# bind.pl
+#
+# This shows how a placeholder may be used to implement a simple lookup.
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+# Prepare the SELECT statement using a placeholder
+my $sth = $dbh->prepare( 'SELECT created FROM all_users WHERE username = ?' );
+
+my ( $created );
+$| = 1;
+print "Enter an empty line to finish\n";
+print "Userid? ";
+while ( <STDIN> ) {
+ chomp;
+ last if ! $_;
+ $sth->execute( uc( $_ ) );
+
+ # Note that the variable is in parenthesis to give an array context
+ if ( ( $created ) = $sth->fetchrow_array ) {
+ print "$created\n";
+ }
+ else {
+ print "unknown\n";
+ }
+ print "Userid? ";
+}
+
+$sth->finish;
+$dbh->disconnect;
@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+#
+# commit.pl
+#
+# Simple example of using commit and rollback.
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+# Create the table to hold prime numbers
+print "Creating table\n";
+eval { $dbh->do( 'CREATE TABLE primes ( prime NUMBER )' ); };
+warn $@ if $@;
+
+print "Loading table";
+my $sth = $dbh->prepare( 'INSERT INTO primes VALUES ( ? )' );
+while ( <DATA> ) {
+ chomp;
+ print " $_";
+ $sth->execute( $_ );
+ print " commit (", $dbh->commit, ")" if 11 == $_;
+}
+print "\n";
+
+my $prime;
+print "Reading table for the first time\n";
+$sth = $dbh->prepare( 'SELECT prime FROM primes ORDER BY prime' );
+$sth->execute;
+$sth->bind_columns( {}, \$prime );
+while ( $sth->fetch ) {
+ print " $prime";
+}
+$sth->finish;
+print "\n";
+
+print "rollback (", $dbh->rollback, ")\n";
+
+print "Reading table for the second time.\n";
+$sth->execute;
+$sth->bind_columns( {}, \$prime );
+while ( $sth->fetch ) {
+ print " $prime";
+}
+$sth->finish;
+print "\n";
+
+$dbh->do( 'DROP TABLE primes' );
+print "Table Dropped\n";
+$dbh->disconnect;
+__END__
+2
+3
+5
+7
+11
+13
+17
+19
+23
+29
@@ -0,0 +1,107 @@
+#!/usr/bin/env perl
+#
+# curref.pl - by Geoffrey Young
+#
+# for this example, we create a package that contains
+# two procedures:
+# emp_cursor - returns a specific cursor reference
+# ref_cursor_close - closes any cursor reference
+#
+# to actually run this example as is, you will need the
+# oracle demo tables. otherwise, it's just sample code...
+
+use DBI;
+use DBD::Oracle qw(:ora_types);
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+my $sql = qq(
+ CREATE OR REPLACE PACKAGE curref_test
+ IS
+ TYPE cursor_ref IS REF CURSOR;
+ PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref);
+ PROCEDURE ref_cursor_close (curref IN cursor_ref);
+ END;
+);
+my $rv = $dbh->do($sql);
+print "The package has been created...\n";
+
+$sql = qq(
+ CREATE OR REPLACE PACKAGE BODY curref_test
+ IS
+ PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref)
+ IS
+ BEGIN
+ OPEN curref FOR select ename, job from emp where job = job_in;
+ END;
+
+ PROCEDURE ref_cursor_close (curref IN cursor_ref)
+ IS
+ BEGIN
+ close curref;
+ END;
+ END;
+);
+$rv = $dbh->do($sql);
+print "The package body has been created...\n";
+
+print "These are the results from the ref cursor:\n";
+$sql = qq(
+ BEGIN
+ curref_test.emp_cursor(:job_in, :curref);
+ END;
+);
+my $curref;
+my $sth = $dbh->prepare($sql);
+$sth->bind_param(":job_in", "CLERK");
+$sth->bind_param_inout(":curref", \$curref, 0, {ora_type => ORA_RSET});
+$sth->execute;
+$curref->dump_results;
+open_cursors();
+
+$sql = qq(
+ BEGIN
+ curref_test.ref_cursor_close(:curref);
+ END;
+);
+$sth = $dbh->prepare($sql);
+$sth->bind_param(":curref", $curref, {ora_type => ORA_RSET});
+$sth->execute;
+
+print "The cursor is now closed\n";
+print "just to prove it...\n";
+open_cursors();
+
+$sql = "DROP PACKAGE curref_test"; # Also drops PACKAGE BODY
+$rv = $dbh->do($sql);
+print "The package has been dropped...\n";
+
+$dbh->disconnect;
+
+sub open_cursors {
+ eval {
+ $sth = $dbh->prepare(
+ 'SELECT user, sql_text FROM sys.v_$open_cursor ORDER BY user, sql_text');
+ $sth->execute;
+ print "Here are the open cursors:\n";
+ $sth->dump_results;
+ };
+ if ( $@ ) {
+ print "Unable to SELECT from SYS.V_\$OPEN_CURSOR:\n";
+ if ( 942 == $DBI::err ) {
+ print " User $user needs SELECT permission.\n";
+ }
+ else { print "$@\n"; }
+ }
+}
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+# Short example using bind_columns() to list a table's values
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass [max]" if 3 > @ARGV;
+my ( $inst, $user, $pass, $max ) = @ARGV;
+$max = 20 if ! $max || 0 > $max;
+
+my ( $name, $id, $created );
+format STDOUT_TOP =
+ Name ID Created
+ ============================== ========= =========
+.
+
+format STDOUT =
+ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @<<<<<<<<
+ $name, $id, $created
+.
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare(
+ "SELECT username, user_id, created FROM all_users ORDER BY username" );
+$sth->execute;
+
+my $nfields = $sth->{NUM_OF_FIELDS};
+print "Query will return $nfields fields\n\n";
+
+$sth->bind_columns( {}, \( $name, $id, $created ) );
+while ( $sth->fetch ) {
+ last if ! --$max;
+ # mark any NULL fields found
+ foreach ( $name, $id, $created ) { $_ = 'NULL' if ! defined; }
+ write;
+}
+
+$sth->finish;
+$dbh->disconnect;
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use DBI;
+
+my $db = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' );
+
+my $table = 'TABLE';
+my %clauses;
+my %attrib;
+my @types;
+my $longrawtype;
+my @row;
+
+# Assuming the existence of @row and an associative array (%clauses) containing the
+# column names and placeholders, and an array @types containing column types ...
+
+my $ih = $db->prepare("INSERT INTO $table ($clauses{names})
+ VALUES ($clauses{places})")
+ or die "prepare insert into $table: " . $db->errstr;
+
+$attrib{'ora_type'} = $longrawtype; # $longrawtype == 24
+
+##-- bind the parameter for each of the columns
+for my $i ( 0..$#types ) {
+
+ ##-- long raw values must have their type attribute explicitly specified
+ if ($types[$i] == $longrawtype) {
+ $ih->bind_param($i+1, $row[$i], \%attrib)
+ || die "binding placeholder for LONG RAW " . $db->errstr;
+ }
+ ##-- other values work OK with the default attributes
+ else {
+ $ih->bind_param($i+1, $row[$i])
+ || die "binding placeholder" . $db->errstr;
+ }
+}
+
+$ih->execute || die "execute INSERT into $table: " . $db->errstr;
+
+
@@ -0,0 +1,52 @@
+#!/usr/bin/perl -w
+# This is an example of how we could code a JAPH using DBI and DBD::Oracle.
+#
+# Original oraperl script by Kevin Stock
+# Date: 1st December 1992
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+# Create the sample table
+$dbh->do( "CREATE TABLE japh ( word CHAR(7), posn NUMBER(1) )" );
+
+# Loop to insert data into the table
+my $sth = $dbh->prepare( "INSERT INTO japh VALUES ( ?, ? )" );
+while ( <DATA> ) {
+ chomp;
+ $sth->execute( split ':', $_ );
+}
+
+# Now retrieve the data, printing it word by word
+$sth = $dbh->prepare( "SELECT word FROM japh ORDER BY posn" );
+$sth->execute;
+my $word;
+$sth->bind_columns( {}, \$word );
+$sth->{ChopBlanks} = 1; # Wouldn't you rather use VARCHAR2 instead of CHAR?
+while ( $sth->fetch ) {
+ print " $word";
+}
+$sth->finish;
+print "\n";
+
+# delete the table
+$dbh->do( 'DROP TABLE japh' );
+$dbh->disconnect;
+
+__END__
+DBI:3
+another:2
+hacker:4
+just:1
@@ -0,0 +1,102 @@
+#!/usr/bin/env perl
+# Sample DBI program to create a new table and load data into it.
+#
+# Author: Kevin Stock (original oraperl script)
+# Date: 5th August 1991
+# Date: 25th September 1992
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+# set these as strings to make the code more readable
+my $CREATE = "CREATE TABLE tryit ( name VARCHAR2(10), ext NUMBER(3) )";
+my $INSERT = "INSERT INTO tryit VALUES ( ?, ? )";
+my $LIST = "SELECT * FROM tryit ORDER BY name";
+my $DELETE = "DELETE FROM tryit WHERE name = ?";
+my $DELETE_NULL = "DELETE FROM tryit WHERE name IS NULL";
+my $DROP = "DROP TABLE tryit";
+
+# Can use dynamic variables in write as long as they are visible at format time
+my ( $msg, $name, $ext );
+
+# Prepare formats for output
+format STDOUT_TOP =
+
+ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $msg
+
+ Name Ext
+ ==== ===
+.
+
+format STDOUT =
+ @<<<<<<<<< @>>
+ $name, $ext
+.
+
+# function to list the table
+sub list {
+ $msg = join "\n", @_;
+ $- = 0;
+ my $sth = $dbh->prepare( $LIST );
+ $sth->execute;
+ $sth->bind_columns( {}, \( $name, $ext ) );
+ while ( $sth->fetch ) {
+ $name = '<NULL>' unless defined $name;
+ $ext = '<N>' unless defined $ext;
+ write;
+ }
+ $sth->finish;
+}
+
+# create the database
+$dbh->do( $CREATE );
+
+# put some data into it
+my $sth = $dbh->prepare( $INSERT );
+while ( <DATA> ) {
+ chomp;
+ $sth->execute( map { 'NULL' eq $_ ? undef : $_ } split /:/, $_, 2 );
+}
+$dbh->commit;
+list( 'Initial Data' );
+
+# remove a few rows
+$sth = $dbh->prepare( $DELETE );
+foreach $name ( 'catherine', 'angela', 'arnold', 'julia' ) {
+ $sth->execute( $name );
+}
+$dbh->commit;
+list( 'After removing selected people' );
+
+# Remove some rows with NULLs
+$dbh->do( $DELETE_NULL );
+list( 'After removing NULL names' );
+
+# remove the table and disconnect
+$dbh->do( $DROP );
+$dbh->disconnect;
+
+# This is the data which will go into the table
+__END__
+julia:292
+angela:208
+NULL:999
+larry:424
+catherine:201
+nonumber:NULL
+randal:306
+arnold:305
+NULL:NULL
@@ -0,0 +1,1765 @@
+#!/usr/bin/env perl
+
+################################################################################
+# Copyright (c) 1999 Alan Burlison
+#
+# 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 code is provided with no warranty of any kind, and is used entirely at
+# your own risk.
+#
+# This code was written by the author as a private individual, and is in no way
+# endorsed or warrantied by Sun Microsystems.
+#
+# Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
+#
+################################################################################
+
+use strict;
+use warnings;
+
+use File::Basename;
+use DBI;
+use Tk;
+use Tk::Balloon;
+use Tk::ErrorDialog;
+use Tk::ROText;
+
+################################################################################
+# Subclassed version of Tk::Tree that allows button3 to have a callback attached
+
+package Tk::B3Tree;
+use strict;
+use base qw(Tk::Tree);
+Construct Tk::Widget qw(B3Tree);
+
+sub ClassInit
+{
+my ($class, $mw) = @_;
+$class->SUPER::ClassInit($mw);
+$mw->bind($class, "<3>", "Button3");
+return $class;
+}
+
+sub Populate
+{
+my ($self, $args) = @_;
+$self->SUPER::Populate($args);
+$self->ConfigSpecs(-b3command => [ "CALLBACK", "b3command", "B3command",
+ undef ]);
+}
+
+sub Button3
+{
+my $w = shift;
+my $Ev = $w->XEvent;
+my $ent = $w->GetNearest($Ev->y);
+return unless (defined($ent) and length($ent));
+$w->Callback(-b3command => $ent);
+}
+
+################################################################################
+
+package main;
+use vars qw($VERSION);
+$VERSION = "1.1";
+
+# Globals
+# $ProgName Program name (without pathname)
+# $Db Database handle
+# $DbName Oracle database name
+# $User Oracle user name
+# $Schema Oracle schema name
+# $SqlMarker String used to identify SQL generated by explain
+# $OracleVersion Oracle version number
+# $CharWidth Width of a character in pixels
+# $Plan Current query plan as a Perl data structure
+# $LoginDialog Login dialog
+# $SchemaDialog Schema dialog
+# $SaveDialog Save File dialog
+# $OpenDialog Open File dialog
+# $FileDir Current file save/open directory
+# $PlanMain Query plan main window
+# $PlanTitle Title of query plan main window
+# $PlanTree Tree used to display the query plan
+# $PlanStep ROText used to display the selected plan step details
+# $PlanSql Text used to allow SQL editing
+# $Balloon For balloon help
+# $GrabMain SQL cache grab main window
+# $GrabStatus Text label used for feedback/status info
+# $GrabSelection Tag of currently selected SQL statement in the SQL cache
+# $GrabSql ROText used to hold the contents of the SQL cache
+# $GrabDetails ROText used to display the selected statement details
+use vars qw($ProgName $Db $DbName $User $Schema $SqlMarker $OracleVersion
+ $CharWidth $Plan $LoginDialog $SchemaDialog $OpenDialog $SaveDialog
+ $FileDir $PlanMain $PlanTitle $PlanTree $PlanStep $PlanSql $Balloon
+ $GrabMain $GrabStatus $GrabSelection $GrabSql $GrabDetails);
+$SqlMarker = "/* This statement was generated by explain */";
+
+################################################################################
+# Switch the hourglass on or off
+
+sub busy($)
+{
+my ($state) = @_;
+if ($state && $PlanMain->grabCurrent()) { $PlanMain->Busy(-recurse => 1); }
+else { $PlanMain->Unbusy(1); }
+}
+
+################################################################################
+# Display an error message in a dialog
+
+sub error($@)
+{
+my ($parent, @lines) = @_;
+
+my ($msg, $height, $width);
+$msg = join("\n", @lines);
+$msg =~ s/\n$//;
+$msg =~ s/ \(DBD:/\n(DBD:/;
+$msg =~ s/(indicator at char \d+ in) /$1\n/;
+@lines = split("\n", $msg);
+$height = @lines;
+$width = 0;
+foreach my $line (@lines)
+ { my $l = length($line); $width = $l if ($l > $width); }
+$width = 80 if ($width > 80);
+$height = 4 if ($height < 4);
+$height = 10 if ($height > 10);
+
+busy(0);
+my $dialog = $PlanMain->Toplevel(-title => "Error");
+$dialog->withdraw();
+my $text = $dialog->Scrolled("ROText", -height => $height, -width => $width,
+ -borderwidth => 3, -relief => "raised",
+ -wrap => "word", -scrollbars => "oe")
+ ->pack(-padx => 6, -pady => 6, -expand => 1, -fill => "both");
+$text->insert("1.0", $msg);
+
+my $ok_cb = sub { $dialog->destroy() };
+$dialog->Button(-text => "OK", -default => "active", -command => $ok_cb)
+ ->pack(-padx => 6, -pady => 6);
+$dialog->bind("<KeyPress-Return>", $ok_cb);
+$dialog->Popup;
+}
+
+################################################################################
+
+sub about($;$)
+{
+my ($parent, $win) = @_;
+my $msg = <<EOM;
+
+ $ProgName version $VERSION
+ Copyright (c) 1998 Alan Burlison
+ Alan.Burlison\@uk.sun.com
+
+ 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 code is provided with no warranty of any kind, and is used entirely at
+ your own risk.
+
+ This code was written by the author as a private individual, and is in no way
+ endorsed or warrantied by Sun Microsystems.
+
+EOM
+
+my $dialog;
+$dialog = $parent->Toplevel(-title => "About $ProgName");
+$dialog->withdraw();
+$dialog->resizable(0, 0);
+my $text = $dialog->Text(-borderwidth => 3, -width => 80, -height => 16,
+ -relief => "raised")
+ ->pack(-padx => 6, -pady => 6);
+$text->insert("1.0", $msg);
+my $cb;
+if ($win)
+ {
+ $$win = $dialog;
+ $cb = sub { $dialog->destroy(); undef($$win); };
+ }
+else
+ {
+ $cb = sub { $dialog->destroy(); };
+ }
+$dialog->Button(-text => "OK", -command => $cb)->pack(-padx => 6, -pady => 6);
+$dialog->Popup();
+return($dialog);
+}
+
+################################################################################
+
+sub update_title()
+{
+$PlanMain->configure(-title =>
+ $User
+ ? $User eq $Schema
+ ? "$ProgName - connected to $DbName as $User"
+ : "$ProgName - connected to $DbName as $User [schema $Schema]"
+ : "$ProgName - not connected"
+ );
+}
+
+################################################################################
+
+sub help($)
+{
+my ($parent) = @_;
+require Tk::Pod;
+$parent->Pod(-file => $0, -scrollbars => "e");
+}
+
+################################################################################
+# Login to the database. The new database handle is put into $Db, and the
+# Oracle version number is put into $OracleVersion
+
+sub login($$$)
+{
+my ($database, $username, $password) = @_;
+
+busy(1);
+# Close any existing handle
+if ($Db)
+ {
+ $Db->disconnect();
+ $Db = undef;
+ $DbName = $User = $Schema = undef;
+ update_title();
+ }
+
+# Connect and initialise
+$Db = DBI->connect("dbi:Oracle:$database", $username, $password,
+ { AutoCommit => 0, PrintError => 0})
+ || die("Can't login to Oracle:\n$DBI::errstr\n");
+$Db->{LongReadLen} = 4096;
+$Db->{LongTruncOk} = 1;
+
+# Get the user name and check the Oracle version
+my $qry = $Db->prepare(qq(
+ $SqlMarker select user, version from product_component_version
+ where lower(product) like '%oracle%'
+));
+if (! $qry->execute())
+ {
+ my $err = $DBI::errstr;
+ $qry->finish();
+ $Db->disconnect();
+ $Db = undef;
+ die("Can't fetch Oracle version:\n$err\n");
+ }
+($User, $OracleVersion) = $qry->fetchrow_array();
+$qry->finish();
+$DbName = $database || $ENV{TWO_TASK} || $ENV{ORACLE_SID};
+$Schema = $User;
+
+# Check there is a plan_table for this user
+$qry = $Db->prepare(qq(
+ $SqlMarker select 1 from user_tables where table_name = 'PLAN_TABLE'
+));
+$qry->execute();
+if (! $qry->fetchrow_arrayref())
+ {
+ $qry->finish();
+ $Db->disconnect();
+ $Db = undef;
+ die("User $User does not have a PLAN_TABLE.\n",
+ "Run the script utlxplan.sql to create one.\n");
+ }
+
+busy(0);
+return(1);
+}
+
+################################################################################
+# Clear the plan tree & details windows
+
+sub clear_plan()
+{
+$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
+$PlanTree->delete("all") if ($PlanTree);
+$PlanStep->delete("1.0", "end") if ($PlanStep);
+}
+
+################################################################################
+# Clear the SQL editor pane
+
+sub clear_editor()
+{
+$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
+$PlanTree->delete("all") if ($PlanTree);
+$PlanStep->delete("1.0", "end") if ($PlanStep);
+$PlanSql->delete("1.0", "end");
+}
+
+################################################################################
+# Display the structure of an index
+
+sub disp_index($$)
+{
+my ($owner, $index) = @_;
+
+# Create the index definition frame
+busy(1);
+my $dialog = $PlanMain->Toplevel(-title => "Index");
+$dialog->withdraw();
+$dialog->resizable(0, 0);
+my $index_fr = $dialog->Frame(-borderwidth => 3, -relief => "raised");
+$index_fr->Label(-text => "$owner.$index", -relief => "ridge",
+ -borderwidth => 1)
+ ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we",
+ -ipadx => 3);
+$index_fr->Label(-text => "Table", -relief => "ridge", -borderwidth => 1)
+ ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
+$index_fr->Label(-text => "Column", -relief => "ridge", -borderwidth => 1)
+ ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
+
+# Show the table columns the index is built upon
+my $qry = $Db->prepare(qq(
+ $SqlMarker select table_owner, table_name, column_name
+ from all_ind_columns
+ where index_owner = :1 and index_name = :2
+ order by column_position
+));
+$qry->execute($owner, $index) || die("Index columns:\n$DBI::errstr\n");
+
+# For each column in the index, display its details
+my ($tab_txt, $col_txt);
+while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array()))
+ {
+ $tab_txt .= "$tab_owner.$table\n";
+ $col_txt .= "$column\n";
+ }
+$qry->finish();
+chop($tab_txt, $col_txt);
+$index_fr->Label(-text => $tab_txt, -relief => "ridge", -borderwidth => 1,
+ -justify => "left")
+ ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
+$index_fr->Label(-text => $col_txt, -relief => "ridge", -borderwidth => 1,
+ -justify => "left")
+ ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
+$index_fr->pack(-side => "top", -fill => "x");
+
+# Pack the grid and add the close button
+$dialog->Button(-text => "Close", -command => sub { $dialog->destroy(); })
+ ->pack(-padx => 6, -pady => 6);
+
+$dialog->Popup();
+busy(0);
+return(1);
+}
+
+################################################################################
+# Callback for adding/removing index definitions to a table dialog
+
+sub disp_table_cb($$$$$)
+{
+my ($owner, $table, $num_cols, $index_fr, $index_bn) = @_;
+
+# If this is the first time through, fetch the index definitions
+busy(1);
+if (! $index_fr->children())
+ {
+ # This will retrieve the names & owners of all the indexes on the table
+ my $qry = $Db->prepare(qq(
+ $SqlMarker select owner, index_name
+ from all_indexes
+ where table_owner = :1 and table_name = :2
+ order by owner, index_name
+ ));
+
+ # Build up a list of all the indexes
+ $qry->execute($owner, $table) || die("Table indexes:\n$DBI::errstr\n");
+ my (@indexes, $ind_owner, $ind_name);
+ while (($ind_owner, $ind_name) = $qry->fetchrow_array())
+ { push(@indexes, { owner => $ind_owner, name => $ind_name }); }
+ $qry->finish();
+
+ # Special for no indexes
+ if (@indexes == 0)
+ {
+ $index_fr->Label(-text => "No\nindexes\ndefined", -relief => "ridge",
+ -borderwidth => 1)->pack(-ipadx => 3, -ipady => 4);
+ }
+ else
+ {
+ # Do the header label
+ $index_fr->Label(-text => "Index\norder", -relief => "ridge",
+ -borderwidth => 1)
+ ->grid(-column => 0, -row => 0, -sticky => "we", -ipadx => 3,
+ -ipady => 2, -columnspan => scalar(@indexes), -rowspan => 2);
+
+ # This will retrieve (table column id, index position) for an index
+ $qry = $Db->prepare(qq(
+ $SqlMarker select atc.column_id, aic.column_position
+ from all_tab_columns atc, all_ind_columns aic
+ where aic.index_owner = :1 and aic.index_name = :2
+ and atc.owner = aic.table_owner and atc.table_name = aic.table_name
+ and atc.column_name = aic.column_name
+ order by aic.index_name, atc.column_id
+ ));
+
+ # For each index, add a label describing the index
+ my $cb = sub { disp_index($_[1], $_[2]); };
+ my $grid_col = 0;
+ foreach my $index (@indexes)
+ {
+ ($ind_owner, $ind_name) = @{$index}{qw(owner name)};
+ $qry->execute($ind_owner, $ind_name)
+ || die("Index columns:\n$DBI::errstr\n");
+ my $index_txt;
+ my $col = 1;
+ while (my ($col_id, $col_pos) = $qry->fetchrow_array())
+ {
+ $index_txt .= "\n" x ($col_id - $col) . "$col_pos\n";
+ $col = $col_id + 1;
+ }
+ $index_txt .= "\n" x ($num_cols - ($col - 1));
+ chop($index_txt);
+ my $label = $index_fr->Label(-text => $index_txt, -relief => "ridge",
+ -borderwidth => 1, -justify => "left")
+ ->grid(-column => $grid_col, -row => 2, -sticky => "w",
+ -ipadx => 3);
+ $label->bind("<1>", [ $cb, $ind_owner, $ind_name ]);
+ $Balloon->attach($label, -msg => "$ind_owner.$ind_name",
+ -balloonposition => "mouse");
+ $grid_col++;
+ }
+ }
+ }
+if ($index_bn->cget(-text) eq "Indexes")
+ {
+ $index_bn->configure(-text => "Hide Indexes");
+ $index_fr->pack(-side => "right", -expand => 1);
+ }
+else
+ {
+ $index_bn->configure(-text => "Indexes");
+ $index_fr->packForget();
+ }
+busy(0);
+return(1);
+}
+
+################################################################################
+# Display a popup dialog showing the structure of a table
+
+sub disp_table($$)
+{
+my ($owner, $table) = @_;
+
+# Create the dialog for displaying the object details
+busy(1);
+my $dialog = $PlanMain->Toplevel(-title => "Table");
+$dialog->withdraw();
+$dialog->resizable(0, 0);
+
+# Create the table definition frame
+my $box1 = $dialog->Frame(-borderwidth => 3, -relief => "raised");
+my $box2 = $box1->Frame(-borderwidth => 0);
+my $table_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
+$table_fr->Label(-text => "$owner.$table",
+ -relief => "ridge", -borderwidth => 1)
+ ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");
+$table_fr->Label(-text => "Name", -relief => "ridge", -borderwidth => 1)
+ ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
+$table_fr->Label(-text => "Type", -relief => "ridge", -borderwidth => 1)
+ ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
+
+# This will get the table description
+my $qry = $Db->prepare(qq(
+ $SqlMarker select column_name, data_type, data_length,
+ data_precision, data_scale
+ from all_tab_columns
+ where owner = :1 and table_name = :2
+ order by column_id
+ ));
+$qry->execute($owner, $table)
+ || die("Table columns:\n$DBI::errstr\n");
+
+my ($num_cols, $name_txt, $type_txt);
+while ((my ($name, $type, $length, $precision, $scale)
+ = $qry->fetchrow_array()))
+ {
+ if ($precision)
+ {
+ $type .= "($precision";
+ $type .= ",$scale" if ($scale);
+ $type .= ")";
+ }
+ elsif ($type =~ /CHAR/)
+ {
+ $type .= "($length)";
+ }
+ $name_txt .= "$name\n";
+ $type_txt .= "$type\n";
+ $num_cols++;
+ }
+$qry->finish();
+chop($name_txt, $type_txt);
+$table_fr->Label(-text => $name_txt, -relief => "ridge", -borderwidth => 1,
+ -justify => "left")
+ ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
+$table_fr->Label(-text => $type_txt, -relief => "ridge", -borderwidth => 1,
+ -justify => "left")
+ ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
+$table_fr->pack(-side => "left");
+
+# Now create a frame for the index definition & pack the whole lot
+my $index_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
+$box2->pack();
+$box1->pack(-side => "top", -fill => "x", -expand => 1);
+
+# Create the buttons at the bottom
+$box1 = $dialog->Frame(-borderwidth => 0);
+$box1->Button(-text => "Close", -command => sub { $dialog->destroy(); })
+ ->pack(-padx => 6, -side => "left", -expand => 1);
+my $index_bn;
+$index_bn = $box1->Button(-text => "Indexes")
+ ->pack(-padx => 6, -side => "left", -expand => 1);
+$index_bn->configure(-command => sub { disp_table_cb($owner, $table, $num_cols,
+ $index_fr, $index_bn); });
+$box1->pack(-side => "bottom", -pady => 6);
+
+$dialog->Popup();
+busy(0);
+return(1);
+}
+
+################################################################################
+# Display the query plan tree
+
+sub disp_plan_tree()
+{
+$PlanTitle->configure(-text => $Plan->{title});
+$PlanTree->delete("all");
+my $steps = 0;
+foreach my $step (@{$Plan->{id}})
+ {
+ my $item = $PlanTree->add($step->{key}, -text => $step->{desc});
+ $steps++;
+ }
+$PlanTree->autosetmode();
+if ($steps)
+ {
+ $PlanTree->selectionSet("1");
+ disp_plan_step("1");
+ }
+}
+
+################################################################################
+# Display the statistics for a given plan step
+
+sub disp_plan_step($)
+{
+my ($key) = @_;
+my $row = $Plan->{key}{$key};
+$PlanStep->delete("1.0", "end");
+my $info = "";
+$info .= "Cost:\t\t$row->{COST}\t(Estimate of the cost of this step)\n"
+ . "Cardinality:\t$row->{CARDINALITY}\t"
+ . "(Estimated number of rows fetched by this step)\n"
+ . "Bytes:\t\t$row->{BYTES}\t"
+ . "(Estimated number of bytes fetched by this step)\n"
+ if ($row->{COST});
+$info .= "\nPartition\nStart:\t$row->{PARTITION_START}\tStop:\t\t"
+ . "$row->{PARTITION_STOP}\tId:\t\t$row->{PARTITION_ID}\n"
+ if ($row->{PARTITION_START});
+$info .= "\nSQL used by Parallel Query Slave:\n$row->{OTHER}"
+ if ($row->{OTHER});
+$PlanStep->insert("1.0", $info);
+}
+
+################################################################################
+# Display a popup dialog showing the structure of the table or index used in
+# the passed plan step
+
+sub disp_plan_step_obj($)
+{
+my ($key) = @_;
+
+# Get the plan step & return if it doesn't refer to an object
+my $row = $Plan->{key}{$key};
+return(1) if (! $row->{OBJECT_NAME});
+
+# Work out the type of the object - table or index
+busy(1);
+my $qry = $Db->prepare(qq(
+ $SqlMarker select object_type from all_objects
+ where object_name = :1 and owner = :2
+));
+$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
+ || die("Object type:\n$DBI::errstr\n");
+my ($object_type) = $qry->fetchrow_array();
+$qry->finish();
+busy(0);
+
+if ($object_type eq "TABLE")
+ {
+ disp_table($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
+ }
+elsif ($object_type eq "INDEX")
+ {
+ disp_index($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
+ }
+else
+ {
+ die("Unknown object type $object_type",
+ "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n");
+ }
+}
+
+################################################################################
+# Display a list of available indexes on a table, and display the selected
+# table definition
+
+sub disp_index_popup($)
+{
+my ($key) = @_;
+
+# Get the plan step & return if it doesn't refer to an object
+my $row = $Plan->{key}{$key};
+return(1) if (! $row->{OBJECT_NAME});
+
+# Work out the type of the object - table or index
+busy(1);
+my $qry = $Db->prepare(qq(
+ $SqlMarker select object_type from all_objects
+ where object_name = :1 and owner = :2
+));
+$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
+ || die("Object type:\n$DBI::errstr\n");
+my ($object_type) = $qry->fetchrow_array();
+$qry->finish();
+if ($object_type ne "TABLE")
+ {
+ busy(0);
+ return(1);
+ }
+
+# Build the popup menu
+$qry = $Db->prepare(qq(
+ $SqlMarker select owner, index_name from all_indexes
+ where table_name = :1 and table_owner = :2
+));
+$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
+ || die("Table indexes:\n$DBI::errstr\n");
+my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#000000");
+$menu->command(-label => "Indexes", -state => "disabled");
+
+$menu->separator();
+my $count = 0;
+while ((my ($index_owner, $index_name) = $qry->fetchrow_array()))
+ {
+ $menu->command(-label => "$index_owner.$index_name",
+ -command => [ \&disp_index, $index_owner, $index_name ]);
+ $count++;
+ }
+$qry->finish();
+busy(0);
+$menu->Popup(-popover => "cursor", -popanchor => "nw") if ($count);
+return(1);
+}
+
+################################################################################
+# Produce the query plan for the SQL in $PlanSql and store it in $Plan
+
+sub _explain()
+{
+# Check there is some SQL
+my $stmt = $PlanSql->get("1.0", "end");
+$stmt =~ s/;//g;
+die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/);
+
+# Check we are logged on
+die("You are not logged on to Oracle\n") if (! $Db);
+
+# Set up the various query strings
+# Note that for some reason you can't use bind variables in 'explain plan'
+my $prefix = "explain plan set statement_id = '$$' for\n";
+my $plan_sql = qq(
+ $SqlMarker select level, operation, options, object_node, object_owner,
+ object_name, object_instance, object_type, id, parent_id, position,
+ other);
+if ($OracleVersion ge "7.3")
+ { $plan_sql .= qq(, cost, cardinality, bytes, other_tag) };
+if ($OracleVersion ge "8")
+ { $plan_sql .= qq(, partition_start, partition_stop, partition_id) };
+$plan_sql .= qq(
+ from plan_table
+ where statement_id = :1
+ connect by prior id = parent_id and statement_id = :1
+ start with id = 0 and statement_id = :1
+);
+
+# Clean any old stuff from the plan_table
+busy(1);
+$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
+ undef, $$)
+ || die("Delete from plan_table:\n$DBI::errstr\n");
+$Db->commit();
+
+# Switch schema if required
+if ($Schema ne $User)
+ {
+ $Db->do(qq($SqlMarker alter session set current_schema = $Schema))
+ || die("Cannot change schema to $Schema:\n$DBI::errstr\n");
+ }
+
+# Explain the plan - need to save message if failed!
+$Plan = { schema => $Schema, sql => $stmt };
+my $fail;
+$fail = $DBI::errstr if (!$Db->do($prefix . $stmt));
+
+# Switch back schema if required
+if ($Schema ne $User)
+ {
+ $Db->do(qq($SqlMarker alter session set current_schema = $User))
+ || die("Set current schema to $User:\n$DBI::errstr\n");
+ }
+# Now we can safely die if the exmplai plan failed
+die("Explain plan:\n$fail\n") if ($fail);
+
+# Read back the plan
+my $qry = $Db->prepare($plan_sql)
+ || die("Unsupported PLAN_TABLE format:\n$DBI::errstr\n");
+$qry->execute($$) || die("Read plan:\n$DBI::errstr\n");
+while (my $row = $qry->fetchrow_hashref())
+ {
+ if ($row->{ID} == 0)
+ {
+ $Plan->{title} = "Query Plan for " . lc($row->{OPERATION});
+ $Plan->{title} .= ". Cost = $row->{POSITION}" if ($row->{POSITION});
+ }
+ else
+ {
+ # Line wrap the OTHER field
+ $row->{OTHER} =~ s/((.{1,80})(\s+|,|$))/$1\n/g if ($row->{OTHER});
+
+ # Construct a descriptive string for the query step
+ my $desc = "$row->{OPERATION}";
+ $desc .= " $row->{OPTIONS}" if ($row->{OPTIONS});
+ $desc .= " $row->{OBJECT_TYPE}" if ($row->{OBJECT_TYPE});
+ $desc .= " of $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}"
+ if ($row->{OBJECT_OWNER} && $row->{OBJECT_NAME});
+ $desc .= " using PQS $row->{OBJECT_NODE} $row->{OTHER_TAG}"
+ if ($row->{OBJECT_NODE});
+ $row->{desc} = $desc;
+
+ # Construct a hierarchical key for the query step
+ if (! $row->{PARENT_ID})
+ {
+ my $key = "$row->{POSITION}";
+ $row->{key} = $key;
+ $Plan->{id}[$row->{ID} - 1] = $row;
+ $Plan->{key}{$key} = $row;
+ }
+ else
+ {
+ my $parent = $Plan->{id}[$row->{PARENT_ID} - 1];
+ my $key = "$parent->{key}.$row->{POSITION}";
+ $row->{key} = $key;
+ $Plan->{id}[$row->{ID} - 1] = $row;
+ $Plan->{key}{$key} = $row;
+ $parent->{child}[$row->{POSITION} - 1] = $row;
+ }
+ }
+ }
+# Top of the tree is step 0
+$Plan->{tree} = $Plan->{id}[0];
+
+# Clean up
+$qry->finish();
+$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
+ undef, $$);
+$Db->commit();
+busy(0);
+return(1);
+}
+
+################################################################################
+# Wrapper for _explain - adds error handling
+
+sub explain
+{
+clear_plan();
+if (! eval { _explain(); }) { error($PlanMain, $@); }
+else { disp_plan_tree(); }
+}
+
+################################################################################
+# Display a login dialog
+
+sub login_dialog($)
+{
+my ($parent) = @_;
+
+# Create the dialog
+if (! $LoginDialog)
+ {
+ my $username = "/";
+ my $password = "";
+ my $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID};
+
+ $LoginDialog = $parent->Toplevel(-title => "Login to Oracle");
+ $LoginDialog->withdraw();
+ $LoginDialog->resizable(0, 0);
+ my $box;
+
+ # Create the entry labels & fields
+ $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
+ $box->Label(-text => "Username")
+ ->grid(-column => 0, -row => 0, -sticky => "w");
+ $box->Entry(-textvariable => \$username, -width => 30)
+ ->grid(-column => 1, -row => 0, -sticky => "w");
+ $box->Label(-text => "Password")
+ ->grid(-column => 0, -row => 1, -sticky => "w");
+ $box->Entry(-textvariable => \$password, -width => 30, -show => "*")
+ ->grid(-column => 1, -row => 1, -sticky => "w");
+ $box->Label(-text => "Database")
+ ->grid(-column => 0, -row => 2, -sticky => "w");
+ $box->Entry(-textvariable => \$database, -width => 30)
+ ->grid(-column => 1, -row => 2, -sticky => "w");
+ $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
+
+ # Create the buttons & callbacks
+ $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
+ my $cb = sub
+ {
+ if (! eval { login($database, $username, $password); })
+ {
+ error($parent, $@);
+ $LoginDialog->raise($parent);
+ }
+ else
+ {
+ update_title();
+ $LoginDialog->withdraw();
+ }
+ };
+ $box->Button(-text => "Login", -default => "active", -command => $cb)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+ $box->Button(-text => "Cancel", -command => sub { $LoginDialog->withdraw() })
+ ->pack(-side => "right", -expand => 1, -pady => 6);
+ $box->pack(-expand => 1, -fill => "both");
+ $LoginDialog->bind("<KeyPress-Return>", $cb);
+ }
+
+# Activate the dialog
+$LoginDialog->Popup();
+}
+
+################################################################################
+
+sub schema_dialog($)
+{
+my ($parent) = @_;
+
+if (! $Db)
+ {
+ error($parent, "You are not logged on to Oracle\n");
+ return;
+ }
+
+# Create the dialog
+if (! $SchemaDialog)
+ {
+ $SchemaDialog = $parent->Toplevel(-title => "Change Schema");
+ $SchemaDialog->withdraw();
+ $SchemaDialog->resizable(0, 0);
+ my ($box, $schema);
+
+ # Create the entry labels & fields
+ $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
+ $box->Label(-text => "Schema")
+ ->pack(-side => "left", -anchor => "e", -expand => 1);
+ $box->Entry(-textvariable => \$schema, -width => 30)
+ ->pack(-side => "right", -anchor => "w", -expand => 1);
+ $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
+
+ # Create the buttons & callbacks
+ $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
+ my $cb = sub
+ {
+ # Try changing to the specified schema
+ $schema = uc($schema);
+ if (! $Db->do(qq($SqlMarker alter session set current_schema = $schema)))
+ {
+ error($parent, "Cannot change schema to $schema:", $DBI::errstr);
+ $SchemaDialog->raise($parent);
+ }
+ else
+ {
+ # Change back to the user's schema
+ $Db->do(qq($SqlMarker alter session set current_schema = $User))
+ || die("Cannot change schema to $User\n$DBI::errstr");
+ $Schema = $schema;
+ update_title();
+ $SchemaDialog->withdraw();
+ }
+ };
+ $box->Button(-text => "Default", -command => sub { $schema = $User; })
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+ $box->Button(-text => "Apply", -default => "active", -command => $cb)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+ $box->Button(-text => "Cancel",
+ -command => sub { $SchemaDialog->withdraw() })
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+ $box->pack(-expand => 1, -fill => "both");
+ $SchemaDialog->bind("<KeyPress-Return>", $cb);
+ }
+
+# Activate the dialog
+$SchemaDialog->Popup();
+}
+
+################################################################################
+# Open a file and read it into the SQL editor frame
+
+sub open_file($)
+{
+# Open the file
+my ($file) = @_;
+use IO::File;
+my $fh;
+if (! ($fh = IO::File->new($file, "r")))
+ {
+ error($PlanMain, "Cannot open $file:\n", $!);
+ return(0);
+ }
+
+# Clear the plan, plan details & SQL editor, then load into the SQL editor
+clear_editor();
+while (my $line = $fh->getline())
+ {
+ $PlanSql->insert("end", $line);
+ }
+$fh->close();
+return(1);
+}
+
+################################################################################
+# Display a file open dialog & load into the SQL editor
+
+sub open_dialog($)
+{
+my ($parent) = @_;
+
+# Put up the dialog
+require Cwd; import Cwd;
+require Tk::FileSelect;
+$FileDir = cwd() if (! $FileDir);
+if (! $OpenDialog)
+ {
+ $OpenDialog = $parent->FileSelect(-title => "Open File",
+ -create => 0);
+ }
+$OpenDialog->configure(-directory => $FileDir);
+my $file = $OpenDialog->Show();
+return if (! $file);
+$FileDir = $OpenDialog->cget(-directory);
+open_file($file);
+}
+
+################################################################################
+# Display a file save dialog & save the contents of the passed Text widget
+
+sub save_dialog($$)
+{
+my ($parent, $text) = @_;
+
+# Put up the dialog
+require Cwd; import Cwd;
+require IO::File;
+require Tk::FileSelect;
+$FileDir = cwd() if (! $FileDir);
+if (! $SaveDialog)
+ {
+ $SaveDialog = $parent->FileSelect(-title => "Save File",
+ -create => 1);
+ }
+$SaveDialog->configure(-directory => $FileDir);
+my $file = $SaveDialog->Show();
+return if (! $file);
+$FileDir = $SaveDialog->cget(-directory);
+
+# Save the Text widget contents to the selected file
+my $fh;
+if (! ($fh = IO::File->new($file, "w")))
+ {
+ error($PlanMain, "Cannot open $file:\n", $!);
+ return;
+ }
+$fh->print($text->get("1.0", "end"));
+$fh->close();
+}
+
+################################################################################
+# Copy SQL from the grab window into the explain SQL editor
+
+sub copy_sql($$)
+{
+my ($text, $tag) = @_;
+return if (! defined($tag));
+clear_editor();
+$PlanSql->insert("end", $text->get("$tag.first", "$tag.last"));
+$Schema = $text->tag("cget", $tag, -data);
+update_title();
+$PlanMain->deiconify();
+}
+
+################################################################################
+# Display info from v$sqlarea for the selected statement in the SQL cache
+
+sub disp_sql_cache_info($$)
+{
+my ($address, $puid) = @_;
+
+# Empty the widget & prepare the SQL
+$GrabDetails->delete("1.0", "end");
+busy(1);
+my $qry = $Db->prepare(qq(
+ $SqlMarker select executions, disk_reads, buffer_gets, rows_processed,
+ sorts, loads, parse_calls, first_load_time
+ from v\$sqlarea where address = :1
+)) || die("Statement info:\n$DBI::errstr\n");
+
+# Read the info. Note that the statement *may* have been purged from the cache!
+$qry->execute($address);
+if (! (my ($executions, $disk_reads, $buffer_gets, $rows_processed,
+ $sorts, $loads, $parse_calls, $first_load_time)
+ = $qry->fetchrow_array()))
+ {
+ $GrabDetails->insert("1.0", "This statement is no longer in the SQL cache");
+ }
+else
+ {
+ $first_load_time =~ s!/! !;
+ $GrabDetails->insert("1.0", "First executed by user", "bold",
+ " $puid ", "",
+ " at", "bold", " $first_load_time\n");
+ $GrabDetails->insert("end", "Total ", "bold");
+ $GrabDetails->insert("end", sprintf("Executions: %8d\n", $executions));
+ my $fmt =
+ "Disk reads: %8d Buffer gets: %8d Rows processed: %8d\n"
+ . "Sorts: %8d Loads: %8d Parse calls: %8d\n";
+ $GrabDetails->insert("end",
+ sprintf($fmt, $disk_reads, $buffer_gets, $rows_processed,
+ $sorts, $loads, $parse_calls));
+ if ($executions > 0)
+ {
+ $GrabDetails->insert("end", "Average per Execution\n", "bold");
+ $fmt =
+ "Disk reads: %8.1f Buffer gets: %8.1f "
+ . "Rows processed: %8.1f\n"
+ . "Sorts: %8.1f Loads: %8.1f "
+ . "Parse calls: %8.1f\n";
+ $GrabDetails->insert("end",
+ sprintf($fmt, $disk_reads / $executions, $buffer_gets / $executions,
+ $rows_processed / $executions, $sorts / $executions,
+ $loads / $executions, $parse_calls / $executions));
+ }
+ }
+busy(0);
+
+# Display the formated info
+return(1);
+}
+
+################################################################################
+# Callback for whenever a bit of grabbed SQL is selected
+
+sub grab_select_cb($$)
+{
+my ($text, $tag) = @_;
+$text->tag("configure", $GrabSelection, -background => undef)
+ if ($GrabSelection);
+$text->tag("configure", $tag, -background => "#43ce80");
+my $puid = $text->tag("cget", $tag, -data);
+$GrabSelection = $tag;
+if (! eval { disp_sql_cache_info($tag, $puid); })
+ { error($GrabMain, $@); }
+}
+
+################################################################################
+# Scan v$sqlarea for SQL statements matching the specified conditions.
+# $order_by is a v$sqlarea column name used to rank the statements
+# $sort_by is "asc" or "desc"
+# $user is who first issued the statement (case insensitive)
+# $pattern is a perl regexp used to filter the SQL
+# $rows is the maximum number of rows to display
+
+sub grab($$$$$$$)
+{
+my ($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows) = @_;
+
+# Check we are logged on
+die("You are not logged on to Oracle\n") if (! $Db);
+
+# Munge args as necessary
+$no_sys = $no_sys ? qq{and user_name not in ('SYS', 'SYSTEM')} : qq{};
+$rows = -1 if ($rows !~ /^\d+$/);
+$user = uc($user);
+
+# Clear the frames
+$GrabSql->delete("1.0", "end");
+$GrabDetails->delete("1.0", "end");
+$GrabStatus->configure(-text => "Please wait...");
+
+# Define the callbacks for highlighting etc
+my $highlight = sub
+ {
+ my ($text, $tag) = @_;
+ $text->tag("configure", $tag, -relief => "raised", -borderwidth => 1);
+ };
+my $normal = sub
+ {
+ my ($text, $tag) = @_;
+ $text->tag("configure", $tag, -relief => "flat");
+ };
+
+# Prepare the queries
+busy(1);
+my $qry1 = qq{$SqlMarker select address, username from v\$sqlarea, all_users};
+$qry1 .= qq{ where sql_text not like '\%$SqlMarker\%'};
+$qry1 .= qq{ and sql_text not like '\%insert into \%plan_table\%'};
+$qry1 .= qq{ and sql_text not like '\%explain plan\%'};
+$qry1 .= qq{ and user_id = parsing_user_id}; # if($user || $no_sys);
+$qry1 .= qq{ and username = :1} if ($user);
+$qry1 .= qq{ and username not in ('SYS', 'SYSTEM')} if ($no_sys);
+if ($ordering eq "total")
+ { $qry1 .= qq{ order by $order_by $sort_by}; }
+elsif ($ordering eq "average")
+ { $qry1 .= qq{ order by $order_by / greatest(executions, 1) $sort_by}; }
+$qry1 = $Db->prepare($qry1) || die("SQL Cache capture:\n$DBI::errstr\n");
+
+my $qry2;
+if ($OracleVersion ge "7.2")
+ {
+ $qry2 = $Db->prepare(qq(
+ $SqlMarker select sql_text from v\$sqltext_with_newlines
+ where address = :1 order by piece))
+ || die("SQL text:\n$DBI::errstr\n");
+ }
+else{
+ $qry2 = $Db->prepare(qq(
+ $SqlMarker select sql_text from v\$sqltext
+ where address = :1 order by piece))
+ || die("SQL text:\n$DBI::errstr\n");
+ }
+
+# For each SQL query in the shared pool...
+if ($user) { $qry1->execute($user) || die("SQL text:\n$DBI::errstr\n"); }
+else { $qry1->execute() || die("SQL text:\n$DBI::errstr\n"); }
+my $count = 0;
+my $first_address;
+while ($count != $rows && (my ($address, $puid) = $qry1->fetchrow_array()))
+ {
+ # ...glue together the components of the SQL string & print out
+ $qry2->execute($address) || die("SQL text:\n$DBI::errstr\n");
+ my ($sql_text) = "";
+ while (my ($sql) = $qry2->fetchrow_array())
+ {
+ $sql_text .= $sql;
+ }
+ $qry2->finish();
+ $sql_text =~ s/^\s+//;
+ $sql_text =~ s/\n\s*\n/\n/;
+ $sql_text =~ s/\s+$//s;
+
+ # Skip if it doesn't match the supplied pattern
+ next if ($pattern && eval { $sql_text !~ /$pattern/is; });
+
+ # Display the statement and set up the bindings
+ $GrabSql->insert("end", $sql_text, $address, "\n\n");
+ $GrabSql->tag("configure", $address, -data => $puid);
+ $GrabSql->tag("bind", $address, "<Any-Enter>" => [ $highlight, $address ]);
+ $GrabSql->tag("bind", $address, "<Any-Leave>" => [ $normal, $address ]);
+ $GrabSql->tag("bind", $address, "<Double-1>" => [ \©_sql, $address]);
+ $GrabSql->tag("bind", $address, "<1>" => [ \&grab_select_cb, $address ]);
+ $GrabSql->update();
+
+ $count++;
+ $first_address = $address if (! defined($first_address));
+ if ($rows > 0)
+ { $GrabStatus->configure(-text => "$count of $rows queries grabbed"); }
+ else
+ { $GrabStatus->configure(-text => "$count queries grabbed"); }
+ }
+
+# Clean up
+$qry1->finish();
+grab_select_cb($GrabSql, $first_address) if ($first_address);
+$GrabStatus->configure(-text => "$count queries grabbed");
+busy(0);
+return(1);
+}
+
+################################################################################
+# Create a top-level window for getting SQL from the shared pool cache
+
+sub grab_main
+{
+# If it already exists, just make it visible)
+if ($GrabMain)
+ {
+ $GrabMain->deiconify();
+ $GrabMain->raise($PlanMain);
+ return;
+ }
+
+# Otherwise, build the grab window
+$GrabMain = $PlanMain->Toplevel(-title => "$ProgName - SQL cache");
+$GrabMain->protocol("WM_DELETE_WINDOW", sub { $GrabMain->withdraw(); });
+
+# Defaults & callbacks
+my $ordering = "";
+my $order_by = "";
+my $sort_by = "";
+my $no_sys = 1;
+my $user = "";
+my $pattern = "";
+my $rows = 100;
+my $grab_cb = sub
+ {
+ if (! eval { grab($ordering, $order_by, $sort_by, $no_sys,
+ $user, $pattern, $rows); })
+ { error($GrabMain, $@); }
+ };
+my (%ord_bn, %sort_bn); # For "order by" and "sort order" buttons
+my $ord_bn_cb = sub
+ {
+ if ($ordering eq "")
+ {
+ $order_by = "";
+ $sort_by = "";
+ foreach my $bn (values(%ord_bn))
+ { $bn->configure(-state => "disabled"); }
+ foreach my $bn (values(%sort_bn))
+ { $bn->configure(-state => "disabled"); }
+ }
+ elsif ($ordering eq "total")
+ {
+ $order_by = "disk_reads" if ($order_by eq "");
+ $sort_by = "desc" if ($sort_by eq "");
+ foreach my $bn (values(%ord_bn))
+ { $bn->configure(-state => "normal"); }
+ foreach my $bn (values(%sort_bn))
+ { $bn->configure(-state => "normal"); }
+ }
+ else # $ordering eq "average"
+ {
+ $order_by = "disk_reads"
+ if ($order_by eq "" || $order_by eq "executions");
+ $sort_by = "desc" if ($sort_by eq "");
+ foreach my $bn (values(%ord_bn))
+ { $bn->configure(-state => "normal"); }
+ $ord_bn{executions}->configure(-state => "disabled");
+ $ord_bn{first_load_time}->configure(-state => "disabled");
+ foreach my $bn (values(%sort_bn))
+ { $bn->configure(-state => "normal"); }
+ }
+ };
+
+### Menubar
+my $menubar = $GrabMain->Frame(-relief => "raised", -borderwidth => 3);
+$menubar->pack(-fill => "x");
+
+my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
+$menubar_file->command(-label => "Save File ...", -underline => 0,
+ -command => sub { save_dialog($PlanMain, $GrabSql); });
+$menubar_file->separator();
+$menubar_file->command(-label => "Capture SQL", -underline => 0,
+ -command => $grab_cb);
+$menubar_file->command(-label => "Copy to Explain", -underline => 9,
+ -command => sub { copy_sql($GrabSql, $GrabSelection); });
+$menubar_file->command(-label => "Close", -underline => 1,
+ -command => sub { $GrabMain->withdraw(); });
+$menubar_file->pack(-side => "left");
+
+my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
+$menubar_help->command(-label => "About ...", -underline => 0,
+ -command => sub { about($GrabMain); });
+$menubar_help->command(-label => "Usage ...", -underline => 0,
+ -command => sub { help($GrabMain); });
+$menubar_help->pack(-side => "right");
+
+### SQL cache display
+my ($frame, $frame1, $frame2, $frame3);
+$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame1 = $frame->Frame(-highlightthickness => 0);
+$frame1->Label(-text => "SQL Cache")->pack(-side => "left");
+$GrabStatus = $frame1->Label(-text => "")->pack(-side => "right");
+$frame1->pack(-fill => "x");
+$GrabSql = $frame->Scrolled("ROText", -setgrid => "true", -scrollbars => "oe",
+ -height => 15, -width => 80, -borderwidth => 0,
+ -wrap => "word")
+ ->pack(-fill => "both", -expand => 1);
+$frame->pack(-fill => "both", -expand => 1);
+
+### SQL statement details
+$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Label(-text => "SQL Statement Statistics")->pack(-anchor => "nw");
+$GrabDetails = $frame->ROText(-height => 7, -width => 80, -borderwidth => 0,
+ -setgrid => "true", -wrap => "none")
+ ->pack(-fill => "x");
+$GrabDetails->tagConfigure("bold", -font => "bold");
+$frame->pack(-fill => "x");
+
+### SQL selection
+$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Label(-text => "SQL Selection Criterea")->pack(-anchor => "w");
+$frame1 = $frame->Frame(-highlightthickness => 1);
+
+## SQL sort frame
+$frame1->Label(-text => "Order SQL by")
+ ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
+$frame2 = $frame1->Frame(-highlightthickness => 0);
+
+# Ordering frame
+$frame3 = $frame2->Frame(-highlightthickness => 1);
+$frame3->Radiobutton(-text => "No ordering", -highlightthickness => 0,
+ -value => "", -variable => \$ordering,
+ -command => $ord_bn_cb)
+ ->pack(-anchor => "w");
+$frame3->Radiobutton(-text => "Total", -highlightthickness => 0,
+ -value => "total", -variable => \$ordering,
+ -command => $ord_bn_cb)
+ ->pack(-anchor => "w");
+$frame3->Radiobutton(-text => "Average per execution",
+ -highlightthickness => 0, -value => "average",
+ -variable => \$ordering, -command => $ord_bn_cb)
+ ->pack(-anchor => "w");
+$frame3->pack(-side => "left", -padx => 6);
+
+# Order by frame
+$frame3 = $frame2->Frame(-highlightthickness => 1);
+$ord_bn{disk_reads} =
+ $frame3->Radiobutton(-text => "Disk reads", -highlightthickness => 0,
+ -value => "disk_reads", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 0, -sticky => "w");
+$ord_bn{buffer_gets} =
+ $frame3->Radiobutton(-text => "Buffer gets", -highlightthickness => 0,
+ -value => "buffer_gets", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 1, -row => 0, -sticky => "w");
+$ord_bn{rows_processed} =
+ $frame3->Radiobutton(-text => "Rows processed", -highlightthickness => 0,
+ -value => "rows_processed", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 1, -sticky => "w");
+$ord_bn{sorts} =
+ $frame3->Radiobutton(-text => "Sorts", -highlightthickness => 0,
+ -value => "sorts", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 1, -row => 1, -sticky => "w");
+$ord_bn{loads} =
+ $frame3->Radiobutton(-text => "Loads", -highlightthickness => 0,
+ -value => "loads", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 2, -sticky => "w");
+$ord_bn{parse_calls} =
+ $frame3->Radiobutton(-text => "Parse calls", -highlightthickness => 0,
+ -value => "parse_calls", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 1, -row => 2, -sticky => "w");
+$ord_bn{executions} =
+ $frame3->Radiobutton(-text => "Executions", -highlightthickness => 0,
+ -value => "executions", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 3, -sticky => "w");
+$ord_bn{first_load_time} =
+ $frame3->Radiobutton(-text => "First load", -highlightthickness => 0,
+ -value => "first_load_time", -variable => \$order_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 1, -row => 3, -sticky => "w");
+$frame3->pack(-side => "left", -padx => 6);
+
+# Sort order frame
+$frame3 = $frame2->Frame(-highlightthickness => 1);
+$sort_bn{desc} =
+ $frame3->Radiobutton(-text => "Descending", -highlightthickness => 0,
+ -value => "desc", -variable => \$sort_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 0, -sticky => "w");
+$sort_bn{asc} =
+ $frame3->Radiobutton(-text => "Ascending", -highlightthickness => 0,
+ -value => "asc", -variable => \$sort_by,
+ -command => $ord_bn_cb)
+ ->grid(-column => 0, -row => 1, -sticky => "w");
+$frame3->pack(-side => "right", -padx => 6);
+$frame2->grid(-column => 0, -row => 1, -sticky => "w", -columnspan => 2);
+
+## Other options frame
+$frame2 = $frame1->Frame(-highlightthickness => 0);
+$frame2->Checkbutton(-text => "Exclude queries by SYS or SYSTEM",
+ -variable => \$no_sys, -offvalue => 0, -onvalue => 1,
+ -highlightthickness => 0)
+ ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
+$frame2->Label(-text => "First user to execute statement")
+ ->grid(-column => 0, -row => 1, -sticky => "w");
+$frame2->Entry(-textvariable => \$user, -width => 30)
+ ->grid(-column => 1, -row => 1, -sticky => "w");
+$frame2->Label(-text => "SQL matches pattern")
+ ->grid(-column => 0, -row => 2, -sticky => "w");
+$frame2->Entry(-textvariable => \$pattern, -width => 30)
+ ->grid(-column => 1, -row => 2, -sticky => "w");
+$frame2->Label(-text => "Maximum number of statements")
+ ->grid(-column => 0, -row => 3, -sticky => "w");
+$frame2->Entry(-textvariable => \$rows, -width => 4)
+ ->grid(-column => 1, -row => 3, -sticky => "w");
+$frame2->grid(-column => 0, -row => 2, -sticky => "we",
+ -columnspan => 2, -padx => 6, -pady => 6);
+$frame1->pack(-fill => "x");
+&$ord_bn_cb(); # Set the buttons to the initial state
+$frame->pack(-fill => "x", -padx => 6, -pady => 6);
+
+### Buttons
+$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Button(-text => "Capture SQL", -command => $grab_cb)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->Button(-text => "Copy to Explain",
+ -command => sub { copy_sql($GrabSql, $GrabSelection); })
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->Button(-text => "Close", -command => sub { $GrabMain->withdraw(); })
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->pack(-fill => "x");
+}
+
+################################################################################
+# Main
+
+### Main window
+$ProgName = basename($0);
+$ProgName =~ s/\..*$//;
+$PlanMain = MainWindow->new();
+$PlanMain->withdraw();
+update_title();
+$Balloon = $PlanMain->Balloon();
+
+### Splash screen
+my $splash;
+if (@ARGV == 0 || $ARGV[0] ne '-q')
+ {
+ about($PlanMain, \$splash);
+ $splash->after(10000,
+ sub { if ($splash) { $splash->destroy(); undef($splash); } });
+ $PlanMain->update();
+ }
+else
+ { shift(@ARGV); }
+
+### Menubar
+my $menubar = $PlanMain->Frame(-relief => "raised", -borderwidth => 3);
+
+# Create a bold font $ figure out charcter spacing
+my $t = $PlanMain->Text();
+my $f = $t->cget(-font);
+$t->fontCreate("bold", $PlanMain->fontActual($f), -weight => "bold");
+$CharWidth = $PlanMain->fontMeasure($f, "X");
+undef($f);
+$t->destroy();
+undef($t);
+
+my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
+$menubar_file->command(-label => "Login ...", -underline => 0,
+ -command => sub { login_dialog($PlanMain); });
+$menubar_file->command(-label => "Schema ...", -underline => 2,
+ -command => sub { schema_dialog($PlanMain); });
+$menubar_file->command(-label => "Explain", -underline => 0,
+ -command => \&explain);
+$menubar_file->command(-label => "SQL Cache ...", -underline => 4,
+ -command => \&grab_main);
+$menubar_file->separator();
+$menubar_file->command(-label => "Open File ...", -underline => 0,
+ -command => sub { open_dialog($PlanMain); });
+$menubar_file->command(-label => "Save File ...", -underline => 0,
+ -command => sub { save_dialog($PlanMain, $PlanSql); });
+$menubar_file->separator();
+$menubar_file->command(-label => "Exit", -underline => 1,
+ -command => sub { $Db->disconnect() if ($Db); exit(0); });
+$menubar_file->pack(-side => "left");
+
+my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
+$menubar_help->command(-label => "About ...", -underline => 0,
+ -command => sub { about($PlanMain); });
+$menubar_help->command(-label => "Usage ...", -underline => 0,
+ -command => sub { help($PlanMain); });
+$menubar_help->pack(-side => "right");
+$menubar->pack(-fill => "x");
+
+### Query plan tree
+my $frame;
+$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
+$PlanTitle = $frame->Label(-text => "Query Plan")->pack(-anchor => "nw");
+my $b1_cb = sub
+ { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); };
+my $b3_cb = sub
+ { error($PlanMain, $@) if (! eval { disp_index_popup($_[0])}); };
+$PlanTree = $frame->Scrolled("B3Tree", -height => 15, -width => 80,
+ -borderwidth => 0, -highlightthickness => 1,
+ -scrollbars => "osoe",
+ -browsecmd => \&disp_plan_step,
+ -command => $b1_cb, -b3command => $b3_cb)
+ ->pack(-expand => 1, -fill => "both");
+$frame->pack(-expand => 1, -fill => "both");
+
+### Query plan statement details
+$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Label(-text => "Query Step Details")->pack(-anchor => "nw");
+$PlanStep = $frame->Scrolled("ROText", -height => 8, -width => 80,
+ -borderwidth => 0, -wrap => "none",
+ -setgrid => "true", -scrollbars => "osoe")
+ ->pack(-fill => "x");
+$frame->pack(-fill => "x");
+
+### SQL text editor
+$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Label(-text => "SQL Editor")->pack(-anchor => "nw");
+$PlanSql = $frame->Scrolled("Text", -setgrid => "true", -scrollbars => "oe",
+ -borderwidth => 0, -height => 15, -width => 80,
+ -wrap => "word")
+ ->pack(-expand => 1, -fill => "both");
+$frame->pack(-expand => 1, -fill => "both");
+
+### Buttons
+$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
+$frame->Button(-text => "Explain", -command => \&explain)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->Button(-text => "Clear", -command => \&clear_editor)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->Button(-text => "SQL Cache", -command => \&grab_main)
+ ->pack(-side => "left", -expand => 1, -pady => 6);
+$frame->pack(-fill => "x");
+
+### user/pass@db command-line argument processing
+$PlanMain->update();
+$PlanMain->deiconify();
+$splash->raise() if (defined($splash));
+if (@ARGV >= 1 && $ARGV[0] =~ /\w*\/\w*(@\w+)?/)
+ {
+ my ($username, $password, $database) = split(/[\/@]/, shift(@ARGV));
+ if (! $username) { $username = "/"; $password = ""; }
+ if (! $database) { $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; }
+ error($PlanMain, $@) if (! eval { login($database, $username, $password); });
+ update_title();
+ }
+else
+ {
+ login_dialog($PlanMain);
+ }
+
+### SQL filename argument processing
+if (@ARGV >= 1 && -r $ARGV[0])
+ {
+ my $file = shift(@ARGV);
+ if (open_file($file))
+ {
+ $FileDir = dirname($file);
+ explain() if ($Db);
+ }
+ }
+
+# Doncha just love GUI programming :-)
+MainLoop();
+
+################################################################################
+__END__
+
+=head1 NAME
+
+ora_explain.pl - Visualise Oracle query plans
+
+=head1 SYNOPSIS
+
+ $ ora_explain.pl [ [ user/password@database ] sql script ]
+
+=head1 DESCRIPTION
+
+Explain is a GUI-based tool that enables easier visualisation of Oracle Query
+plans. A query plan is the access path that Oracle will use to satisfy a SQL
+query. The Oracle query optimiser is responsible for deciding on the optimal
+path to use. Needless to say, understanding such plans requires a fairly
+sophisticated knowledge of Oracle architecture and internals.
+
+Explain allows a user to interactively edit a SQL statemant and view the
+resulting query plan with the click of a single button. The effects of
+modifying the SQL or of adding hints can be rapidly established.
+
+Explain allows the user to capture all the SQL currently cached by Oracle. The
+SQL capture can be filtered and sorted by different criterea, e.g. all SQL
+matching a pattern, order by number of executions etc.
+
+Explain is written using Perl, DBI/DBD::Oracle and Tk.
+
+=head1 PREREQUISITES
+
+=over 2
+
+=item 1.
+
+Oracle 7 or Oracle 8, with SQL*Net if appropriate
+
+=item 2.
+
+L<Perl 5.004_04|perl> or later
+
+=item 3.
+
+L<DBI> version 1.02 or later
+
+=item 4.
+
+L<DBD::Oracle> 0.54 or later
+
+=item 5.
+
+L<Tk|Tk::overview> 800.011 or later
+
+=item 6.
+
+L<Tk::Pod> 3.15 or later
+
+=back
+
+Items 2 through 6 can be obtained from any CPAN mirror.
+
+=head1 HOW TO USE
+
+Type "ora_explain.pl" at the shell prompt. A window will appear with
+a menu bar and three frames, labelled "Query Plan", "Query Step Details" and
+"SQL Editor". At the bottom of the window are three buttons labelled
+"Explain", "Clear" and "SQL Cache". A login dialog will also appear, into
+which you should enter the database username, password and database instance
+name (SID). The parameters you enter are passed to the DBI->connect() method,
+so if you have any problems refer to the DBI and DBD::Oracle documentation.
+
+Optionally you may supply up to two command-line arguments. If the first
+argument is of the form username/password@database, explain will use this to
+log in to Oracle, otherwise if it is a filename it will be loaded into the SQL
+editor. If two arguments are supplied, the second one will be assumed to be a
+filename.
+
+Examples:
+
+ explain scott/tiger@DEMO query.sql
+ explain / query.sql
+ explain query.sql
+
+=head2 Explain functionality
+
+The menu bar has two pulldown menus, "File" and "Help". "File" allows you to
+login to Oracle, Change the current schema, Capture the contents of the Oracle
+SQL cache, Load SQL from files, Save SQL to files and to Exit the program.
+"Help" allows you to view release information and read this documentation.
+
+The "SQL Editor" frame allows the editing of a SQL statement. This should be
+just a single statement - multiple statements are not allowed. Refer to the
+documentation for the Tk text widget for a description of the editing keys
+available. Text may be loaded and saved by using the "File" pulldown menu.
+
+Once you have entered a SQL statement, the "Explain" button at the bottom of
+the window will generate the query plan for the statement. A tree
+representation of the plan will appear in the "Query Plan" frame. Individual
+"legs" of the plan may be expanded and collapsed by clicking on the "+' and "-"
+boxes on the plan tree. The tree is drawn so that the "innermost" or "first"
+query steps are indented most deeply. The connecting lines show the
+"parent-child" relationships between the query steps. For a comprehensive
+explanation of the meaning of query plans you should refer to the relevant
+Oracle documentation. The "Clear" button will empty the editor & query plan
+tree panes.
+
+Single-clicking on a plan step in the Query Plan pane will display more
+detailed information on that query step in the Query Step Details frame. This
+information includes Oracle's estimates of cost, cardinality and bytes
+returned. The exact information displayed depends on the Oracle version.
+Again, for detailed information on the meaning of these fields, refer to the
+Oracle documentation.
+
+Double-clicking on a plan step that refers to either a table or an index will
+pop up a dialog box showing the definition of the table or index in a format
+similar to that of the SQL*Plus 'desc' command.
+
+The dialog that appears has a button labelled 'Index'. Clicking on this will
+expand the table dialog to show all the indexes defined on the table. Each
+column represents an index, and the figures define the order that the table
+columns appears in the index. To find out the name of an index, position the
+mouse over the index column. A single click will display the definition of the
+index in a separate dialog.
+
+Right-clicking on a plan step that refers to a table will pop up a menu showing
+a list of the indexes available for the table. Selecting an index will display
+its definition in a dialog box.
+
+=head2 Capture SQL Cache functionality
+
+The explain window has an option on the "File" menu labelled "SQL Cache ...",
+as well as a button with the same function. Selecting this will popup a new
+top-level window containing a menu bar and three frames, labelled "SQL Cache",
+"SQL Statement Statistics" and "SQL Selection Criterea". At the bottom of the
+window are three buttons labelled "Capture SQL", "Explain" and "Close".
+
+The menu bar has two pulldown menus "File" and "Help". "File" allows you to
+Save the contents of the SQL Cache pane to a file, copy the selected SQL
+statement to the Explain window and Close the Grab window.
+
+The "SQL Cache" frame shows the statements currently in the Oracle SQL cache.
+As you move the cursor over this window, each SQL statement will be highlighted
+with an outline box. Single-clicking on a statement in the SQL Cache pane will
+highlight the stamement in green and display more detailed information on that
+statement in the SQL Statement Statistics frame.
+
+If you want to save the entire contents of the SQL Cache pane, you can do this
+from the "File" menu.
+
+The "SQL Selection Criterea" frame allows you to specify which SQL statements
+you are interested in, and how you want them sorted. The pattern used to select
+statements is a normal perl regexp. Once you have defined the selection
+criterea, clicking the "Capture SQL" button will read all the matching
+statements from the SQL cache and display them in the top frame.
+
+Double-clicking on a statement in the "SQL Cache" pane, selecting "Explain"
+from the "File" menu or clicking the "Explain" button will copy the currently
+highlighted statement in the "SQL Cache" pane to the SQL editor in the Explain
+window, so that the query plan for the statement can be examined. Note also
+that the current schema will be changed to that of the user who first executed
+the captured statement.
+
+=head1 SEE ALSO
+
+This tool assumes that you already know how to interpret Oracle query plans.
+If need an explanation of the information displayed by this tool, you should
+refer to the appropriate Oracle documentation. Information can be found in the
+"Concepts" and "Oracle Tuning" manuals - look for "Query plan" and "Explain
+plan". Two other useful sources of information are:
+
+ Oracle Performance Tuning, 2nd ed.
+ Mark Gurry and Peter Corrigan
+ O'Reilly & Associates, Inc.
+ ISBN 1-56592-237-9
+
+ Advanced Oracle Tuning and Administration
+ Eyal Aronoff, Kevin Loney and Noorali Sonawalla
+ Oracle Press (Osborne)
+ ISBN 0-07-882241-6
+
+=head1 SUPPORT
+
+Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+Copyright (c) 1999 Alan Burlison
+
+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 code is provided with no warranty of any kind, and is used entirely at
+your own risk.
+
+This code was written by the author as a private individual, and is in no way
+endorsed or warrantied by Sun Microsystems.
+
+=cut
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+#
+# Dump the contents of an Oracle table into a set of insert statements.
+# Quoting is controlled by the datatypes of each column. (new with DBI)
+#
+# Usage: oradump <database> <user> <pass> <table>
+#
+# Author: Kevin Stock (original oraperl script)
+# Date: 28th February 1992
+#
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 base user pass table\n" if 4 > @ARGV;
+my ( $base, $user, $pass, $table ) = @ARGV;
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare( "SELECT * FROM $table");
+$sth->execute;
+my @name = @{$sth->{NAME}};
+my @type = @{$sth->{TYPE}};
+my $lead = "INSERT INTO $table ( " . join( ', ', @name ) . " ) VALUES ( ";
+my ( @data, $i );
+$sth->bind_columns( {}, \( @data[0 .. $#name] ) );
+while ( $sth->fetch ) {
+ $i = 0;
+ print $lead . join( ", ", map { $dbh->quote( $_, $type[$i++] ) } @data ) .
+ # print $lead . join( ", ", map { $dbh->quote( $_ ) } @data ) . # for old DBI
+ " );\n";
+}
+
+$sth->finish;
+$dbh->disconnect;
@@ -0,0 +1,148 @@
+#!/usr/bin/env perl
+# Short examples of procedure calls from Oracle.pm
+# These PL/SQL examples come from: Eric Bartley <bartley@cc.purdue.edu>.
+
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
+my ( $inst, $user, $pass ) = @ARGV;
+
+# So we don't have to check every DBI call we set RaiseError.
+# See the DBI docs if you're not familiar with RaiseError.
+# AutoCommit is currently encouraged and may be required later.
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die "Unable to connect: $DBI::errstr";
+
+# Create the package for the examples
+$dbh->do( <<END_PLSQL_EXAMPLE );
+CREATE OR REPLACE PACKAGE plsql_example IS
+ PROCEDURE proc_np;
+ PROCEDURE proc_in( err_code IN NUMBER );
+ PROCEDURE proc_in_inout( test_num IN NUMBER, is_odd IN OUT NUMBER );
+ FUNCTION func_np RETURN VARCHAR2;
+END plsql_example;
+END_PLSQL_EXAMPLE
+
+$dbh->do( <<END_PLSQL_EXAMPLE );
+CREATE OR REPLACE PACKAGE BODY plsql_example IS
+ PROCEDURE proc_np IS
+ whoami VARCHAR2(20) := NULL;
+ BEGIN
+ SELECT user INTO whoami FROM DUAL;
+ END;
+
+ PROCEDURE proc_in( err_code IN NUMBER ) IS
+ BEGIN
+ RAISE_APPLICATION_ERROR( err_code, 'This is a test.' );
+ END;
+
+ PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ) IS
+ BEGIN
+ is_odd := MOD( test_num, 2 );
+ END;
+
+ FUNCTION func_np RETURN VARCHAR2 IS
+ ret_val VARCHAR2(20);
+ BEGIN
+ SELECT user INTO ret_val FROM DUAL;
+ RETURN ret_val;
+ END;
+END plsql_example;
+END_PLSQL_EXAMPLE
+
+my $sth;
+
+print "\nExample 1\n";
+# Calling a PLSQL procedure that takes no parameters. This shows you the
+# basic's of what you need to execute a PLSQL procedure. Just wrap your
+# procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
+#
+# p.s. If you've used SQL*Plus's exec command all it does is wrap the
+# command in a BEGIN END; block for you.
+
+$sth = $dbh->prepare( q{
+BEGIN
+ plsql_example.proc_np;
+END;
+} );
+$sth->execute;
+
+
+print "\nExample 2\n";
+# Now we call a procedure that has 1 IN parameter. Here we use bind_param
+# to bind out parameter to the prepared statement just like you might
+# do for an INSERT, UPDATE, DELETE, or SELECT statement.
+#
+# I could have used positional placeholders (e.g. :1, :2, etc.) or
+# ODBC style placeholders (e.g. ?), but I prefer Oracle's named
+# placeholders (but few DBI drivers support them so they're not portable).
+#
+# proc_in() will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
+# Because we set RaiseError, the DBI will die() so we catch that with eval {}.
+
+my $err_code = -20001;
+
+$sth = $dbh->prepare( q{
+BEGIN
+ plsql_example.proc_in( :err_code );
+END;
+} );
+$sth->bind_param( ":err_code", $err_code );
+eval { $sth->execute; };
+print 'After proc_in: $@ = ', "'$@', errstr = '$DBI::errstr'\n";
+
+
+print "\nExample 3\n";
+# Building on the last example, I've added 1 IN OUT parameter. We still
+# use a placeholders in the call to prepare, the difference is that
+# we now call bind_param_inout to bind the value to the place holder.
+#
+# Note that the third parameter to bind_param_inout is the maximum size
+# of the variable. You normally make this slightly larger than necessary.
+# But note that the perl variable will have that much memory assigned to
+# it even if the actual value returned is shorter.
+
+my $test_num = 5;
+my $is_odd;
+
+$sth = $dbh->prepare( q{
+BEGIN
+ plsql_example.proc_in_inout( :test_num, :is_odd );
+END;
+} );
+
+# The value of $test_num is _copied_ here
+$sth->bind_param( ":test_num", $test_num );
+$sth->bind_param_inout( ":is_odd", \$is_odd, 1 );
+
+# The execute will automagically update the value of $is_odd
+$sth->execute;
+print "$test_num is ", $is_odd ? "odd - ok" : "even - error!", "\n";
+
+
+print "\nExample 4\n";
+# What about the return value of a PL/SQL function? Well treat it the same
+# as you would a call to a function from SQL*Plus. We add a placeholder
+# for the return value and bind it with a call to bind_param_inout so
+# we can access it's value after execute.
+
+my $whoami = "";
+
+$sth = $dbh->prepare( q{
+BEGIN
+ :whoami := plsql_example.func_np;
+END;
+} );
+$sth->bind_param_inout( ":whoami", \$whoami, 30 );
+$sth->execute;
+print "Your database user name is $whoami\n";
+
+# Get rid of the example package
+$dbh->do( 'DROP PACKAGE plsql_example' );
+$dbh->disconnect;
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use DBI;
+
+my $dbh = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' );
+
+$dbh->{RaiseError} = 1;
+$dbh->{LongTruncOk} = 1; # truncation on initial fetch is ok
+
+my $sth = $dbh->prepare("SELECT key, long_field FROM table_name");
+$sth->execute;
+
+while ( my ($key) = $sth->fetchrow_array) {
+ my $offset = 0;
+ my $lump = 4096; # use benchmarks to get best value for you
+ my @frags;
+ while (1) {
+ my $frag = $sth->blob_read(1, $offset, $lump);
+ last unless defined $frag;
+ my $len = length $frag;
+ last unless $len;
+ push @frags, $frag;
+ $offset += $len;
+ }
+ my $blob = join "", @frags;
+ print "$key: $blob\n";
+}
+
@@ -0,0 +1,235 @@
+#!/usr/bin/perl -w
+'di';
+'ig00';
+# See usage() for syntax
+
+use Getopt::Long;
+
+use DBI;
+
+use strict;
+
+# Default values for options
+my ( $trace, $inst, $cache, $delim, $format, $headers, $page_len, $null_str ) =
+ ( 0, $ENV{TWO_TASK} || $ENV{ORACLE_SID} || '', '', "\t", 0, 0, 60, '' );
+
+# Syntax description
+sub usage {
+ my ( $sOpt, $sVal, @sMsg ) = @_;
+
+ my $sHelpText = <<END_HELP_END;
+Execute a SQL statement
+syntax: $0 [options] name pass [stmt]
+Options:
+ -h Write this help to STDOUT
+ -t trace trace control string
+ -b base database to use (default $inst)
+ -c cache SQL fetch cache size in rows
+ -d delim specifies the field delimiter (default TAB)
+ -F format output, similar to sqlplus
+ -H add headers, not allowed if formatting
+ -l page_len lines per page, only used by -f (default $page_len)
+ -n string replace NULL fields by string
+Arguments:
+ name Oracle username
+ pass Password
+ stmt Oracle statement to be executed
+ it is read from STDIN if not given on command line
+END_HELP_END
+# Balance quotes in here document # ' # "
+
+ my $nRet = 'help' eq $sOpt ? 0 : 0 + $sVal;
+ my $fh = $nRet ? *STDERR : *STDOUT;
+ foreach ( @sMsg, $sHelpText ) { s/\s+$//; print $fh "$_\n"; }
+ exit $nRet;
+}
+
+# Get options and arguments
+Getopt::Long::config( qw( no_ignore_case no_auto_abbrev require_order ) );
+GetOptions(
+ 'help|h' => \&usage,
+ 'trace|t=i' => \$trace,
+ 'base|b=s' => \$inst,
+ 'cache|c=i' => \$cache,
+ 'delim|d=s' => \$delim,
+ 'Format!' => \$format, 'F!' => \$format,
+ 'Headers!' => \$headers, 'H!' => \$headers,
+ 'len|len=i' => \$page_len,
+ 'null|n=s' => \$null_str,
+ ) or usage( 'die', 1 );
+usage( 'die', 1, "Only one of -F and -H may be specified\n" )
+ if $format && $headers;
+
+usage( 'die', 1, 'Username and password are required' ) if 2 > @ARGV;
+my ( $user, $pass, @stmt ) = @ARGV;
+if ( ! @stmt ) {
+ print "Enter the statement to execute (^D to end):\n";
+ @stmt = <STDIN>;
+}
+usage( 'die', 1, "A statement is required" ) if ! @stmt;
+
+$\ = "\n"; # each record terminated with newline
+$, = $delim; # set column delimiter
+$= = $page_len; # set page length
+
+# Set trace level
+DBI->trace( $trace );
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+$dbh->{RowCacheSize} = $cache if $cache; # set fetch cache
+
+# Start statement
+my $sth = $dbh->prepare( join "\n", @stmt );
+$sth->execute;
+my $nfields = $sth->{NUM_OF_FIELDS};
+
+# print out any information which comes back
+if ( $nfields ) {
+ # the statement has output columns
+ my ( @col, $col );
+ my @name = @{$sth->{NAME}};
+ if ( $format ) {
+ # build format statements for the data
+ my @size = @{$sth->{PRECISION}};
+
+ # First, the header - a list of field names, formatted
+ # in columns of the appropriate width
+ my $fmt = join '|', map { "%-${_}.${_}s" } @size;
+ $fmt = sprintf $fmt, @name;
+ $format = "format STDOUT_TOP =\n" . $fmt . "\n";
+
+ # Then underlines for the field names
+ $fmt =~ tr/|/-/c;
+ $fmt =~ tr/|/+/;
+ $format .= $fmt . "\n.\n";
+
+ # Then for the data format, a @<<... field per column
+ $fmt =~ tr/-+/<|/;
+ $fmt =~ s/(^|\|)</$1@/g;
+ $format .= "format STDOUT =\n" . $fmt . "\n";
+
+ # Finally the variable associated with each column
+ # Why doesn't Perl let us specify an array here?
+ $format .= join ', ', map { "\$col[$_]" } 0 .. $#name;
+ $format .= "\n.\n";
+
+ eval($format);
+ }
+ elsif ( $headers ) {
+ # Simple headers with underlines
+ print map { s/\s+$//; $_ } @name;
+ print map { tr//-/c; $_ } @name;
+ }
+
+ # Associate @col with output columns and fetch the rows
+ $sth->bind_columns( {}, \( @col[0 .. $#name] ) );
+ while ( $sth->fetch ) {
+ foreach $col ( @col ) { $col = $null_str if ! defined $col; }
+ $format ? write : print @col;
+ }
+}
+
+# finish off neatly
+$sth->finish;
+$dbh->disconnect;
+
+__END__ # no need for perl even to scan the rest
+
+##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+.00; # finish .ig
+
+'di \" finish diversion--previous line must be blank
+.nr nl 0-1 \" fake up transition to first page again
+.nr % 0 \" start at page 1
+';<<'.ex'; ############## From here on it's a standard manual page ############
+.TH SQL L "5th July 1999"
+.ad
+.nh
+.SH NAME
+sql \- execute an Oracle SQL statement from the command line
+.SH SYNOPSIS
+\fBsql\fP
+[\fB\-b\fP\fIbase\fP]
+[\fB\-c\fP\fIcache\fP]
+[\fB\-d\fP\fIdelim\fP]
+[\fB\-F\fP|\fB\-H\fP]
+[\fB\-l\fP\fIpage_len\fP]
+[\fB\-n\fP\fIstring\fP]
+\fIname\fP \fIpassword\fP
+\fIstatement\fP
+.SH DESCRIPTION
+.I Sql
+connects to an Oracle database
+using the \fIname\fP and \fIpassword\fP supplied
+and executes the given SQL \fIstatement\fP
+displaying the result
+on its standard output.
+
+The \fB\-b\fP\fIbase\fP flag may be supplied to specify the database to be used.
+If it is not given, the database specified by the environment variable
+\fBTWO_TASK\fP or \fBORACLE_SID\fP is used.
+
+The \fB\-c\fP\fIcache\fP flag may be supplied to set the size of fetch cache
+to be used. If it is not given, the default is used.
+
+If the \fB\-n\fP\fIstring\fP flag is supplied,
+\fBNULL\fP fields (in the \fIOracle\fP sense)
+will replaced in the output by \fIstring\fP.
+Normally, they are left blank.
+
+The \fB\-F\fP and \fB\-H\fP flags may be used to modify the form of the output.
+Without either flag, no field headers are printed
+and fields are not padded.
+With the \fB\-H\fP flag,
+field headers are added to the top of the output,
+but the format is otherwise unchanged.
+With the \fB\-F\fP flag,
+the output is formatted in a tabular form similar to that used by \fIsqlplus\fP,
+except that all fields are left\-justified, regardless of their data type.
+Column headers are printed at the top of each page;
+a page is assumed to be 60 lines long,
+but this may be overridden with the \fB\-l\fP\fIpage_len\fP flag.
+
+Without the \fB\-F\fP flag, fields are separated with tabs;
+this may be changed to any desired string (\fIdelim\fP)
+using the \fB\-d\fP flag.
+.SH ENVIRONMENT
+The environment variable \fBTWO_TASK\fP or \fBORACLE_SID\fP
+determines the Oracle database to be used
+if the \fB\-b\fP\fIbase\fP flag is not supplied.
+.SH DIAGNOSTICS
+.in +5
+.ti -5
+\fBonly one of \-F and \-H may be specified\fP
+.br
+the \fB\-F\fP and \fB\-H\fP options are mutually exclusive,
+but both were specified
+
+.in -5
+The only other diagnostics generated by \fIsql\fP are usage messages,
+which should be self\-explanatory.
+However, you may also encounter
+error messages from DBI (unlikely) or from Oracle (more common).
+See the \fIOracle Error Messages and Codes Manual\fP for details.
+.SH NOTES
+This program is only intended for use from the command line.
+If you use it within a shell script
+then you should consider rewriting your script in DBI
+to use Perl's text manipulation and formatting commands.
+.SH "SEE ALSO"
+\fISQL Language Reference Manual\fP
+.br
+perl(1),
+oraperl(1)
+.SH AUTHOR
+Kevin Stock,
+.if t .ft C
+<kstock@encore.com>
+.if t .ft P
+.ex
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+#
+# tabinfo
+#
+# Usage: tabinfo base user password table
+#
+# Displays the structure of the specified table.
+# Note that the field names are restricted to the length of the field.
+# This is mainly to show the use of &ora_lengths, &ora_titles and &ora_types.
+#
+use DBI;
+
+use strict;
+
+# Set trace level if '-# trace_level' option is given
+DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
+
+# read the compulsory arguments
+die "syntax: $0 base user password table ...\n" if 4 > @ARGV;
+my ( $base, $user, $pass, @table ) = @ARGV;
+
+my ( $table, @name, @length, @type, %type_name, $i );
+format STDOUT_TOP =
+Structure of @<<<<<<<<<<<<<<<<<<<<<<<
+$table
+
+Field name | Length | Type | Type Name
+----------------------------------------------+--------+------+-----------------
+.
+
+format STDOUT =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>>>> | @>>> | @<<<<<<<<<<<<<<<
+$name[$i], $length[$i], $type[$i], $type_name{$type[$i]}
+.
+
+# Connect to database
+my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass,
+ { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
+ or die $DBI::errstr;
+
+# Associate type names to types
+{
+ my $type_info_all = $dbh->type_info_all;
+ my $iname = $type_info_all->[0]{TYPE_NAME};
+ my $itype = $type_info_all->[0]{DATA_TYPE};
+ my $rtype;
+ shift @$type_info_all;
+ foreach $rtype ( @$type_info_all ) {
+ $type_name{$$rtype[$itype]} = $$rtype[$iname]
+ if ! exists $type_name{$$rtype[$itype]};
+ }
+}
+
+my $sth;
+foreach $table ( @table ) {
+ $sth = $dbh->prepare( "SELECT * FROM $table WHERE 1 = 2");
+ @name = @{$sth->{NAME}};
+ @length = @{$sth->{PRECISION}};
+ @type = @{$sth->{TYPE}};
+
+ foreach $i ( 0 .. $#name ) {
+ write;
+ }
+ $- = 0;
+ $sth->finish;
+}
+
+$dbh->disconnect;
@@ -1,3 +1,4 @@
_dlsym
_dlclose
+_poll
@@ -1,66 +1,329 @@
package DBD::Oracle::GetInfo;
+$DBD::Oracle::GetInfo::VERSION = '1.74';
+BEGIN {
+ $DBD::Oracle::GetInfo::AUTHORITY = 'cpan:PYTHIAN';
+}
+# ABSTRACT: Wrapper to get Oracle information
+use strict;
use DBD::Oracle();
-my $fmt = '%02d.%02d.%1d%1d%1d%1d'; # ODBC version string: ##.##.#####
+my $sql_driver = 'Oracle';
+my $sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.#####
+my ($a,$b,$c) = (0,0,0);
+my $ver = $DBD::Oracle::VERSION;
+my @parts = split /\./, $ver;
+$a = $parts[0];
+($b,$c) = split /_/, $parts[1];
+$c = 0 if !$c;
-my $sql_driver_ver = sprintf $fmt, split (/\./, "$DBD::Oracle::VERSION.0.0.0.0.0.0");
+my $sql_driver_ver = sprintf $sql_ver_fmt, $a, $b, $c;
sub sql_dbms_version {
my $dbh = shift;
- return sprintf $fmt, @{DBD::Oracle::db::ora_server_version($dbh)};
+ local $^W; # for ora_server_version having too few parts
+ return sprintf $sql_ver_fmt, @{DBD::Oracle::db::ora_server_version($dbh)};
}
+
+my @Keywords = qw(
+ACCESS
+AUDIT
+BFILE
+BLOB
+CLOB
+CLUSTER
+COMMENT
+COMPRESS
+EXCLUSIVE
+FILE
+IDENTIFIED
+INCREMENT
+INITIAL
+LOCK
+LONG
+MAXEXTENTS
+MINUS
+MODE
+MODIFY
+NCLOB
+NOAUDIT
+NOCOMPRESS
+NOWAIT
+NUMBER
+OFFLINE
+ONLINE
+PCTFREE
+RAW
+RENAME
+RESOURCE
+ROW
+ROWID
+ROWLABEL
+ROWNUM
+SHARE
+START
+SUCCESSFUL
+SYNONYM
+SYSDATE
+TRIGGER
+UID
+VALIDATE
+VARCHAR
+);
+
+
+sub sql_keywords {
+
+ return join ',', @Keywords;
+
+}
+
+
+
sub sql_data_source_name {
my $dbh = shift;
- return 'dbi:Oracle:' . $dbh->{Name};
+ return "dbi:$sql_driver:" . $dbh->{Name};
}
+
sub sql_user_name {
my $dbh = shift;
- # XXX OPS$
- return $dbh->{CURRENT_USER};
+ # CURRENT_USER is a non-standard attribute, probably undef
+ # Username is a standard DBI attribute
+ return $dbh->{CURRENT_USER} || $dbh->{Username};
}
-%info = (
- 117 => 0 # SQL_ALTER_DOMAIN
-, 114 => 2 # SQL_CATALOG_LOCATION
-, 10003 => 'N' # SQL_CATALOG_NAME
-, 41 => '@' # SQL_CATALOG_NAME_SEPARATOR
-, 42 => 'Database Link' # SQL_CATALOG_TERM
-, 87 => 'Y' # SQL_COLUMN_ALIAS
-, 22 => 1 # SQL_CONCAT_NULL_BEHAVIOR
-, 127 => 0 # SQL_CREATE_ASSERTION
-, 130 => 0 # SQL_CREATE_DOMAIN
-, 2 => \&sql_data_source_name # SQL_DATA_SOURCE_NAME
-, 17 => 'Oracle' # SQL_DBMS_NAME
-, 18 => \&sql_dbms_version # SQL_DBMS_VERSION
-, 6 => 'DBD/Oracle.pm' # SQL_DRIVER_NAME
-, 7 => $sql_driver_ver # SQL_DRIVER_VER
-, 136 => 0 # SQL_DROP_ASSERTION
-, 139 => 0 # SQL_DROP_DOMAIN
-, 28 => 1 # SQL_IDENTIFIER_CASE
-, 29 => '"' # SQL_IDENTIFIER_QUOTE_CHAR
-, 34 => 0 # SQL_MAX_CATALOG_NAME_LEN
-, 30 => 30 # SQL_MAX_COLUMN_NAME_LEN
-, 10005 => 30 # SQL_MAX_IDENTIFIER_LEN
-, 32 => 30 # SQL_MAX_OWNER_NAME_LEN
-, 34 => 0 # SQL_MAX_QUALIFIER_NAME_LEN
-, 32 => 30 # SQL_MAX_SCHEMA_NAME_LEN
-, 35 => 30 # SQL_MAX_TABLE_NAME_LEN
-, 107 => 30 # SQL_MAX_USER_NAME_LEN
-, 90 => 'N' # SQL_ORDER_BY_COLUMNS_IN_SELECT
-, 39 => 'Owner' # SQL_OWNER_TERM
-, 40 => 'Procedure' # SQL_PROCEDURE_TERM
-, 114 => 2 # SQL_QUALIFIER_LOCATION
-, 41 => '@' # SQL_QUALIFIER_NAME_SEPARATOR
-, 42 => 'Database Link' # SQL_QUALIFIER_TERM
-, 93 => 3 # SQL_QUOTED_IDENTIFIER_CASE
-, 39 => 'Owner' # SQL_SCHEMA_TERM
-, 14 => '\\' # SQL_SEARCH_PATTERN_ESCAPE
-, 13 => sub {"$_[0]->{Name}"} # SQL_SERVER_NAME
-, 94 => '$#' # SQL_SPECIAL_CHARACTERS
-, 45 => 'Table' # SQL_TABLE_TERM
-, 46 => 3 # SQL_TXN_CAPABLE
-, 47 => \&sql_user_name # SQL_USER_NAME
+
+our %info = (
+ 0 => 0, # SQL_MAX_DRIVER_CONNECTIONS
+ 1 => 0, # SQL_MAX_CONCURRENT_ACTIVITIES
+ 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME
+ 3 => 147209344, # SQL_DRIVER_HDBC
+ 4 => 147212776, # SQL_DRIVER_HENV
+# 5 => undef, # SQL_DRIVER_HSTMT
+ 6 => $INC{'DBD/Oracle.pm'}, # SQL_DRIVER_NAME
+ 7 => $sql_driver_ver, # SQL_DRIVER_VER
+ 8 => 191, # SQL_FETCH_DIRECTION
+ 9 => 1, # SQL_ODBC_API_CONFORMANCE
+ 10 => '03.52', # SQL_ODBC_VER
+ 11 => 'Y', # SQL_ROW_UPDATES
+ 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE
+ 13 => sub {"$_[0]->{Name}"}, # SQL_SERVER_NAME
+ 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE
+ 15 => 1, # SQL_ODBC_SQL_CONFORMANCE
+ 16 => 'DEVEL', # SQL_DATABASE_NAME
+ 17 => 'Oracle', # SQL_DBMS_NAME
+ 18 => \&sql_dbms_version, # SQL_DBMS_VERSION
+ 19 => 'Y', # SQL_ACCESSIBLE_TABLES
+ 20 => 'Y', # SQL_ACCESSIBLE_PROCEDURES
+ 21 => 'Y', # SQL_PROCEDURES
+ 22 => 1, # SQL_CONCAT_NULL_BEHAVIOR
+ 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR
+ 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR
+ 25 => 'N', # SQL_DATA_SOURCE_READ_ONLY
+ 26 => 8, # SQL_DEFAULT_TRANSACTION_ISOLATION
+ 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY
+ 28 => 1, # SQL_IDENTIFIER_CASE
+ 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR
+ 30 => 30, # SQL_MAXIMUM_COLUMN_NAME_LENGTH
+ 31 => 30, # SQL_MAXIMUM_CURSOR_NAME_LENGTH
+ 32 => 30, # SQL_MAXIMUM_SCHEMA_NAME_LENGTH
+ 33 => 92, # SQL_MAX_PROCEDURE_NAME_LEN
+ 34 => 0, # SQL_MAXIMUM_CATALOG_NAME_LENGTH
+ 35 => 30, # SQL_MAXIMUM_TABLE_NAME_LENGTH
+ 36 => 'Y', # SQL_MULT_RESULT_SETS
+ 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN
+ 38 => 'Y', # SQL_OUTER_JOINS
+ 39 => 'Owner', # SQL_SCHEMA_TERM
+ 40 => 'Procedure', # SQL_PROCEDURE_TERM
+ 41 => '@', # SQL_QUALIFIER_NAME_SEPARATOR
+ 42 => 'Database Link', # SQL_QUALIFIER_TERM
+ 43 => 7, # SQL_SCROLL_CONCURRENCY
+ 44 => 19, # SQL_SCROLL_OPTIONS
+ 45 => 'Table', # SQL_TABLE_TERM
+ 46 => 3, # SQL_TRANSACTION_CAPABLE
+ 47 => \&sql_user_name, # SQL_USER_NAME
+ 48 => 1, # SQL_CONVERT_FUNCTIONS
+ 49 => 16646015, # SQL_NUMERIC_FUNCTIONS
+ 50 => 8355839, # SQL_STRING_FUNCTIONS
+ 51 => 7, # SQL_SYSTEM_FUNCTIONS
+ 52 => 1023999, # SQL_TIMEDATE_FUNCTIONS
+ 53 => 10518015, # SQL_CONVERT_BIGINT
+ 54 => 10775839, # SQL_CONVERT_BINARY
+ 55 => 10518015, # SQL_CONVERT_BIT
+ 56 => 15106047, # SQL_CONVERT_CHAR
+ 57 => 164097, # SQL_CONVERT_DATE
+ 58 => 10518015, # SQL_CONVERT_DECIMAL
+ 59 => 10514943, # SQL_CONVERT_DOUBLE
+ 60 => 10514943, # SQL_CONVERT_FLOAT
+ 61 => 10518015, # SQL_CONVERT_INTEGER
+ 62 => 14680833, # SQL_CONVERT_LONGVARCHAR
+ 63 => 10518015, # SQL_CONVERT_NUMERIC
+ 64 => 10514943, # SQL_CONVERT_REAL
+ 65 => 10518015, # SQL_CONVERT_SMALLINT
+ 66 => 0, # SQL_CONVERT_TIME
+ 67 => 10718465, # SQL_CONVERT_TIMESTAMP
+ 68 => 10518015, # SQL_CONVERT_TINYINT
+ 69 => 10775839, # SQL_CONVERT_VARBINARY
+ 70 => 15204351, # SQL_CONVERT_VARCHAR
+ 71 => 265216, # SQL_CONVERT_LONGVARBINARY
+ 72 => 10, # SQL_TRANSACTION_ISOLATION_OPTION
+ 73 => 'N', # SQL_ODBC_SQL_OPT_IEF
+ 74 => 2, # SQL_CORRELATION_NAME
+ 75 => 1, # SQL_NON_NULLABLE_COLUMNS
+# 76 => undef, # SQL_DRIVER_HLIB
+ 77 => '03.52', # SQL_DRIVER_ODBC_VER
+ 78 => 1, # SQL_LOCK_TYPES
+ 79 => 1, # SQL_POS_OPERATIONS
+ 80 => 7, # SQL_POSITIONED_STATEMENTS
+ 81 => 15, # SQL_GETDATA_EXTENSIONS
+ 82 => 88, # SQL_BOOKMARK_PERSISTENCE
+ 83 => 0, # SQL_STATIC_SENSITIVITY
+ 84 => 0, # SQL_FILE_USAGE
+ 85 => 1, # SQL_NULL_COLLATION
+ 86 => 1029739, # SQL_ALTER_TABLE
+ 87 => 'Y', # SQL_COLUMN_ALIAS
+ 88 => 2, # SQL_GROUP_BY
+ 89 => \&sql_keywords, # SQL_KEYWORDS
+ 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT
+ 91 => 31, # SQL_SCHEMA_USAGE
+ 92 => 3, # SQL_QUALIFIER_USAGE
+ 93 => 3, # SQL_QUOTED_IDENTIFIER_CASE
+ 94 => '$#', # SQL_SPECIAL_CHARACTERS
+ 95 => 31, # SQL_SUBQUERIES
+ 96 => 3, # SQL_UNION_STATEMENT
+ 97 => 0, # SQL_MAXIMUM_COLUMNS_IN_GROUP_BY
+ 98 => 0, # SQL_MAXIMUM_COLUMNS_IN_INDEX
+ 99 => 0, # SQL_MAXIMUM_COLUMNS_IN_ORDER_BY
+ 100 => 1000, # SQL_MAXIMUM_COLUMNS_IN_SELECT
+ 101 => 1000, # SQL_MAXIMUM_COLUMNS_IN_TABLE
+ 102 => 0, # SQL_MAXIMUM_INDEX_SIZE
+ 103 => 'N', # SQL_MAX_ROW_SIZE_INCLUDES_LONG
+ 104 => 0, # SQL_MAXIMUM_ROW_SIZE
+ 105 => 0, # SQL_MAXIMUM_STATEMENT_LENGTH
+ 106 => 0, # SQL_MAXIMUM_TABLES_IN_SELECT
+ 107 => 30, # SQL_MAXIMUM_USER_NAME_LENGTH
+ 108 => 0, # SQL_MAX_CHAR_LITERAL_LEN
+ 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS
+ 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS
+ 111 => 'N', # SQL_NEED_LONG_DATA_LEN
+ 112 => 0, # SQL_MAX_BINARY_LITERAL_LEN
+ 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE
+ 114 => 2, # SQL_QUALIFIER_LOCATION
+ 115 => 127, # SQL_OUTER_JOIN_CAPABILITIES
+ 116 => 0, # SQL_ACTIVE_ENVIRONMENTS
+ 117 => 0, # SQL_ALTER_DOMAIN
+ 118 => 1, # SQL_SQL_CONFORMANCE
+ 119 => 0, # SQL_DATETIME_LITERALS
+ 120 => 0, # SQL_BATCH_ROW_COUNT
+ 121 => 0, # SQL_BATCH_SUPPORT
+ 122 => 15106047, # SQL_CONVERT_WCHAR
+ 123 => 0, # SQL_CONVERT_INTERVAL_DAY_TIME
+ 124 => 0, # SQL_CONVERT_INTERVAL_YEAR_MONTH
+ 125 => 14680833, # SQL_CONVERT_WLONGVARCHAR
+ 126 => 15106047, # SQL_CONVERT_WVARCHAR
+ 127 => 0, # SQL_CREATE_ASSERTION
+ 128 => 0, # SQL_CREATE_CHARACTER_SET
+ 129 => 0, # SQL_CREATE_COLLATION
+ 130 => 0, # SQL_CREATE_DOMAIN
+ 131 => 3, # SQL_CREATE_SCHEMA
+ 132 => 14305, # SQL_CREATE_TABLE
+ 133 => 0, # SQL_CREATE_TRANSLATION
+ 134 => 3, # SQL_CREATE_VIEW
+# 135 => undef, # SQL_DRIVER_HDESC
+ 136 => 0, # SQL_DROP_ASSERTION
+ 137 => 0, # SQL_DROP_CHARACTER_SET
+ 138 => 0, # SQL_DROP_COLLATION
+ 139 => 0, # SQL_DROP_DOMAIN
+ 140 => 0, # SQL_DROP_SCHEMA
+ 141 => 1, # SQL_DROP_TABLE
+ 142 => 0, # SQL_DROP_TRANSLATION
+ 143 => 1, # SQL_DROP_VIEW
+ 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1
+ 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2
+ 146 => 57345, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1
+ 147 => 2183, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2
+ 148 => 3, # SQL_INDEX_KEYWORDS
+ 149 => 65568, # SQL_INFO_SCHEMA_VIEWS
+ 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1
+ 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2
+ 152 => 3, # SQL_ODBC_INTERFACE_CONFORMANCE
+ 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS
+ 154 => 3, # SQL_PARAM_ARRAY_SELECTS
+ 155 => 0, # SQL_SQL92_DATETIME_FUNCTIONS
+ 156 => 0, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE
+ 157 => 0, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE
+ 158 => 16, # SQL_SQL92_GRANT
+ 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS
+ 160 => 7687, # SQL_SQL92_PREDICATES
+ 161 => 0, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS
+ 162 => 0, # SQL_SQL92_REVOKE
+ 163 => 0, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR
+ 164 => 0, # SQL_SQL92_STRING_FUNCTIONS
+ 165 => 1, # SQL_SQL92_VALUE_EXPRESSIONS
+ 166 => 3, # SQL_STANDARD_CLI_CONFORMANCE
+ 167 => 57935, # SQL_STATIC_CURSOR_ATTRIBUTES1
+ 168 => 4231, # SQL_STATIC_CURSOR_ATTRIBUTES2
+ 169 => 64, # SQL_AGGREGATE_FUNCTIONS
+ 170 => 3, # SQL_DDL_INDEX
+ 171 => '03.52.0002.0002', # SQL_DM_VER
+ 172 => 7, # SQL_INSERT_STATEMENT
+ 173 => 0, # SQL_CONVERT_GUID
+ 10000 => 1995, # SQL_XOPEN_CLI_YEAR
+ 10001 => 1, # SQL_CURSOR_SENSITIVITY
+ 10002 => 'Y', # SQL_DESCRIBE_PARAMETER
+ 10003 => 'N', # SQL_CATALOG_NAME
+ 10004 => '', # SQL_COLLATING_SEQUENCE
+ 10005 => 30, # SQL_MAXIMUM_IDENTIFIER_LENGTH
+ 10021 => 2, # SQL_ASYNC_MODE
+ 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS
+# 20000 => undef, # SQL_MAXIMUM_STMT_OCTETS
+# 20001 => undef, # SQL_MAXIMUM_STMT_OCTETS_DATA
+# 20002 => undef, # SQL_MAXIMUM_STMT_OCTETS_SCHEMA
);
1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::GetInfo - Wrapper to get Oracle information
+
+=head1 VERSION
+
+version 1.74
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,74 @@
+package DBD::Oracle::Object;
+$DBD::Oracle::Object::VERSION = '1.74';
+BEGIN {
+ $DBD::Oracle::Object::AUTHORITY = 'cpan:PYTHIAN';
+}
+# ABSTRACT: Wrapper for Oracle objects
+
+use strict;
+use warnings;
+
+sub type_name { shift->{type_name} }
+
+sub attributes { @{shift->{attributes}} }
+
+sub attr_hash {
+ my $self = shift;
+ return $self->{attr_hash} ||= { $self->attributes };
+}
+
+sub attr {
+ my $self = shift;
+ if (@_) {
+ my $key = shift;
+ return $self->attr_hash->{$key};
+ }
+ return $self->attr_hash;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Object - Wrapper for Oracle objects
+
+=head1 VERSION
+
+version 1.74
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,291 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Aix
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on AIX
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Aix - Tips and Hints to Troubleshoot DBD::Oracle on AIX
+
+=head1 VERSION
+
+version 1.74
+
+=head1 Using Visual Age 7 C Compiler
+
+Oracle 9i is only certified as a 64-bit application on AIX 5L (5.1,5.2,5.3) with 32-bit support;
+in other words, there is no 9i "32-bit" Oracle client
+
+Oracle 10g is certified as both a 64-bit application and a 32-bit Oracle client
+
+This information only pertains to deploying:
+
+ the DBI (version 1.48)
+ and DBD-Oracle (version 1.16):
+ on AIX 5.3
+ using Oracle 9i (9.2.0.1/9.2.0.5)
+ using the existing Perl 5.8.2 (no custom-built Perl) which is 32-bit
+ using Visual Age 7.0 C/C++ compiler
+
+Install the DBI (required for the DBD-Oracle install - no issues here)
+Untar the DBD-Oracle bundle
+Run Makefile.PL
+
+ $ perl Makefile.PL
+
+Edit Makefile with following commands:
+
+ 1,$s?/lib/ ?/lib32/ ?g
+ 1,$s?-q64??g
+ 1,$s?/lib/sysliblist?/lib32/sysliblist?g
+
+Now perform normal commands to perform the testing/making:
+
+ $ make
+ $ make test
+ $ make install
+
+I've tested the basics of the DBD-Oracle and it seems fully functional.
+
+Stephen de Vries
+
+=head1 Using gcc C Compiler
+
+ DBD::Oracle with gcc and Oracle Instant Client on AIX
+ --------------------------------------------------------------------------------------
+ Nathan Vonnahme Dec 15 2005, 4:28 pm Newsgroups: perl.dbi.users
+ See: http://groups.google.com/group/perl.dbi.users/msg/0bd9097f80f2c8a9
+ [ with updates 1/31/2006 - DBD::Oracle 1.17 doesn't need makefile hacking
+ to work with instantclient on AIX ]
+
+
+ Yes! It eluded me last year but I finally got DBD::Oracle working on an
+ AIX machine using gcc. Here's the short version:
+
+ First I had to recompile perl with gcc, using
+ sh Configure -de -Dcc=gcc
+ This apparently built a 32 bit perl, someday I will try getting it to go
+ 64 bit.
+
+ I was then able to install and build DBI 1.50 with the CPAN shell.
+
+ I downloaded the base and sdk packages of the Oracle Instant Client for
+ AIX -- first I tried the 64 bit but that didn't work with my 32 bit perl
+ -- the 32 bit version (still at 10.1.0.3) did the trick. I unzipped
+ them and moved the dir to /usr/local/oracle/instantclient10_1 and made a
+ symlink without the version at /usr/local/oracle/instantclient , then
+ set:
+
+ export ORACLE_HOME=/usr/local/oracle/instantclient
+ export LIBPATH=$ORACLE_HOME
+
+
+
+ Oracle wasn't providing the sqlplus package for 32 bit AIX so I
+ explicitly told Makefile.PL the version:
+
+ perl Makefile.PL -V 10.1
+
+ make
+
+ My test databases were on other machines so I set these environment variables
+ to get the tests to run:
+
+ export ORACLE_DSN=DBI:Oracle://host/dbinstance
+ export ORACLE_USERID="user/password"
+
+ make test
+ make install
+
+
+ NOTE: I have an older full version of Oracle on this machine, and the
+ ORACLE_HOME environment variable is normally set to point to that, so
+ my perl scripts that use DBD::Oracle have to make sure to first set
+ $ENV{ORACLE_HOME}='/usr/local/oracle/instantclient';
+
+
+
+
+
+ --------------------------------------------------------------------------------------
+ The following setup worked to build on AIX 5.2:
+ gcc-3.3.2 (32-bit) (configure opts [ --with-ld=/usr/ccs/bin/ld --with-as=/usr/ccs/bin/as])
+ Oracle-9.2.0 ( full install w/32bit support)
+ perl-5.8.3 (built with above gcc/latest stable as of March 2004)
+ Followed the directions from Rafael's email below, only set ORACLE_HOME, (and
+ the appropriate test environmentals).
+ 1) build perl-5.8.3 with gcc
+ 2) install DBI
+ 3) ORACLE_HOME="your oracle home"
+ ORACLE_USERID..
+ ORACLE_SID ..
+ (I ignored ORACCENV, didn't use it.)
+ 4) install DBD::Oracle, after perl Makefile.PL, edit the created Makefile,
+ changing references to Oracle's ../lib to ../lib32. and change crt0_64.o to
+ crt0_r.o. Remove the -q32 and/or -q64 options from the list of libraries to
+ link with.
+ 5) make should be clean, make test should pass.
+ This setup worked with 8.1.7 w/32 bit support, and with 9.2.0 w/ 32-bit support.
+ --Adrian Terranova
+
+=head1 Using xlc_r C Compiler
+
+ From: Rafael Caceres
+ Date: 22 Jul 2003 10:05:20 -0500
+
+ The following sequence worked for me on AIX 5.1:
+
+ -use Perl 5.8.0 (the latest stable from CPAN)
+
+ -use the xlc_r version of IBM's compiler and build a 32 bit Perl
+ (which xlc_r will do by default). All tests should be successful.
+
+ -get and install DBI
+
+ -get DBD::Oracle. Edit the Makefile.PL or Makefile for DBD::Oracle,
+ changing references to Oracle's ../lib to ../lib32. and change crt0_64.o
+ to crt0_r.o. Remove the -q32 and/or -q64 options from the list of
+ libraries to link with. Do the make and make test.
+
+ -Set up the environment for making DBD::Oracle:
+ ORACLE_HOME="your oracle home"
+ ORACCENV = "xlc_r"
+ ORACLE_USERID..
+ ORACLE_SID ..
+
+ -Run make, all tests should be successfull -against Oracle 9.x at least.
+
+ You should have no problems with Oracle 8.1.7, but accessing Oracle 7.x
+ or previous is not possible (you'll core dump, or simply hang). The same
+ goes for a Linux build or a Digital build, regarding access of different
+ Oracle versions.
+
+ Rafael Caceres
+
+ > I don't believe I compiled Oracle. During the installation it was linked
+ > but I am not sure it was compiled
+ >
+ > I used a xlc compiler to compile PERL.
+ > Got this message in the Perl Makefile.PL output
+ >
+ > Warning: You will may need to rebuild perl using the xlc_r compiler.
+ > You may also need do: ORACCENV='cc=xlc_r'; export ORACCENV
+ > Also see the README about the -p option
+ >
+ > this probably means I need to rebuild PERL with xlc_r??
+ >
+ > thanx
+ >
+ > Mike Paladino
+ > Database Administrator
+
+
+ From: Rafael Caceres
+ >
+ > Make sure you use the same compiler to build Oracle and Perl. We have
+ > used xlc_r on Aix 5.1 with no problems. Your Perl build is 32 bit, so
+ > when building DBD::Oracle, you should use the 32bit libraries (change
+ > references to .../oracle/lib to .../oracle/lib32 in your Makefile).
+ > Remove the references to the -q64 or -q32 parameters for ld in Makefile,
+ > as they shouldn't be there.
+ >
+ > Rafael Caceres
+
+
+ From: "cartman ltd"
+ Subject: Tip for DBI and DBD::Oracle on AIX 5.1 and Oracle 9.2
+ Date: Mon, 11 Aug 2003 18:15:38 +0000
+ Message-ID: <BAY1-F58Temqpg2ItZe00032a0f@hotmail.com>
+
+ Here is a tip for compiling DBD::Oracle as a 32 bit application on AIX 5.1
+ 64 bit and Oracle 9.2 64 bit without editing any makefiles. I hope people
+ find this useful:
+
+ First, the versions of products I used:
+ DBI version 1.32
+ DBD::Oracle version 1.14
+ Oracle 9.2.0.2 - default 64 bit application with 32 bit libraries
+ AIX 5.1 ML03 - 64 bit kernel - ships with Perl as a 32 bit application.
+ VisualAge C/C++ 5.0.2
+
+ Basically DBD must be compiled as 32 bit to link with Perl's 32 bit
+ libraries.
+ gunzip -c DBD-Oracle-1.14.tar.gz | tar xvf
+ cd DBD-Oracle-1.14
+ perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/demo_rdbms32.mk
+ make
+
+ NB: I think there is a bug in the Oracle 9.2.0.3 file
+ $ORACLE_HOME/rdbms/lib/env_rdbms.mk
+ I corrected this (before running the above commands) by replacing the
+ invalid linker option
+ LDFLAGS32=-q32
+ with
+ LDFLAGS32=-b32
+
+ Have fun: KC.
+ --------------------------------------------------------------------------------------
+
+ Date: Wed, 30 Jun 2004 23:34:24 -0500
+ From: "SCHULTZ, DARYLE (SBCSI)"
+
+ Got it to work. Using dbd 1.16
+
+ Perl 5.8.4 built like this, with Visual Age 6.0:
+
+ config_args='-Dcc=xlc_r -Dusenm -Dprefix=/appl/datasync/work/perl5
+ -Dusethreads -Duse64bitall -des'
+ ==============================================
+
+ Used DBI 1.42
+ =============================================
+ Added this to top of Oracle.h:
+ #define A_OSF
+
+ #include <oratypes.h>
+ =======================
+ Set LIBPATH to point to 64bit Oracle libs first.
+ export LIBPATH=$ORACLE_HOME/lib:$ORACLE_HOME/lib32:/usr/lib
+
+ Use: perl Makefile.PL -nob
+
+ Change all references in Makefile of LD_RUN_PATH to be LIBPATH.
+ Change nothing else, left all flags in Makefile, including -q64.
+ Passed make, and all tests.
+
+ --------------------------------------------------------------------------------------
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,112 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Cygwin
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Cygwin
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Cygwin - Tips and Hints to Troubleshoot DBD::Oracle on Cygwin
+
+=head1 VERSION
+
+version 1.74
+
+=head1 General Info
+
+Makefile.PL should find and make use of OCI include
+files, but you have to build an import library for
+OCI.DLL and put it somewhere in library search path.
+one of the possible ways to do this is issuing command
+
+ dlltool --input-def oci.def --output-lib liboci.a
+
+in the directory where you unpacked DBD::Oracle distribution
+archive. this will create import library for Oracle 8.0.4.
+
+Note: make clean removes '*.a' files, so put a copy in a safe place.
+
+=head1 Compiling DBD::Oracle using the Oracle Instant Client, Cygwin Perl and gcc
+
+=over
+
+=item 1
+
+Download these two packages from Oracle's Instant Client for
+Windows site
+(http://www.oracle.com/technology/software/tech/oci/instantclient/htdocs/winsoft.html):
+
+Instant Client Package - Basic: All files required to run OCI,
+OCCI, and JDBC-OCI applications
+
+Instant Client Package - SDK: Additional header files and an
+example makefile for developing Oracle applications with Instant Client
+
+(I usually just use the latest version of the client)
+
+=item 2
+
+Unpack both into C:\oracle\instantclient_11_1
+
+=item 3
+
+Download and unpack DBD::Oracle from CPAN to some place with no
+spaces in the path (I used /tmp/DBD-Oracle) and cd to it.
+
+=item 4
+
+Set up some environment variables (it didn't work until I got the
+DSN right):
+
+ ORACLE_DSN=DBI:Oracle:host=oraclehost;sid=oracledb1
+ ORACLE_USERID=username/password
+
+=item 5
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+=back
+
+Note, the TNS Names stuff doesn't always seem to work with the instant
+client so Perl scripts need to explicitly use host/sid in the DSN, like
+this:
+
+ my $dbh = DBI->connect('dbi:Oracle:host=oraclehost;sid=oracledb1',
+ 'username', 'password');
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,962 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Hpux
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on HP-UX
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Hpux - Tips and Hints to Troubleshoot DBD::Oracle on HP-UX
+
+=head1 VERSION
+
+version 1.74
+
+=head1 INTRODUCTION
+
+Building a working dynamically linked version of the Oracle DBD driver
+on HP-UX (11.00) has been a challenge for many. For months after taking
+a new job, where HP-UX was the standard database server environment, I
+had only been able to build a statically linked version of Perl and the
+DBD-Oracle module on HP-UX 11.00.
+
+Then Roger Foskett posted instructions for what turned out to be dynamic
+build. Rogers's post got me further than I had previously gotten. In
+fact, after resolving some undefined symbol errors, I succeeded where for
+I had previously despaired of finding the time to hack out the right
+incantation.
+
+This document describes the combined knowledge of a number of
+folks who invested many hours discovering a working set of build options.
+The instructions in this file, which include building Perl from source,
+will produce a working dynamically linked DBD-Oracle that can be used
+with mod_perl and Apache.
+
+See L<APPENDICES> for exact build configurations used by me an others.
+
+For HPUX 11 on Itanium see also
+http://www.nntp.perl.org/group/perl.dbi.users/23840
+
+=head1 First things First: Introduction
+
+The reason you are even reading this file is because you want to connect
+to an Oracle database from your perl program using the DBD::Oracle DBI
+driver. So before you start, install (at least the Oracle client
+software) (SQL*Net, Pro*C, SQL*Plus) upon the machine you intend to
+install Perl/DBI/DBD-Oracle. You B<do not>, I repeat, I<do not> need to
+build a database on this machine.
+
+After you have installed the Oracle client software, B<test it!>. Make
+sure you can connect to the target database using SQL*Plus (or any other
+Oracle supplied tool). The (gory) details of the install are beyond the
+scope of this document, some information can be found in the section
+L<Compiling on a Client Machine>, or see your friendly Oracle DBA.
+
+One final remark, 3 years after this was first written. This has been
+updated numerous times over the years. And some of the new build
+recipe's see simpler than some of the original instructions in this file.
+
+I think one reason the recipe is getting simpler may be that the build
+hints, in the base perl build have gotten more right, as we have moved
+from perl 5.6.1 to the 5.8.8 (now the stable version).
+
+Someday, if I ever find myself building on HP again I should probably
+update as many of these recipes (that I can test) by trying to remove
+more of the special case stuff I have in my build scripts now.
+Gram Ludlows's build for the default bundled C compiler shows that a lot
+of this may no longer be necessary.
+
+On the other hand, it would be bad if we deleted information that others
+might need, so I err on the side of too much, in the hope that the
+person who really needs the information, will not have to look beyond
+this file.
+
+ -- Lincoln
+
+=head1 Build your own Perl
+
+HP's default Perl is no good (and antique).
+
+By default, HP-UX 11.00 delivered Perl 5.00503 until September 2001.
+Others tell me that the default is a threaded GNUpro build of 5.6.1.
+This is not what I found on our systems, and it probably depends on which
+packages you install. In any case, this version of Perl delivered by
+HP will in all likelihood not work. Before you check, be sure to prevent
+the perl4 located in /usr/contrib/bin from being the first Perl version
+found in your $PATH.
+
+As of application release September 2001, HP-UX 11.00 is shipped with
+Perl-5.6.1 in /opt/perl. The first occurrence is on CD 5012-7954. The
+build is a portable hppa-1.1 multithread build that supports large files
+compiled with gcc-2.9-hppa-991112. When you have a modern system with a
+hppa-2.0 architecture (PA8xxx processor) and/or the HP C-ANSI-C compiler
+consider building your own Perl, which will surely outperform this
+version.
+
+If you are reading this, you have probably discovered that something did
+not work. To get a working version of the DBD-Oracle driver, we have to
+start with a Perl that as been built with the correct compiler flags and
+shared libraries. This means that you must build your own version of
+Perl from source.
+
+See L<EXAMPLE FILES> for a copy of a makefile used by me to build Perl on
+HP-UX and all other platforms on which he works (Sun and Red Hat).
+
+The instructions below have been used for building a dynamically linked
+working DBD-Oracle driver that works with mod_perl and Apache. These
+instructions are based on Perl 5.6.0 and 5.6.1, and 5.8.0. To this
+author's knowledge, they have not be tested on earlier versions of Perl.
+
+Note that is important to build a B<non>-threaded Perl, but linked with
+-lcl and -lpthread. Since Oracle on HP uses libpthread, everything that
+dynamically loads it (such as DBD-Oracle) must be built/linked
+with '-lpthread -lcl'. (When used with Apache, it and any associated
+modules must also be built this way - otherwise all it does is core
+dump when loading DBD::Oracle).
+
+A good link that explains thread local storage problems is
+http://my1.itrc.hp.com/cm/QuestionAnswer/1,1150,0x0d0a6d96588ad4118fef0090279cd0f9!0,00.html
+
+One more note, it would appear that the README.hpux in the Perl 5.8.0
+directory, is somewhat out of date, but is up-to-date in versions 5.8.3
+and up. H.Merijn Brand points out that Perl I<is> 64bit compliant when
+the -Duse64bitall flag is used to Configure. While Perl will be built
+in a pure LP64 environment via the +DD64 flag is used, the +DA2.0w flag
+is preferred on PA-RISC, and when an incantation can be concocted that
+eliminates the noisy warnings the produces at link time, this will
+probably become the default. Older 64bit versions of GCC, are known to
+be unable to build a good LP64 perl. And these flags will cause gcc to
+barf. On HP-UX 11i (11.11), gcc-3.4.4 or gcc-3.4.5 is preferred over
+gcc-4.0.2 (or older gcc-4 versions) as 64bit builds on PA-RISC with that
+versions of the compiler are unreliable.
+
+=head1 Compilers
+
+=head2 HP Softbench Compiler
+
+Both Roger Foskett, I and most others have been using the HP Softbench
+C compiler normally installed in:
+
+ /opt/softbench/bin/cc.
+
+While the DBD-Oracle F<Makefile.PL> checks for some of the conditions
+which, when met, we know will produce a working build, there are many
+variations of Oracle installations and features. Not all of these can
+be tested by any one of us, if you discover a way to make a variation
+which did not previously work, please submit patches to the Makefile.PL
+to Tim Bunce, and patches to this README to me, and I will incorporate
+them into the next README.
+
+The instructions herein, have compiled, linked cleanly, and tested
+cleanly using the HP softbench compiler, and Oracle 8.0.5 (32bit), and
+Oracle 8.1.6, 8.1.7 (64 bit). Oracle 8.1.5 will probably work as well.
+
+Oracle 8.1.7.4 (32bit) with DBI-1.35 and DBD-Oracle-1.13 has been proven
+to work on HP-UX 11.00 (64bit) with Perl 5.6.1, Perl 5.8.x using the
+guidelines in this document for both HP-C-ANSI-C and gcc-3.2. Later
+versions have been proven to work as well. Current DBI-1.42 and
+DBD-Oracle-1.16 have been proven to work. This Oracle 9.2 client (at
+least) should be used if you plan to do work with Unicode. See the
+DBD-Oracle POD/Man documentation.
+
+=head2 gcc Compiler
+
+As of gcc-3.4, perl-5.8.3 and up should build out-of-the box when
+Configure is invoked with -Dcc=gcc. Please read README.hpux carefully
+for the differences with HP C-ANSI-C. Once built, tested and installed,
+both DBI and DBD-Oracle should be able to build against that perl
+without trouble.
+
+In the past, Waldemar Zurowski and Michael Schuh sent useful information
+about builds of Perl with DBD-Oracle using gcc on HP-UX. Both were able
+to get working executables, and their explanations shed much light on
+the issues.
+
+Waldemar's build is described in L<Appendix A>, and Michael's is
+described in L<Appendix C>.
+
+While I have not reproduced either of these configurations, I believe
+the information is complete enough (particularly in the aggregate) to
+be helpful to others who might wish to replicate it.
+
+If someone would be willing to submit a makefile equivalent to the
+makefile in any of the examples from L<EXAMPLE FILES>, which uses gcc
+to build Perl and the DBI/DBD-Oracle interfaces, I will be happy to
+include it in the next README.
+
+=head2 The "default" built in compiler 64bit build (/usr/bin/cc)
+
+And now, at long last, we have a recipe for building perl and DBD-Oracle
+using the default bundled C compiler. Please see the L<Appendix B> build
+instructions provided by Gram Ludlow, using the default /usr/bin/cc
+bundled compiler. Please note that perl itself will I<NOT> build using
+that compiler.
+
+=head2 Configure (doing it manually)
+
+Once you have downloaded and unpacked the Perl sources (version 5.8.8
+assumed here), you must configure Perl. For those of you new to building
+Perl from source, the Configure program will ask you a series of
+questions about how to build Perl. You may supply default answers to the
+questions when you invoke the Configure program by command line flags.
+
+We want to build a Perl that understands large files (over 2GB, wich is
+the default for building perl on HP-UX), and that is incompatible with
+v5.005 Perl scripts (compiling with v5.005 compatibility causes mod_perl
+to complain about malloc pollution). At the command prompt type:
+
+ cd perl-5.8.8
+ sh ./Configure -A prepend:libswanted='cl pthread ' -des
+
+or, if you need a 64bit build
+
+ sh ./Configure -A prepend:libswanted='cl pthread ' -Duse64bitall -des
+
+Do not forget the trailing space inside the single quotes. This is also
+described by H.Merijn Brand in the README.hpux from the perl core
+distribution.
+
+When asked:
+
+ Any additional cc flags? - Answer by prepending: I<+Z> to enable
+ position independent code.
+
+ For example:
+ Any additional cc flags? [-D_HP-UX_SOURCE -Aa] -Ae +Z -z
+
+Though this should be the default in more recent perl versions.
+
+Lastly, and this is optional, when asked:
+
+ Do you want to install Perl as /usr/bin/perl? [y] n
+
+ You may or may not want to install directly in /usr/bin/perl,
+ many persons on HP install Perl in /opt/perl<version>/bin/perl and
+ put a symbolic link to /usr/bin/perl. Furthermore, you can supply
+ the answer to this question by adding an additional switch to the
+ invocation of Configure such as: Configure -Dprefix=/opt/perl
+
+After you have answered the above questions, accept the default values
+for all of the remaining questions. You may press <Enter> for each
+remaining question, or you may enter "& -d" (good idea) at the next
+question and the Configure will go into auto-pilot and use the Perl
+supplied defaults.
+
+BTW: If you add -lcl and -lpthread to the end of the list it will not
+work. I wasted a day and a half trying to figure out why I had lost the
+recipe, before I realized that this was the problem. The symptom will
+be that
+
+ make test
+
+of Perl itself will fail to load dynamic libraries.
+
+You can check in the generated 'config.sh' that the options you selected
+are correct. If not, modify config.sh and then re-run ./Configure with
+the '-d' option to process the config.sh file.
+
+Build & Install
+
+ make
+ make test
+ make install
+
+If you are going to build mod_perl and Apache it has been suggested
+that you modify Config.pm to the change the HP-UX ldflags & ccdlflags in
+F</your/install/prefix/lib/5.6.0/PA-RISC2.0/Config.pm> as follows:
+
+ ccdlflags=''
+ cccdlflags='+Z'
+ ldflags=' -L/usr/local/lib'
+
+This is not necessary if you are not using mod_perl and Apache.
+
+=head1 Build and Install DBI
+
+ cd DBI-1.50
+ Perl Makefile.PL
+ make
+ make test
+ make install
+
+=head1 Build and Install DBD-Oracle-1.07 and later
+
+It is critical to setup your Oracle environmental variables. Many people
+do this incorrectly and spend days trying to get a working version of
+DBD-Oracle. Below are examples of a local database and a remote database
+(i.e. the database is on a different machine than your Perl/DBI/DBD
+installation) environmental variable setup.
+
+Example (local database):
+
+ export ORACLE_USERID=<validuser/validpasswd>
+ export ORACLE_HOME=<path to oracle>
+ export ORACLE_SID=<a valid instance>
+ export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP
+ export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both)
+
+Note that HP-UX supports I<both> SHLIB_PATH I<and> LD_LIBRARY_PATH for
+all libraries that need to be found, but that each library itself can
+enable or disable any of the two, and can also set preference for the
+order they are used, so please set them to the same value.
+
+Example (remote database):
+
+ export ORACLE_USERID=<validuser/validpasswd>
+ export ORACLE_HOME=<path to oracle>
+ export ORACLE_SID=@<valid tnsnames.ora entry>
+ export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP
+ export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both)
+
+The standard mantra now works out of the box on HP-UX:
+
+ cd DBD-Oracle-1.07 # or more recent version
+ perl Makefile.PL
+ make
+ make test
+ make install # if all went smoothly
+
+And with DBD-1.14 and later the following can be used:
+
+ cd DBD-Oracle-1.14 # or more recent version
+ perl Makefile.PL -l # uses a simple link to oracle's main library
+ make
+ make test
+ make install # if all went smoothly
+
+If you have trouble, see the L<Trouble Shooting> instructions below, for
+hints of what might be wrong... and send me a note, describing your
+configuration, and what you did to fix it.
+
+=head1 Trouble Shooting
+
+=head2 "Unresolved symbol"
+
+In general, find the symbols, edit the Makefile, and make test.
+
+You'll have to modify the recipe accordingly, in my case the symbol
+"LhtStrCreate" was unresolved. (Authors Note: thanks patch suggestions
+by Jay Strauss this situation which occurs with Oracle 8.1.6 should
+now be handled in Makefile.PL.)
+
+1) Find the symbols.
+
+ a) The following ksh/bash code (courtesy of Roger) will search
+ from $ORACLE_HOME and below for Symbols in files in lib directories.
+ Save the following to a file called "findSymbol".
+
+ >>>> CUT HERE <<<<<
+ cd $ORACLE_HOME
+
+ echo "\nThis takes a while, grepping a lot of stuff"
+ echo " ignore the \"no symbols\" warnings\n"
+
+ sym=$1; shift;
+ libs="*.sl"
+
+ for lib in $(find . -name $libs -print); do
+ if nm -p $lib | grep -q $sym; then
+ echo "found \"$sym\" in $lib"
+ fi
+ done
+ >>>>> CUT HERE <<<<
+
+ Note that on Itanium machines (HP-UX 11.23), the shared libraries
+ have a .so extension instead of the .sl HP-UX uses on PA-RISC.
+
+ b) Run it (replace "LhtStrCreate" with your "Unresolved symbol").
+ For example, at my installation, findSymbols produced the
+ following output:
+
+ # chmod 755 findSymbols
+ # ./findSymbol LhtStrCreate
+
+ found "LhtStrCreate" in ./lib/libagtsh.sl
+ found "LhtStrCreate" in ./lib/libclntsh.sl
+ found "LhtStrCreate" in ./lib/libwtc8.sl
+
+2) Edit the Makefile
+
+In the previous step your unresolved symbol was found in one or more
+library files. You will need to edit the OTHERLDFLAGS makefile macro,
+and add the missing libraries.
+
+When you add those library files to OTHERLDFLAGS you must convert the
+name from the actual name to the notation that OTHERLDFLAGS uses.
+
+ libclntsh.sl becomes => -lclntsh
+ libagtsh.sl becomes => -lagtsh
+ libwtc8.sl becomes => -lwtc8
+
+That is, you replace the "lib" in the name to "-l" and remove the ".sl"
+(or the .so).
+
+You can edit the Makefile in 2 ways:
+
+ a) Do this:
+
+ perl -pi -e's/\b(OTHERLDFLAGS.*$)/$1 -lclntsh/' Makefile
+
+ b) Using vi, emacs... edit the file, find OTHERLDFLAGS, and add the
+ above "-l" entries to the end of the line.
+
+ For example the line:
+ OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr
+
+ Becomes:
+ OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr -lclntsh
+
+3) make test
+
+Perform a make test, if symbols are still unresolved repeat the editing
+of the Makefile and make test again.
+
+=head1 DBD-Oracle-1.06
+
+You are strongly urged to upgrade. However here is what you may need to
+know to get it or work, if you insist on using an earlier version.
+
+Check the output that above command produces, to verify that
+
+ -Wl,+n
+ -W1,+s
+
+is b<NOT> present. and that
+
+ -lqsmashr
+
+B<is> present.
+
+If the version of Makefile.PL does not include the patch produced at the
+time of this document, then the above conditions will likely not be
+met.
+You can fix this as follows:
+
+ perl -pi -e's/-Wl,\+[sn]//' Makefile
+
+=head1 Building on a Oracle Client Machine
+
+If you need to build or deliver the DBD-Oracle interface on or to a
+machine upon which the Oracle database has not been installed you need
+take the following into consideration:
+
+=over
+
+=item 1) Oracle files are needed for DBD::Oracle to compile
+
+=item 2) Oracle files are needed for the compiled DBD to connect
+
+=item 3) ORACLE_HOME environment variable must be set
+
+=item 4) SHLIB_PATH environment variable must be set
+
+=back
+
+=head2 Compiling on a Client Machine
+
+This may seem obvious to some, but the Oracle software has to be present
+to compile and run DBD-Oracle. The best way to compile and install on a
+client machine, is to use the oracle installer to install the oracle
+(client) software locally. Install SQL*Net, Pro*C and SQL*Plus. After
+this some tests with SQL*Net (tnsping at a minimum) are an good idea.
+Make sure you can connect to your remote database, and everything works
+with Oracle before you start bashing your head into the wall trying to
+get DBD-Oracle to work.
+
+If you do not have the Oracle installer handy, the following hack has
+been known to work:
+
+Either open an NFS share from the oracle installation directory on the
+machine that has Oracle and point both of the above-mentioned env vars to
+that share, or alternatively copy the following four directories from your
+Oracle installation over to the machine on which you are compiling the DBD:
+
+drwxr-xr-x 3 oracle dba 3072 Jul 3 09:36 lib
+drwxr-xr-x 13 oracle dba 512 Jul 3 09:38 network
+drwxr-xr-x 7 oracle dba 512 Jul 2 19:25 plsql
+drwxr-xr-x 12 oracle dba 512 Jul 3 09:38 rdbms
+
+then point the above-mentioned env vars to the containing directory (good
+place to put them, if copying locally, might be /usr/lib/oracle,
+/usr/local/lib/oracle, or /opt/oracle/lib )
+
+In any case, the compiler needs to be able to find files in the above
+four directories from Oracle in order to get all the source code needed
+to compile properly.
+
+=head2 Required Runtime environment
+
+Again, use the Oracle installer to install the Oracle Client on the
+machine where your scripts will be running. If the Oracle installer is
+not available, the following hack should suffice:
+
+For running the compiled DBD in Perl and connecting, you need only the
+files in the 'lib' folder mentioned above, either connecting to them
+through an NFS share on the Oracle machine, or having copied them
+directly onto the local machine, say, in /usr/lib/oracle . Make sure the
+env variable for ORACLE_HOME = /usr/lib/oracle and LD_LIBRARY_PATH
+includes /usr/lib/oracle . You can set the env var in your perl script
+by typing
+
+ $ENV{ORACLE_HOME} = '/usr/lib/oracle';
+
+=head1 Apache and mod_perl
+
+B<Nota Bene:> these instructions are now more than a year and a half old,
+you may have to tinker.
+
+If you are not building this version of Perl for Apache you can go on to
+build what ever other modules you require. The following instructions
+describe how these modules were built with the Perl/DBD-Oracle built
+above: The following is what worked for Roger Foskett:
+
+=head1 Apache Web server
+
+ cd apache_1.3.14/
+ LDFLAGS_SHLIB_EXPORT="" \
+ LDFLAGS="-lm -lpthread -lcl" \
+ CC=/usr/bin/cc \
+ CFLAGS="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" \
+ ./configure \
+ --prefix=/opt/www/apache \
+ --enable-shared=max \
+ --disable-rule=EXPAT \
+ --enable-module=info \
+ --enable-rule=SHARED_CORE
+
+The Expat XML parser is disabled as it conflicts with the Perl XML-Parser
+module causing core dumps. -lcl is needed to ensure that Apache does not
+coredump complaining about thread local storage
+
+ make
+ make install
+
+Once installed, ensure that the generated httpd.conf is properly
+configured, change the relevant lines to below (the default user/group
+caused problems on HP (the user 'www' may need to be created)
+
+ User www
+ Group other
+ port 80
+
+=head2 mod_perl
+
+ cd mod_perl-1.24_01/
+ perl Makefile.PL \
+ NO_HTTPD=1 \
+ USE_APXS=1 \
+ WITH_APXS=/opt/www/apache/bin/apxs \
+ EVERYTHING=1
+ make
+ make install
+
+=head2 htdig intranet search engine
+
+ cd htdig-3.1.5/
+ CC='cc' CPP='aCC' \
+ ./configure \
+ --prefix=/opt/www/htdig \
+ --with-cgi-bin-dir=/opt/www/htdig/cgi-bin \
+ --with-image-dir=/opt/www/htdig/images
+
+=head1 CONTRIBUTORS
+
+The following folks contributed to this document:
+
+ Lincoln A. Baxter <lab@lincolnbaxter.com.Fix.This>
+ H.Merijn Brand <h.m.brand@xs4all.nl>
+ Jay Strauss <me@heyjay.com.Fix.This>
+ Roger Foskett <Roger.Foskett@icl.com.Fix.This>
+ Weiguo Sun <wesun@cisco.com.Fix.This>
+ Tony Foiani <anthony_foiani@non.hp.com.Fix.This>
+ Hugh J. Hitchcock <hugh@hitchco.com.Fix.This>
+ Heiko Herms <Heiko.Herms.extern@HypoVereinsbank.de.Fix.This>
+ Waldemar Zurowski <bilbek0@poczta.onet.pl.Fix.This>
+ Michael Schuh <Michael.Schuh@airborne.com.Fix.This>
+ Gram M. Ludlow <LUDLOW_GRAM_M@cat.com.Fix.This>
+
+And probably others unknown to me.
+
+=head1 AUTHOR
+
+ Lincoln A. Baxter <lab@lincolnbaxter.com.Fix.This>
+ H.Merijn Brand <h.m.brand@xs4all.nl>
+
+=head1 APPENDICES
+
+=head2 Appendix A
+
+(gcc build info from Waldemar Zurowski)
+
+This is pretty much verbatim the build information I received from
+Waldemar Zurowski on building Perl and DBD-Oracle using gcc on HP. Note
+that this build was on a PA-RISC1.1 machine.
+
+=head3 Host
+
+ HP-UX hostname B.11.11 U 9000/800 XXXXXXXXX unlimited-user license
+
+=head3 Oracle
+
+ Oracle 8.1.7
+
+=head3 Parameters to build Perl
+
+ ./Configure -des -Uinstallusrbinperl -Uusethreads -Uuseithreads
+ -Duselargefiles -Dcc=gcc -Darchname=PA-RISC1.1 -Dprefix=/opt/perl-non-thread
+ -Dlibs='-lcl -lpthread -L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads
+ -ljava -lnsl -lnm -lndbm -ldld -lm -lc -lndir -lcrypt -lsec'
+
+-L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads -ljava, was added
+because DBD::Oracle wants to link with it (probably due to Oracle's own
+build rules picked up by Makefile.PL)
+
+Set environment variable LDOPTS to '+s' (see ld(1)). This holds extra
+parameters to HP-UX's ld command, as I don't use GNU ld (does anybody?).
+This allows you to build an executable, which when run would search for
+dynamic linked libraries using SHLIB_PATH (for 32-bit executable) and
+LD_LIBRARY_PATH (for 64-bit executable). Obviously LDOPTS is needed only
+when building Perl _and_ DBI + DBD::Oracle.
+
+Then, after building Perl + DBI + DBD::Oracle and moving it into
+production environment it was enough to add to SHLIB_PATH
+${ORACLE_HOME}/lib and ${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads,
+for example:
+
+SHLIB_PATH=${ORACLE_HOME}/lib:${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads:
+$SHLIB_PATH
+
+Please note output of ldd command:
+
+ $ ldd -s ./perl
+ [...]
+ find library=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl;
+ required by ./perl
+ search path=/home/ora817/lib:/home/ora817/JRE/lib/PA_RISC/native_threads
+ (SHLIB_PATH)
+ trying path=/home/ora817/lib/libjava.sl
+ trying path=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl
+ /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl =>
+ /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl
+ [...]
+
+All of this mess is necessary because of weakness of shl_load(3X),
+explained in this document and in some discussion forums at HP.com
+site. I have learned, that HP issued patch PHSS_24304 for HP-UX 11.11
+and PHSS_24303 for HP-UX 11.00, which introduced variable LD_PRELOAD.
+I haven't tried it yet, but it seems promising that it would allow you
+to completely avoid building your own Perl binary, as it would be enough
+to set LD_PRELOAD to libjava.sl (for example) and all
+'Cannot load XXXlibrary' during building of DBD::Oracle should be gone.
+
+The documentation says, that setting this variable should have the same
+effect as linking binary with this library. Also please note, that this
+variable is used only when binary is not setuid nor setgid binary (for
+obvious security reasons).
+
+It seems, that the best way to find out if you already have this patch
+applied, is to check if 'man 5 dld.sl' says anything about LD_PRELOAD
+environment variable.
+
+Best regards,
+
+Waldemar Zurowski
+
+Authors Note: Search for references to LD_PRELOAD else where in this
+document. Using LD_PRELOAD is probably a fragile solution at best.
+Better to do what Waldemar actually did, which is to include libjava in
+the extra link options.
+
+=head2 Appendix B
+
+(64 bit build with /usr/bin/cc -- bundled C compiler)
+
+Gram M. Ludlow writes:
+
+I recently had a problem with Oracle 9 64-bit on HPUX 11i. We have
+another application that required SH_LIBARY_PATH to point to the 64-bit
+libraries, which "broke" the Oraperl module. So I did some research and
+successfully recompiled and re-installed with the most recent versions of
+everything (perl, DBI, DBD) that works with 64-bit shared libraries. This
+is the error we were getting (basically)
+"/usr/lib/dld.sl: Bad magic number for shared library:
+/ora1/app/oracle/product/9.2.0.1.0/lib32"
+
+Here is my step-by-step instructions, pretty much what you have but
+streamlined for this particular case.
+
+Required software:
+
+ HPUX 11.11 (11i) PA-RISC
+ perl 5.8.4 source
+ DBI-1.42 source
+ DBD-Oracle-1.16 source
+ Oracle 9.2.0.1.0 installation
+
+=over
+
+=item Step 1: Compiling Perl
+
+This compiles PERL using the default HPUX cc compiler. The important
+things to note here are the configure parameters. the only non-default
+option to take is to add "+z" to the additional cc flags step.
+
+ gunzip perl-5.8.4.tar.gz
+ tar -xf perl-5.8.4.tar
+ cd perl-5.8.4
+ ./Configure -Ubincompat5005 -Duselargefiles -A prepend:libswanted='cl pthread ' -Duse64bitall
+
+Any additional cc flags?
+Add +z to beginning of list, include all other options.
+
+ make; make test
+
+98% of tests should succeed. If less, something is wrong.
+
+=item Step 2: DBI
+
+ gunzip DBI-1.42.tar.gz
+ tar -xvf DBI-1.42.tar
+ cd DBI-1.42
+ perl Makefile.PL
+ make;make test
+ make install
+
+=item Step 3: Install DBD-Oracle
+
+First, set the following environment variables specific you your Oracle
+installation:
+
+ export ORACLE_USERID=user/pass
+ export ORACLE_HOME=/oracle/product/9.2.0.1.0
+ export ORACLE_SID=orap1
+
+Then unpack and build:
+
+ gunzip DBD-Oracle-1.16.tar.gz
+ tar -xvf DBD-Oracle-1.16.tar
+ cd DBD-Oracle-1.16
+ perl Makefile.PL -l
+ make;make test
+ make install
+
+=back
+
+Note from H.Merijn Brand: In more recent perl distributions using
+HP C-ANSI-C should "just work" (TM), provided your C compiler can be
+found and used, your database is up and running, and your environment
+variables are set as noted. Example is for a 64bit build, as Oracle
+ships Oracle 9 and up for HP-UX only in 64bit builds.
+
+ gzip -d <perl-5.8.8.tgz | tar xf -
+ cd perl-5.8.8
+ sh ./Configure -Duse64bitall -A prepend:libswanted='cl pthread ' -des
+ make
+ make test_harness
+ make install
+
+ gzip -d <DBI-1.50.tgz | tar xf -
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+ gzip -d <DBD-Oracle-1.17.tgz | tar xf -
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+=head2 Appendix C
+
+(Miscellaneous links which might be useful)
+
+Michael Schuh writes:
+
+It was a bit by trial and error and a bit more by following your
+suggestions (and mapping them to gcc) that I got something that worked.
+
+One of the most significant "mappings" was to take your suggestion under
+"Configure" to add "+Z" to the ccflags variable and to change that to
+"-fPIC" (which, I learned from the gcc man page, is different than
+"-fpic", which is the counterpart for +z). -fPIC (+Z) allows I<big>
+offsets in the Position Independent Code, where -fpic (+z) only allows
+small offsets.
+
+I suspect that your hint about adding -lcl and -lpthread were crucial,
+but (after doing so) I never encountered any problems that were related
+to them.
+
+One thing that I did was create a shell script to set some variables,
+as the initial environment for root on the target system didn't work
+very well. Here is that script, trimmed to remove a bunch of echo
+statements, etc.:
+
+ # -------------------------------------------------------------------
+ # root.env - sets some environment variables the way I want them...
+ #
+ # Mike Schuh, June 2002, July 2002
+
+ export CC=/usr/local/bin/gcc
+
+ export INSTALL=./install-sh
+
+ . appl_setup DDD
+
+ export ORACLE_SID="SSS"
+ export ORACLE_USERID="XXX/YYY"
+
+ export PATH=/usr/local/bin:/usr/sbin:/usr/bin:/usr/ccs/bin:/opt/perl5/bin:/usr/c
+ ontrib/bin:/opt/nettladm/bin:/opt/fc/bin:/opt/fcms/bin:/opt/pd/bin:/usr/bin/X11:
+ /usr/contrib/bin/X11:/opt/hparray/bin:/opt/resmon/bin:/usr/sbin/diag/contrib:/op
+ t/pred/bin:/opt/gnome/bin:/sbin
+
+ # end of root.env
+
+The appl_setup sets some Oracle variables (specific to our installation),
+which I then override for the database that I am working on. The script
+(which I source) also uses some variables specific to other applications
+(e.g., Tivoli), mostly to unclutter my debugging. The INSTALL variable
+is related to building libgdbm.
+
+=head2 http://www.mail-archive.com/dbi-users@perl.org/msg18687.html
+
+Garry Ferguson's notes on a successful build using perl 5.8.0, DBI-1.38
+and DBD-Oracle-1.14 on HPUX 11.0 ( an L2000 machine ) with Oracle 9.0.1
+
+=head2 http://www.sas.com/service/techsup/unotes/SN/001/001875.html
+
+This is a note from the SAS support people documenting the
+LhtStrInsert() and LhtStrCreate() undefined symbols errors, and how to
+fix them in the Oracle makefiles.
+
+=head1 Appendix D
+
+(Why Dynamic Linking)
+
+Some one posted to the DBI email list the following question:
+
+ What are the advantages of building a dynamically linked version?
+ Being able to use threads? Or something besides that?
+
+The answer is there are too many to count, but here are several big ones:
+
+=over
+
+=item 1 Much smaller executables
+
+Only the code referenced gets loaded... this
+means faster execution times, and less machine resources (VM) used)
+
+=item 2 Modular addition and updating of modules.
+
+This is HUGE. One does not relink B<EVERYTHING, EVERY time> one changes
+or updates a module.
+
+=item 3 It eliminates Dynaloader warning (multiply defined).
+
+This occurs with the static build when Perl is run with -w. I fixed
+this by removing -w from my #! lines, converting the pragam "use
+warnings;". However, it was annoying, since all my scripts had -w in the
+#! line.
+
+=item 4 It's the default build
+
+Since almost every OS now supports dynamic linking, I believe that static
+linking is NOT getting the same level of vetting it maybe used to.
+Dynamicly linking is what you get by default, so its way better tested.
+
+=item 5 It's required for Apache and mod_perl.
+
+=back
+
+=head1 Appendix E
+
+(WebLogic Driver for Oracle with the Oracle8i Server Lob Bug)
+
+Michael Fox reported a bug when you are using DBD-Oracle-1.18 or later and when using older Oracle versions.
+The bug will result in an error report
+
+ 'Failed to load Oracle extension and/or shared libraries'.
+
+This problem occurs if you use the WebLogic Driver for Oracle with the Oracle8i Server
+- Enterprise Edition 8.1.7 and the corresponding Oracle Call Interface (OCI).
+This problem occurs only in Oracle 8.1.7; it is fixed in Oracle 9i.
+
+This link details the problem
+
+=head1 http://e-docs.bea.com/platform/suppconfigs/configs70/hptru64unix51_alpha/70sp1.html#88784
+
+The solution from this page is below;
+
+To work around this problem, complete the following procedure:
+
+=over
+
+=item 1 Log in to your Oracle account:
+
+ su - oracle
+
+=item 2 In a text editor, open the following file:
+
+ $ORACLE_HOME/rdbms/admin/shrept.lst
+
+=item 3 Add the following line:
+
+ rdbms:OCILobLocatorAssign
+
+=item 4 (optional) Add the names of any other missing functions needed by applications, other than WebLogic Server 7.0, that you want to execute.
+Note: The OCILobLocatorAssign function is not the only missing function that WebLogic Server 7.0 should be able to call, but it is the only missing function that WebLogic Server 7.0 requires. Other functions that WebLogic Server should be able to call, such as OCIEnvCreate and OCIerminate, are also missing. If these functions are required by other applications that you plan to run, you must add them to your environment by specifying them, too, in $ORACLE_HOME/rdbms/admin/shrept.lst.
+
+=item 5 Rebuild the shared client library:
+
+ $ cd $ORACLE_HOME/rdbms/lib
+ $ make -f ins_rdbms.mk client_sharedlib
+
+The make command updates the following files in /opt/oracle/product/8.1.7/lib:
+
+ clntsh.map
+ ldap.def libclntsh.so
+ libclntsh.so.8.0 libclntst8.a
+ network.def
+ plsql.def
+ precomp.def
+ rdbms.def
+
+Because OCILobLocatorAssign is now visible in libclntsh.so, WebLogic Server can call it.
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,166 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Linux
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Linux
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Linux - Tips and Hints to Troubleshoot DBD::Oracle on Linux
+
+=head1 VERSION
+
+version 1.74
+
+=head1 SELinux and httpd
+
+If SELinux is running, it can prevents DBD::Oracle running in
+an Apache process to load shared libraries it requires (libclntsh.so
+or libnnz12.so). A typical symptom is a line like the following in
+the Apache error logs:
+
+ [Tue Apr 17 13:22:45 2012] [error] Can't load '.../DBD/Oracle/Oracle.so' for
+ module DBD::Oracle: libnnz11.so: cannot enable executable stack as shared
+ object requires: Permission denied at .../DynaLoader.pm line 190.\n at
+ .../startup.pl line 17\nCompilation failed in require at ...
+
+The fix:
+
+ /usr/sbin/setsebool -P httpd_execmem
+
+=head1 Installing with Instantclient .rpm files.
+
+Nothing special with this you just have to set up you permissions as follows;
+
+1) Have permission for RWE on '/usr/lib/oracle/10.2.0.3/client/' or the other directory where you RPMed to
+
+2) Set export ORACLE_HOME=/usr/lib/oracle/10.2.0.3/client
+
+3) Set export LD_LIBRARY_PATH=$ORACLE_HOME/lib
+
+4) If you plan to use tnsnames to connect to remote servers and your tnsnames.ora file is not in $ORACLE_HOME/network/admin, you will need to Export TNS_ADMIN=dir to point DBD::Oracle to where your tnsnames.ora file is
+
+=head1 undefined symbol: __cmpdi2 comes up when Oracle isn't properly linked to the libgcc.a library.
+
+In version 8, this was corrected by changing the SYSLIBS entry in
+$ORACLE_HOME/bin/genclntsh to include
+"-L/usr/lib/gcc-lib/i386-redhat-linux/3.2 -lgcc".
+
+I had tried this with no success as when this program was then run, the
+error "unable to find libgcc" was generated. Of course, this was the
+library I was trying to describe!
+
+It turns out that now it is necessary to edit the same file and append
+"`gcc -print-libgcc-file-name`" (including the backquotes!). If you do
+this and then run "genclntsh", the libclntsh is properly generated and
+the linkage with DBD::Oracle proceeds properly.
+
+=head1 cc1: invalid option `tune=pentium4'" error
+
+If you get the above it seems that either your Perl or OS where compiled with a different version of GCC or the GCC that is on your system is very old.
+
+No real problem with the above however you will have to
+
+1) run Perl Makefile.PL
+
+2) edit the Makefile and remove the offending '-mtune=pentium4' text
+
+3) save and exit
+
+4) do the make install and it should work fine for you
+
+=head1 Oracle 9i Lite
+
+The advice is to use the regular Oracle9i not the lite version.
+
+Another great source of help was: http://www.puschitz.com/InstallingOracle9i.html
+
+just getting 9i and 9i lite installed. I use fvwm2(nvidia X driver) as
+a window manager which does not work with the 9i install program, works
+fine with the default Gnomish(nv X driver), it could have been the X
+driver too.
+
+With Redhat9 it is REAL important to set LD_ASSUME_KERNEL to 2.4.1.
+
+I didn't try this but it may be possible to install what is needed by
+only downloading the first disk saving some 1.3GB of download fun.
+
+I installed a custom install from the client group. The packages I
+installed are the Programmers section and sqlplus. I noticed that the
+Pro*C when on as a result of the checking the Programmers section I
+assume.
+
+Once Oracle was installed properly the DBD::Oracle install went as
+smooth as just about every other CPAN module.
+
+=head1 Oracle 10g Instantclient
+
+The Makefile.PL will now work for Oracle 10g Instantclient. To have both the Compile and
+the test.pl to work you must first have the LD_LIBRARY_PATH correctly set to your
+"instantclient" directory. (http://www.oracle.com/technology/tech/oci/instantclient/instantclient.html)
+
+The present version of the make creates a link on your "instantclient" directory as follows
+"ln -s libclntsh.so.10.1 libclntsh.so". It is needed for both the makefile creation and the compile
+but is not need for the test.pl. It should be removed after the compile.
+
+If the Makefile.PL or make fails try creating this link directly in your "instantclient" directory.
+
+=head1 Oracle Database 10g Express Edition 10.2
+
+To get 10Xe to compile correctly I had to add $ORACLE_HOME/lib to the LD_LIBRARY_PATH
+as you would for an install against 10g Standard Edition, Standard Edition One, or
+Enterprise Edition
+
+=head1 UTF8 bug in Oracle 9.2.0.5.0 and 9.2.0.7.0
+
+DBD::Oracle seems to hit some sort of bug with the above two versions of DB.
+The bug seems to hit when you when the Oracle database charset: US7ASCII and the Oracle nchar charset: AL16UTF16 and it has also
+been reported when the Oracle database charset: WE8ISO8850P1 Oracle nchar charset: AL32UTF16.
+
+So far there is no patch for this but here are some workarounds
+
+ use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR );
+ ...
+ $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR });
+
+ or this way
+
+ $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders
+
+ or this way
+
+ utf8::downgrade($parameter, 1);
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,601 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Macos
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on MacOs
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Macos - Tips and Hints to Troubleshoot DBD::Oracle on MacOs
+
+=head1 VERSION
+
+version 1.74
+
+=head1 General Info
+
+These instructions allow for the compilation and successful testing of
+DBD::Oracle on MacOS X 10.2.4 and higher, using Oracle 9iR2 DR
+(Release 9.2.0.1.0) or the 10g Instant Client release (10.1.0.3 at the
+time of writing).
+
+MacOS X DBD::Oracle has been tested (and used) under Jaguar (10.2.x),
+Panther (10.3.x), Snow Leopard (10.6.x), Lion (10.7.x). Jaguar comes
+with a Perl version of 5.6.0., which I can report to work with
+DBD::Oracle 1.14 and higher once you take certain steps (see below).
+You may want to install a later perl, e.g., Perl 5.8.x. Please refer to:
+
+ Installing Perl 5.8 on Jaguar
+ http://developer.apple.com/internet/macosx/perl.html
+
+for Perl 5.8.0 installation instructions.
+
+DBD::Oracle is likely to not install out of the box on MacOS X
+10.2. nor on 10.3. Manual but different changes will most likely be
+required on both versions.
+
+The key problem on 10.2. (Jaguar) is a symbol clash (caused by a
+function poll() named identically) between the IO library in at least
+Perl 5.6.0 (which is the version that comes with 10.2) and the Oracle
+client library in 9iR2 developer's release for MacOS X. The symptom is
+that your build appears to compile fine but then fails in the link
+stage. If you are running a (possibly self-installed) version of Perl
+other than 5.6.0, there's a chance that you are not affected by the
+symbol clash. So, try to build first without any special measures, and
+only resort to the instructions below if your build fails in the link
+stage with a duplicate symbol error. Note: if it fails to even
+compile, solve that problem first since it is not due to the symbol
+clash.
+
+The key problem on 10.3 (Panther) is that the default perl that comes
+with the system is compiled with multi-threading turned on, which at
+least with the 9iR2 developer's release exposes a memory leak. Your
+DBD::Oracle build will compile, test, and install fine, but if you
+execute the same prepared statement multiple times, the process will
+quickly run up hundreds of megabytes of RAM, and depending on how much
+memory you have it will die sooner or later.
+
+Oracle recently released an "Instant Client" for MacOSX 10.3
+(Panther), which as far as I can attest has none of the problems
+above. Since it is also a very compact download (actually, a series of
+downloads) I highly recommend you install and use the Instant Client
+if you are on 10.3 (Panther) and you do not intend to run the Oracle
+database server on your MacOSX box. See below (Instructions for
+10.3.x) for details.
+
+=head1 Instructions for 10.7.x (Lion)
+
+Perl on Lion and later is built with 64-bit support, and therefore requires
+the 64-bit Instant Client. As of this writing, only Instant Client 11.2
+(64-bit) actually works. The 64-bit Instant Client 10.2 is L<incompatible with
+Lion|http://only4left.jpiwowar.com/2011/08/instant-client-osx-lion-32-bit-only/>.
+We therefore recommend the 11.2 client. If you must Instant Client 10.2, you
+may need to recompile Perl with 32-bit support.
+
+Either way, setup and configuration is the same:
+
+=over
+
+=item *
+
+Download and install the basic, sqlplus, and sdk instantclient libraries and
+install them in a central location, such as F</usr/oracle_instantclient>.
+L<Downloads
+here|http://www.oracle.com/technetwork/topics/intel-macsoft-096467.html>
+
+=item *
+
+Create a symlink from F<libclntsh.dylib.10.1> to F<libclntsh.dylib>:
+
+ cd /usr/oracle_instantclient/
+ ln -s libclntsh.dylib.* libclntsh.dylib
+ ln -s libocci.dylib.* libocci.dylib
+
+=item *
+
+Update your environment to point to the libraries:
+
+ export ORACLE_HOME=/usr/oracle_instantclient
+ export DYLD_LIBRARY_PATH=$DYLD_LIBRARY_PATH:/usr/oracle_instantclient
+
+=item *
+
+You should now be able to install DBD::Oracle from CPAN:
+
+ cpan DBD::Oracle
+
+=back
+
+=head1 Instructions for 10.6.x (Snow Leopard)
+
+These are taken from a stackoverflow answer by "nickisfat" who gave
+his/her permission for its inclusion here. You can see the original
+question and answers at http://stackoverflow.com/questions/5964999.
+
+Getting a mac install of perl to play nicely with oracle is a bit of a
+pain - once it's running it is fantastic, getting it running is a
+little frustrating..
+
+The below has worked for me on a few different intel macs, there could
+well be superfluous steps in there and it is likely not going to be
+the same for other platforms.
+
+This will require use of shell, the root user and a bit of CPANing -
+nothing too onerous
+
+First off create a directory for the oracle pap - libraries, instant client etc
+
+sudo mkdir /usr/oracle_instantClient64
+
+Download and extract all 64 bit instant client packages from oracle to
+the above directory
+
+Create a symlink within that directory for one of the files in there
+
+sudo cd /usr/oracle_instantClient64
+sudo ln -s /usr/oracle_instantClient64/libclntsh.dylib.10.1 libclntsh.dylib
+
+The following dir is hardcoded into the oracle instant client - god knows why - so need to create and symlink it
+
+sudo mkdir -p /b/227/rdbms/
+sudo cd /b/227/rdbms/
+sudo ln -s /usr/oracle_instantClient64/ lib
+
+Need to add a couple of environment variables, so edit /etc/profile
+and add them so they exist for all users:
+
+export ORACLE_HOME=/usr/oracle_instantClient64
+export DYLD_LIBRARY_PATH=/usr/oracle_instantClient64
+
+Now try and install DBD::Oracle through CPAN - this will fail, but it
+means any dependencies will be downloaded and it retrieves the module
+for us
+
+sudo perl -MCPAN -e shell
+install DBD::Oracle
+
+When this fails exit CPAN and head to your .cpan/build dir - if you
+used automatic config of CPAN it'll be
+
+cd ~/.cpan/build
+
+if you didn't auto configure you can find your build directory with
+the following command in CPAN
+
+o conf build_dir
+
+Once in the build dir look for the DBD::Oracle dir which has just been
+created (it'll be called something like DBD-Oracle-1.28-?) and cd into
+it.
+
+Now we need to switch to the root user. Root isn't enabled as default
+in osx - for details on enabling see this post on the apple website
+
+Once logged in as root we need to set the above environment variables for root:
+
+export ORACLE_HOME=/usr/oracle_instantClient64
+export DYLD_LIBRARY_PATH=/usr/oracle_instantClient64
+
+Now while still logged in as root we need to run the makefile for the
+module, then make, then install
+
+perl Makefile.pl
+make
+install
+
+Assuming that all worked without error log out of root: we're DBD'd
+up! If this didn't work it's time to bust out google on whatever
+errors you're seeing
+
+Now just to install the DBI module
+
+sudo perl -MCPAN -e shell
+install DBI
+
+Now you're all set - enjoy your perly oracley new life
+
+=head1 Instructions for 10.2.x (Jaguar)
+
+1) Install Oracle exactly per Oracle documentation. If you change
+install locations, then you'll need to modify paths accordingly.
+
+2) There are two ways to remedy the symbol clash. Either edit the
+symbol table of the Oracle client library
+$ORACLE_HOME/lib/libclntsh.dylib.9.0 such that the symbol _poll is no
+longer exported. Alternatively, download, patch, and re-install the
+perl IO modules. I could not successfully repeat the report for the
+former, but I did succeed by doing the latter. Instructions for both
+follow nonetheless.
+
+ 2a) SKIP IF YOU WANT TO OR HAVE SUCCESSFULLY TRIED 2b). Make a
+ backup copy of the $ORACLE_HOME/lib/libclntsh.dylib.9.0 file, or
+ the file this name points to, since we're about to modify that
+ library. Note that the ".9.0" suffix of the file name is version
+ dependent, and that you want to work with the file pointed to
+ through one or a series of symbolic links rather than any of the
+ symbolic links (e.g., one will be called libclntsh.dylib).
+
+ As user 'oracle' execute the following command to fix namespace
+ collisions in Oracle's dynamic libraries.
+
+ nmedit -R ./hints/macos_lib.syms $ORACLE_HOME/lib/libclntsh.dylib.9.0
+
+ *** Recall the above caveats regarding the file name.
+
+ The problem with this is that the version of nm that comes with
+ Jaguar doesn't support the -R flag. I'd be grateful to anyone who
+ can suggest how to edit the symbol table of libraries on MacOS X.
+
+ 2b) SKIP IF YOU WANT TO OR HAVE SUCCESSFULLY TRIED 2a). In this
+ variant, we will patch the Perl IO modules to change the name of
+ the poll() function, as that is where it is defined. In this case,
+ we do not need to do anything with the Oracle libraries. Follow
+ these steps:
+
+ - Download the module IO (IO.pm) from CPAN and unpack it. Check
+ the documentation as to whether the version is compatible with
+ your version of Perl; I used v1.20 with Perl 5.6.0 and had
+ success.
+
+ - The files IO.xs, poll.c, and poll.h need to be patched. Apply
+ the following patches, e.g., by cutting and pasting the marked
+ section into a file perlio.patch and using that file as input
+ for patch:
+
+ $ patch -p0 < perlio.patch
+
+ The patch will basically rename the C implementation of poll()
+ to io_poll(). The other patches were necessary to make v1.20
+ compile with Perl 5.6.0; they may not be necessary with other
+ versions of IO and Perl, respectively.
+
+ +=+=+=+=+=+=+= Cut after this line
+ diff -c ../IO-orig/IO-1.20/IO.xs ./IO.xs
+ *** ../IO-orig/IO-1.20/IO.xs Mon Jul 13 23:36:24 1998
+ --- ./IO.xs Sat May 10 15:20:02 2003
+ ***************
+ *** 205,211 ****
+ ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+ }
+ else {
+ ! ST(0) = &sv_undef;
+ errno = EINVAL;
+ }
+
+ --- 205,211 ----
+ ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+ }
+ else {
+ ! ST(0) = &PL_sv_undef;
+ errno = EINVAL;
+ }
+
+ ***************
+ *** 249,255 ****
+ SvREFCNT_dec(gv); /* undo increment in newRV() */
+ }
+ else {
+ ! ST(0) = &sv_undef;
+ SvREFCNT_dec(gv);
+ }
+
+ --- 249,255 ----
+ SvREFCNT_dec(gv); /* undo increment in newRV() */
+ }
+ else {
+ ! ST(0) = &PL_sv_undef;
+ SvREFCNT_dec(gv);
+ }
+
+ ***************
+ *** 272,278 ****
+ i++;
+ fds[j].revents = 0;
+ }
+ ! if((ret = poll(fds,nfd,timeout)) >= 0) {
+ for(i=1, j=0 ; j < nfd ; j++) {
+ sv_setiv(ST(i), fds[j].fd); i++;
+ sv_setiv(ST(i), fds[j].revents); i++;
+ --- 272,278 ----
+ i++;
+ fds[j].revents = 0;
+ }
+ ! if((ret = io_poll(fds,nfd,timeout)) >= 0) {
+ for(i=1, j=0 ; j < nfd ; j++) {
+ sv_setiv(ST(i), fds[j].fd); i++;
+ sv_setiv(ST(i), fds[j].revents); i++;
+ diff -c ../IO-orig/IO-1.20/poll.c ./poll.c
+ *** ../IO-orig/IO-1.20/poll.c Wed Mar 18 21:34:00 1998
+ --- ./poll.c Sat May 10 14:28:22 2003
+ ***************
+ *** 35,41 ****
+ # define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP)
+
+ int
+ ! poll(fds, nfds, timeout)
+ struct pollfd *fds;
+ unsigned long nfds;
+ int timeout;
+ --- 35,41 ----
+ # define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP)
+
+ int
+ ! io_poll(fds, nfds, timeout)
+ struct pollfd *fds;
+ unsigned long nfds;
+ int timeout;
+ diff -c ../IO-orig/IO-1.20/poll.h ./poll.h
+ *** ../IO-orig/IO-1.20/poll.h Wed Apr 15 20:33:02 1998
+ --- ./poll.h Sat May 10 14:29:11 2003
+ ***************
+ *** 44,50 ****
+ #define POLLHUP 0x0010
+ #define POLLNVAL 0x0020
+
+ ! int poll _((struct pollfd *, unsigned long, int));
+
+ #ifndef HAS_POLL
+ # define HAS_POLL
+ --- 44,50 ----
+ #define POLLHUP 0x0010
+ #define POLLNVAL 0x0020
+
+ ! int io_poll _((struct pollfd *, unsigned long, int));
+
+ #ifndef HAS_POLL
+ # define HAS_POLL
+ +=+=+=+=+=+=+= Cut to the previous line
+
+ - compile and install as you usually would, making sure that
+ existing but conflicting modules get removed:
+
+ $ perl Makefile.PL
+ $ make
+ $ make test
+ $ make install UNINST=1
+
+ - You are done. Continue with 3).
+
+3) Install the module DBI as per its instructions, if you haven't
+ already done so.
+
+4) Install the DBD::Oracle module.
+
+ $ perl Makefile.PL
+ $ make
+ $ make test
+ $ make install
+
+=head1 Instructions for 10.3.x (Panther)
+
+I highly recommend you install and use the Oracle 10g Instant Client
+for MacOSX 10.3. Compared to traditional Oracle client installations
+it is a very compact download, and it has the memory leak problem
+fixed. As an added benefit, you will be able to seamlessly connect to
+10g databases. Even if you do want to run the database server included
+in the 9iR2 Developer's Release, I'd still use the Instant Client for
+compiling OCI applications or drivers like DBD::Oracle.
+
+If you still decide to use the full 9iR2 DR client, and if all you use
+DBD::Oracle for on MacOSX is development and test scripts that don't
+involve running the same query multiple times or many queries within
+the same perl process, then note that the memory leak will most likely
+never affect you in a serious way. In this case you may not need to
+bother and instead just go ahead, build and install DBD::Oracle
+straightforwardly without any special measures.
+
+That said, here are the details.
+
+0) (If you decided for the 9iR2 DR client, skip to 1.) If you decided
+ to use the 10g Instant Client, make sure you download and install
+ all parts. (Given that this is perl land you may not need the JDBC
+ driver, but why bother sorting out the 25% you may or may not ever
+ need.) Follow the Oracle instructions and copy the contents of each
+ part into the same destination directory. Change to this
+ destination directory and create a symlink lib pointing to '.'
+ (without the quotes):
+
+ $ cd </path/to/my/oracle/instantclient>
+ $ ln -s lib .
+
+ Also, set the environment variable ORACLE_HOME to the path to your
+ instantclient destination directory. Makefile.PL needs it.
+
+ Now return to your DBD::Oracle download. If the version is 1.16 or
+ less you will need to patch Makefile.PL; in later versions this may
+ be fixed already. Apply the following patch, e.g., by cutting and
+ pasting into a file Makefile.PL.patch and then executing
+
+ $ patch -p0 < Makefile.PL.patch
+
+ Here is the patch:
+
+ +=+=+=+=+=+=+= Cut after this line
+ *** Makefile.PL.orig Fri Oct 22 02:07:04 2004
+ --- Makefile.PL Fri May 13 14:28:53 2005
+ ***************
+ *** 1252,1257 ****
+ --- 1252,1258 ----
+ print "Found $dir/$_\n" if $::opt_d;
+ }, "$OH/rdbms",
+ "$OH/plsql", # oratypes.h sometimes here (eg HPUX 11.23 Itanium Oracle 9.2.0)
+ + "$OH/sdk", # Oracle Instant Client default location (10g)
+ );
+ @h_dir = keys %h_dir;
+ print "Found header files in @h_dir.\n" if @h_dir;
+ ***************
+ *** 1286,1292 ****
+ --- 1287,1297 ----
+ open FH, ">define.sql" or warn "Can't create define.sql: $!";
+ print FH "DEFINE _SQLPLUS_RELEASE\nQUIT\n";
+ close FH;
+ + # we need to temporarily disable login sql scripts
+ + my $sqlpath = $ENV{SQLPATH};
+ + delete $ENV{SQLPATH};
+ my $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`;
+ + $ENV{SQLPATH} = $sqlpath if $sqlpath;
+ unlink "define.sql";
+ print $sqlplus_release;
+ if ($sqlplus_release =~ /^DEFINE _SQLPLUS_RELEASE = "(\d?\d)(\d\d)(\d\d)(\d\d)(\d\d)"/) {
+ +=+=+=+=+=+=+= Cut to the previous line
+
+ The first hunk allows Makefile.PL to find the header files which
+ are in a subdirectory sdk, and the second temporarily disables any
+ global and local login.sql scripts which may make the sqlplus call
+ fail. If you don't have a local login.sql script you will most
+ likely be fine without the second hunk.
+
+ Now run Makefile.PL and make sure you provide the -l flag:
+
+ $ perl Makefile.PL -l
+
+ If you receive some ugly error message stating that some *.mk file
+ couldn't be found you forgot to add the -l flag.
+
+ The continue the standard build process by running make. In
+ DBD::Oracle versions 1.16 and earlier this will end in an error due
+ to a failed execution of nmedit -R. Ignore this error. Move on to
+ running the tests, making sure the test scripts can log in to your
+ database (e.g., by setting ORACLE_USERID). Note that by default the
+ Instant Client does not have a network/admin/tnsnames.ora
+ installed. Either install a suitable one, or point TNS_ADMIN to the
+ directory where you keep your tnsnames.ora, or include the full
+ SQLNET connection string in ORACLE_USERID. All three options are
+ documented by Oracle in the README_IC.htm file that comes with the
+ Instant Client, so be sure you read it if you don't understand what
+ I'm writing here.
+
+ All tests should succeed. Complete by make install. You are done!
+ Skip the other steps below, they do NOT apply to the Instant
+ Client. (Although of course you may still install a later version
+ of perl if you have the need.)
+
+1) Until the reason for the memory leak has been found and fixed, you
+ need to remove the condition that exposes it. Apparently, this is
+ multi-threading being enabled in Perl. The Perl 5.8.1RC3 that comes
+ with Panther was compiled with multi-threading enabled, and AFAIK
+ it cannot be turned off at runtime. Note that the problem is
+ independent of whether you run multiple concurrent threads or not.
+
+ Therefore, the solution is to build your own perl. I leave it up to
+ you whether you want to replace the system perl or not. At least
+ Perl 5.8.x comes with instructions as to how to replace the system
+ perl on MacOS X, and what the caveats and risks are. I used 5.8.4,
+ installed in /usr/local, and it worked perfectly fine.
+
+ The key when configuring your custom build of perl is to disable
+ multi-threading (usethreads, useithreads, and usemultiplicity
+ options). More precisely, do not enable them, as they are disabled
+ by default, at least up to version 5.8.5. You can check whether
+ threads are enabled or not by passing -V to ther Perl interpreter:
+
+ $ /path/to/your/perl -V | grep usethreads
+
+ You need to see a line saying, among other things,
+ usethreads=undef. If you see usethreads=define then multi-threading
+ is enabled.
+
+2) If you choose not to replace the system perl, make sure that when
+ you build DBI and DBD::Oracle you provide the full path to your own
+ perl when running Makefile.PL, like so (assuming you installed in
+ /usr/local, which is the default):
+
+ $ /usr/local/bin/perl Makefile.PL
+
+ Also, every time you run a DBD::Oracle script, you must use the
+ full path too, unless your custom-built perl comes before the
+ system perl in the PATH environment. The easiest way to ensure you
+ are using the right perl is to uninstall DBI from the system perl
+ if you did install it under that as well.
+
+3) Continue with 3) as in instructions for Jaguar (making path
+ substitutions for perl as discussed in 2).
+======================================================================
+
+If you have any problems then follow the instructions in the
+README. Please post details of any problems (or changes you needed to
+make) to dbi-users@perl.org and CC them to brooksch@mac.com on MacOSX
+specific problems. Rewrite of part of this readme, Panther
+instructions, and the Perl IO patch is credit to Hilmar Lapp, hlapp at
+gmx.net.
+
+Earlier and original instructions thanks to:
+ Andy Lester
+ Steve Sapovits
+ Tom Mornini
+
+Date: Tue, 15 Apr 2003 16:02:17 +1000
+Subject: Compilation bug in DBI on OSX with threaded Perl 5.8.0
+From: Danial Pearce
+
+In regards to a previous message on this list:
+
+http://archive.develooper.com/dbi-users@perl.org/msg16365.html
+
+I have some more info:
+
+I have compiled and installed Perl just fine with threads enabled:
+
+./Configure -de -Dusethreads -Dprefix=/usr
+make
+make test
+sudo make install
+
+I have then successfully installed Apache and mod_perl as well.
+
+When I try to compile and install DBI, I get a bus error, just like the
+people on this list have previously discussed on the thread above.
+
+If I unpack the DBI, and run perl Makefile.pl, then alter the created
+Makefile so that it uses gcc2 rather than just "cc" then it compiles,
+installs and runs just fine.
+
+The issue here is that Apple have just recently release 10.2.4, which
+updates /usr/bin/{gcc3,gcc2,g++3,g++2} and /usr/bin/cc is a symlink to
+/usr/bin/gcc3, so compilation of DBI under Apple's gcc3 does not work. It
+works find with gcc2 however.
+
+I had the same problem with DBD::Pg, and was able to compile and install
+that using the same fix.
+
+I am unsure if this is a problem with Apple's version of gcc, or a problem
+with the DBI/DBD code itself. Given that all my other open source
+applications are compiling and installing fine, I am thinking there isn't
+anything Apple are going to do about it.
+
+cheers
+Danial
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,76 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Sun
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Sun
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Sun - Tips and Hints to Troubleshoot DBD::Oracle on Sun
+
+=head1 VERSION
+
+version 1.74
+
+=head1 General Info
+
+If you get this on a Solaris 9 and 10 box
+
+ "Outofmemory!
+ Callback called exit.
+ END failed--call queue aborted."
+
+The solution may be as simple as not having you "ORACLE_HOME" Defined in the
+environment.
+
+It seems that having it defined will prevent the error.
+
+=head1 Setting library load path for instant client libraries
+
+Usually you set LD_LIBRARY_PATH to point to the location of
+your Oracle Instant Client (you need to do this when building
+DBD::Oracle). However, afterwards it can be a pain to keep
+ensuring this is set and changing LD_LIBRARY_PATH in your Perl
+script does not work (needs to be done beforehand) as the dynamic
+linker caches its value.
+
+An alternative under newer versions of Solaris is:
+
+root> crle -u -l /youroracledir/lib/instantclient_11_2
+
+however, make sure you check the crle options as you may need to
+set the architecture etc as well.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,130 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Vms
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Vms
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Vms - Tips and Hints to Troubleshoot DBD::Oracle on Vms
+
+=head1 VERSION
+
+version 1.74
+
+=head1 General Info
+
+This is related to Oracle RDBMS 9.2 and later, since Oracle
+made fundamental changes to oracle installation requirements
+and factual installation with this release.
+
+Oracle's goal was to make VMS installation be more like on
+*nix and Windows, with an all new Oracle Home structure too,
+requiring an ODS-5 disk to install Oracle Home on instead of
+the good old ODS-2.
+
+Another major change is the introduction of an Oracle generated
+logical name table for oracle logical names like ORA_ROOT and all
+its derivatives like ORA_PROGINT etc. And that this logical name
+table is inserted in LNM$FILE_DEV in LNM$PROCESS_DIRECTORY.
+
+ (LNM$PROCESS_DIRECTORY)
+
+ "LNM$FILE_DEV" = "SERVER_810111112"
+ = "LNM$PROCESS"
+ = "LNM$JOB"
+ = "LNM$GROUP"
+ = "LNM$SYSTEM"
+ = "DECW$LOGICAL_NAMES"
+
+This ensures that any process that needs to have access to
+oracle gets the environment by just adding one logical name table
+to a central process specific mechanism.
+
+But as it is inserted at the very top of LNM$FILE_DEV it also
+represents a source of misfortune - especially if a user with
+enough privilege to update the oracle table does so (presumably
+unintentionally), as an example by changing NLS_LANG.
+
+PERL has the ability to define, redefine and undefine (deassign)
+logical names, but if not told otherwise by the user does it
+in the first table in above list, and not as one would normally
+expect in the process table.
+
+Installing DBI and DBD::Oracle has influence upon this since in
+both cases a few environment variables are read or set in the
+test phase.
+For DBI it is the logical SYS$SCRATCH, which is a JOB logical.
+For DBD-Oracle it is when testing a new feature in the Oracle
+RDBMS: UTF8 and UTF16 character set functionality, and in order
+to do this it sets and unsets the related environment variables
+NLS_NCHAR and NLS_LANG.
+
+If one is not careful this changes the values set in the oracle
+table - and in the worst case stays active until the next major
+system reset. It can also be a very hard error to track down
+since it happens in a place where one normally never looks.
+
+Furthermore, it is very possibly that some or all of the UTF tests
+fails, since if one have a variable like NLS_LANG in his process
+table, then even though 'mms test' sets it in the wrong table
+it is not invoked as it is overruled by the process logical...
+
+The way to ensure that no logicals are set in the oracle table and
+that the UTF tests get the best environment to test in, and that
+DBI correctly translates the SYS$SCRATCH logical, use the
+logical
+
+ PERL_ENV_TABLES
+
+to ensure that PERL's behavior is to leave the oracle table alone and
+use the process table instead:
+
+ $ DEFINE PERL_ENV_TABLES LNM$PROCESS, LNM$JOB
+
+This tells PERL to use the LNM$PROCESS table as the default place to
+set and unset variables so that only the perl users environment
+is affected when installing DBD::Oracle, and ensures that the
+LNM$JOB table is read when SYS$SCRATCH is to be translated.
+
+PERL_ENV_TABLES is well documented in the PERLVMS man page.
+
+Oracle8 releases are not affected, as they don't have the
+oracle table implementation, and no UTF support.
+
+Oracle 9.0 is uncertain, since testing has not been possible yet,
+but the remedy will not hurt :)
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,278 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Win32
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win32
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Win32 - Tips and Hints to Troubleshoot DBD::Oracle on Win32
+
+=head1 VERSION
+
+version 1.74
+
+=head1 GENERAL INFO
+
+In general, on Windows, it's best to just use ActiveState Perl and the
+PPM package manager to install a pre-built version of DBD::Oracle however only version 1.17 is available there.
+
+=head1 Oracle Instant Client 11.1.0.6.0 Notes
+
+So far I have managed to get it to Makefile and compile test and install and work. However it seems one needs to set "NLS_LANG" to a valid value
+in the environment variables.
+
+As well IC 11 seems to have trouble finding the .ORA files. A quick fix for this is to add "TNS_ADMIN"
+to the environment variables and point it to where your .ORA files are.
+
+=head1 Other information, some of which is out of date ---
+
+ DBD-Oracle for Windows and Oracle Instantclient and 10XE (Express Edition)
+ By: John Scoles
+ The Pythian Group
+
+The preferred method of getting DBD::Oracle is to use a pre-built version from the ActiveState
+repository, which can be installed with PPM.
+
+Compiling and installing DBD::Oracle 1.18 or later on a windows 2000 professional or XP OS for use
+with Oracle instantClient ver 10.2.0.1 & 10.1.0.5 or Oracle XE requires only a few downloads and
+a minimal number of environment setting. The procedures below were tested on a clean
+Windows platform having no Oracle or other development environment installed.
+
+ 1) The first part of the process is to download and install the latest version of
+ Active Perl from http://www.activeperl.com/.
+
+ 2) Use the PPM application to get the latest version of DBI
+
+ 3) Download the latest DBD::Oracle from http://svn.perl.org/modules/dbd-oracle/trunk/
+
+ 4) Download and unzip the Oracle Instant Client (10.2.0.1 or 10.1.0.5) 32 bit from
+ http://www.oracle.com/technology/tech/oci/instantclient/instantclient.html
+ You will need all three of these products
+ i. Instant Client Package - Basic
+ ii. Instant Client Package - SQL*Plus:
+ iii. Instant Client Package - SDK:
+ or
+
+ install oracle 10XE http://www.oracle.com/technology/products/database/xe/index.html
+
+ 5) You will now need the Microsoft Visual C++ toolkit 2003. Unfortunately this product is no longer available from Microsoft.
+ The file name was VCToolkitSetup.exe and is available at this mirror site http://www.filewatcher.com/m/VCToolkitSetup.exe.32952488.0.0.html at the time of writing.
+ Microsoft's replacement for this tool kit is Visual C++ 2005 Express Edition and all attempts to compile DBD::Oracle with this product fail. It has been successfully compiled
+ using a complete edition of Microsoft Visual Studio 2005.
+ Download and then install this product.
+
+ 6) You will also need the Windows SDK. Which can be found at
+ http://www.microsoft.com/downloads/details.aspx?FamilyId=A55B6B43-E24F-4EA3-A93E-40C0EC4F68E5&displaylang=en
+ You have the choice to of either to download the entire SDK and install or run an online install from the page.
+ Both have been tested and proven to work.
+
+ 7) Next download and install the Microsoft .net framework 1.1 skd from
+ http://www.microsoft.com/downloads/details.aspx?FamilyID=9b3a2ca6-3647-4070-9f41-a333c6b9181d&displaylang=en
+
+ 8) You will also need a copy of nmake.exe which you can download here http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe
+
+ 9) Enough Downloading and installing go have a coffee.
+
+ 10) You should at this time attempt to connect to an Oracle database with the version SQL*Plus that
+ you installed in step 4. If you are unable to connect at this stage then any problems you encounter
+ later may have nothing to do with DBD::Oracle
+
+ 11) On the path where you installed Visual C++ find and edit the vcvars32.bat file as follows. You may have to modify
+ these path values depending where you installed the products on you computer,
+
+ i. Add the local path to the windows platform SDK include directory to the Set INCLUDE
+ Command Line to include the needed files from the Windows SDK.
+
+ e.g. "C:\Program Files\Microsoft Platform SDK\Include;"
+
+ ii. Add the local path to the .net Vc7 lib directory to the Set LIB command
+ to include the needed library file from the .Net SKD
+
+ e.g. C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib;
+
+ iii. Add the local path to the windows platform SDK Lib directory to the Set Lib command
+ to include the needed library files from the Windows SDK
+
+ e.g. C:\Program Files\Microsoft Platform SDK\Lib;
+
+ 12) Open a Windows Visual C++ command window from the start menu.
+
+ 13) Add the path to the instant client to the Path command. If you are compiling aginst a 10XE db/client then you can skip steps
+ 12 to 14.
+ e.g. PATH = C:/Oracle/instantclient;%PATH%
+
+ 14) Using the "Set" command add "ORACLE_HOME=path to Instant client" to the environment variables.
+ e.g. Set ORACLE_HOME=C:\Oracle\instantclient
+
+ 15) Using the "Set" command add "NLS_LANG=.WE8ISO8859P15" to the environment variables. The globalization variable is required,
+ with this or another compatible value, by Oracle instantclient in order for it to compile correctly.
+ e.g. Set NLS_LANG=.WE8ISO8859P15
+
+ 16) Using the "Set" command add "ORACLE_USERID=test/test@test" substituting test with the username/password@database
+ you wish to run the make test files against.
+ Note: it is not necessary to do this step for the compile and install to work.
+ However: The self-test programs included with Oracle-DBD will mostly fail.
+
+ 17) Move to the DBD-Oracle directory in the Visual C++ window DOS prompt and enter the following.
+
+ c:\oracle-dbd\>perl Makefile.PL
+
+ The Makefile should then run and compile Oracle-dbd without reporting any errors.
+
+ 18) From this DOS prompt enter the following command
+
+ c:\oracle-dbd\>nmake
+
+ The Visual C++ make executable will then build you DBD-execuable. There should be no errors at this point.
+
+ 19) You can test the compile by either entering
+
+ c:\oracle-dbd\>nmake test
+
+ As long as you have given a valid user name, password and database name in step 15 you will see some results. If it appears to
+ run but you do not get a connection check the following.
+
+ i. User name password and DB Name
+ ii. Ensure the a valid TNSNAMES.ORA file is in the Instantclient directory
+ iii. Attempt to log into the version of SQLPLUS that comes with Instantclient.
+ If you manage to log on use the username password and TNS name with
+ the Set ORACLE_USERID = and rerun the tests.
+ iv If you are compiling against 10XE and have skiped steps 12 to 14 try again bu this time carry out these steps
+
+ 20) You can now install DBD-Oracle into you system by entering the following command from the Visual C++ window dos prompt;
+
+ c:\oracle-dbd\>nmake install
+
+ 21) You should now be able to run DBD-Oracle on you system
+
+=head1 09/30 2006 from asu
+
+DBD::Oracle 1.18a
+
+Linux, Debian unstable (
+DBI: 1.52
+perl v5.8.8 built for i486-linux-gnu-thread-multi
+)
+
+Oracle Instant client (10.1.0.5)
+
+The problem is in Makefile.PL. In line 130 the function find_oracle_home
+is used to guess a value form $ORACLE_HOME if it is not set explicitly.
+This value is used in line 138 to setup the environment (regardless
+which client is used).
+
+in line 1443 (sub get_client_version) sqlplus is used to get the
+version string, but for the oracle instant client you must not set
+$ORACLE_HOME (it will generate an error "SP2-0642: SQL*Plus internal
+error state 2165, context 4294967295:0:0")
+
+A solution that worked for me was to set
+local $ENV{ORACLE_HOME} = '';
+in line 1463 immediately before sqlplus is called (but I cannot tell if
+this fails for full client installations)
+
+11/30/05 -- John Scoles
+I have confirmed that this Makefile.pl will work for both Oracle InstantClient
+10.2.0.1 & 10.1.0.4 using same process the Andy Hassall uses. Starting with a clean OD
+One needs only to get the latest version of Active Perl 5.8.7 use PPM to get DBI and then
+install Microsoft Visual C++ toolkit, Windows SDK, and the Microsoft .net
+framework 1.1. and modify the vcvars32.bat in C++ dir as follows
+
+ 1) Add the local path to the windows platform SDK include directory to the
+ Set INCLUDE Command Line to include the needed files from the Windows SDK.
+ e.g. "C:\Program Files\Microsoft Platform SDK\Include;"
+ 2) Add the local path to the .net Vc7 lib directory to the Set LIB
+ command to include the needed library files from the .Net SKD
+ e.g. C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib;
+ 3) Add the local path to the windows platform SDK Lib directory to the Set Lib
+ command to include the needed library files from the Windows SDK
+ e.g. C:\Program Files\Microsoft Platform SDK\Lib;
+
+If one happens to have visual studio installed you may not have to download additional MS products.
+
+12/01/05 --- John Scoles
+Oracle 10XE
+No big problem here as 10XE seems to use the instantclient as well. Just ensure your
+ NLS_LANG and ORACLE_HOME are set to the same directory that 10XE uses
+
+10/07/05 --John Scoles
+Andy Hassall kindly added some changes to the Makefile.PL
+so it will work for the Instant Client 10g on Windows OSs. Below is how he set
+up his environment and the steps he preformed to get it to compile.
+
+ Setting environment for using Microsoft Visual Studio .NET 2003 tools.
+ (If you have another version of Visual Studio or Visual C++ installed and wish
+ to use its tools from the command line, run vcvars32.bat for that version.)
+
+ C:\Documents and Settings\andyh>d:
+
+ D:\>cd cygwin\home\andyh\src\pythian
+
+ D:\cygwin\home\andyh\src\pythian>set ORACLE_HOME=d:\lib\instantclient_10_2
+
+ D:\cygwin\home\andyh\src\pythian>set NLS_LANG=.WE8ISO8859P15
+
+ D:\cygwin\home\andyh\src\pythian>set PATH=d:\lib\instantclient_10_2;D:\Program F
+ iles\Microsoft Visual Studio .NET 2003\Common7\IDE;D:\Program Files\Microsoft Vi
+ sual Studio .NET 2003\VC7\BIN;D:\Program Files\Microsoft Visual Studio .NET 2003
+ \Common7\Tools;D:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\
+ bin\prerelease;D:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\
+ bin;D:\Program Files\Microsoft Visual Studio .NET 2003\SDK\v1.1\bin;C:\WINNT\Mic
+ rosoft.NET\Framework\v1.1.4322;d:\Perl\bin\;C:\WINNT\system32;C:\WINNT;C:\WINNT\
+ System32\Wbem;D:\Program Files\Microsoft SDK\Bin;D:\Program Files\Microsoft SDK\
+ Bin\WinNT
+
+ D:\cygwin\home\andyh\src\pythian>set ORACLE_USERID=test/test@test102
+
+ D:\cygwin\home\andyh\src\pythian>perl Makefile.PL
+
+4/27/04 -- Jeff Urlwin
+
+Do not untar this distribution in a directory with spaces. This will not work.
+
+ i.e. C:\Program Files\ORacle\DBD Oracle Distribution is bad while
+ c:\dev\dbd-oracle-1.15 is good ;)
+
+9/14/02 -- Michael Chase
+
+Makefile.PL uses Win32::TieRegistry or Win32::Registry to find the
+current Oracle Home directory if the ORACLE_HOME environment variable
+is not set. If neither module is installed, you must set ORACLE_HOME
+before running Makefile.PL. Since the registry location of the current
+Oracle Home is in different locations in different Oracle versions,
+it is usually safer to set ORACLE_HOME before running Makefile.PL.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,196 @@
+#PODNAME: DBD::Oracle::Troubleshooting::Win64
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win64
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting::Win64 - Tips and Hints to Troubleshoot DBD::Oracle on Win64
+
+=head1 VERSION
+
+version 1.74
+
+=head1 DBD::Oracle and Windows 64bit
+
+I have successfully compiled and installed DBD::Oracle on Windows 2008 server 64bit operating system today.
+
+I used the latest version of <a href='http://search.cpan.org/~pythian/DBD-Oracle-1.24a/'>DBD::Oracle 1.24</A>
+version 11.2.0.1.0 for 64bit windows of Oracle's
+<a href='http://www.oracle.com/technology/software/tech/oci/instantclient/htdocs/winx64soft.html'>Instant Client Package - Basic</a>
+along with the Instant Client Package - SQL*Plus and finally the Instant Client Package - SDK.
+
+To get it to Make and compile correctly I had to download Microsoft's <a href='http://www.microsoft.com/visualstudio/en-ca/download'>Visual Studio Ultimate</a>
+
+which should contain all the files you need. It is rather portly at 2+gb so you might want to grab lunch while you are downloading it.
+
+After all the above downloading DBB::Oracle installed right out of the box.
+
+All one has to do is select 'Start Menu->All Programs->Microsoft Visual Studio 2010->Visual Studio Tools->Visual Studio x64 Win64 Command Prompt (2010)'
+which will open a good old 'dos' window.
+
+At this point CD to the directory where you downloaded DBD::Oracle
+
+c:\DBD-Oracle>
+
+then set your 'ORACLE_HOME to the Instant Client directory
+
+c:\DBD-Oracle>set ORACLE_HOME=c:\IC_11
+
+you should also set your NLS like this
+
+c:\DBD-Oracle>set NLS_LANG=.WE8ISO8859P15
+
+Once the above setting are done do a
+
+c:\DBD-Oracle>perl Makefile.PL
+
+and then a
+
+c:\DBD-Oracle>nmake install
+
+Which will produce a whole of warnings (the make you can ignore them for now as they do not seem to effect DBD::Oracle at all) and near the end it should output something like this;
+
+Generating code
+Finished generating code
+ if exist blib\arch\auto\DBD\Oracle\Oracle.dll.manifest mt -nologo -manifest blib\arch\auto\DBD\Oracle\Oracle.dll.manifest -outputresource:blib\arch\auto
+\DBD\Oracle\Oracle.dll;2
+ if exist blib\arch\auto\DBD\Oracle\Oracle.dll.manifest del blib\arch\auto\DBD\Oracle\Oracle.dll.manifest
+ C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 755 blib\arch\auto\DBD\Oracle\Oracle.dll
+ C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- Oracle.bs blib\arch\auto\DBD\Oracle\Oracle.bs
+ C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 blib\arch\auto\DBD\Oracle\Oracle.bs
+ C:\Perl64\bin\perl.exe "-Iblib\arch" "-Iblib\lib" ora_explain.PL ora_explain
+Extracted ora_explain from ora_explain.PL with variable substitutions.
+ C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- ora_explain blib\script\ora_explain
+ pl2bat.bat blib\script\ora_explain
+
+At this point you are all done.
+
+Well almost
+
+It is important that you test your code before you install but you will have to set a few things up to get it to fully test correctly
+
+You will need a TNSNAMES.ORA file that points to a valid DB in the Instant Client Directory
+
+Next you will need to set the ORACLE_USER_ID to a valid user
+
+c:\DBD-Oracle>set ORACLE_USER_ID=system/system@XE
+
+You will have to set up TNS_ADMIN to point to the Instant Client Directory
+
+c:\DBD-Oracle>set TNS_ADMIN=c:\IC_11
+
+Most importantly you will have to add the Instant Client directory to your path like this
+
+c:\DBD-Oracle>path = c:\IC_11;%path%
+
+If you do not do this step you will run into the dreaded
+
+Can't load 'C:/Perl/lib/auto/DBD/Oracle/Oracle.dll' for module DBD::Oracle: load_file:%1 is not a valid Win32 application at C:/Perl/lib/DynaLoader.pm line 202.
+
+Error later on after the compile when you try to use DBD::Oracle.
+
+What is actually going on is that Perl cannot find oci.dll (or one of the other .dlls it needs to run) the 'C:/Perl/lib/auto/DBD/Oracle/Oracle.dll' and the DynaLoader error
+are just a false trails. For more info on this check out this page <a href='http://www.alexander-foken.de/Censored%20copy%20of%20Oracle%20Troubleshooter%20HOWTO.html#oneoci'>Oracle Troubleshooter'</a>
+by Alexander Foken. It is rather dated but the facts of why perl did not find a dll are still valid.
+
+now you can do this
+
+c:\DBD-Oracle>nmake test
+
+and all the tests should run and it will report
+
+Finally simple do a
+
+c:\DBD-Oracle>nmake install
+
+and you are all set
+
+That is about it.
+
+At this point you might want to add the Instant Client directory permanently to your path so you will not run into the Dynaloader error again.
+
+In general compiling DBD:Oracle for 64 bit machines has been a hit or miss operation.
+The main thing to remember is you will have to compile using 32 bit Perl and compile DBD::Oracle against a 32bit client
+which sort of defeats the purpose of having a 64bit box.
+So until 64bit Perl comes out we will be posing in this README any success stories we have come across
+
+-------- Original Message --------
+From: Alex Buttery, OCA, MCTS
+ Director, Database Architecture and Operations
+ Impact Rx, Inc.
+
+I needed to get perl working on a 64-bit Windows Server so I got creative. Since I was unable to build DBD::Oracle on the Windows Server
+(even with Visual Studio 6 installed), I decided that I would try another approach. Here are the steps I took to get it working
+(yes, this is a hack and I'm not even sure that it does not violate someone's license agreements but I'm not going to be asking anyone
+else to support this configuration).
+
+ Step 1: Install 32-bit Perl 5.8.8 from Activestate on the Server to the C: drive.
+
+ Step 2: Install the 32-bit Oracle client on the server (I'm assuming the 64-bit client has already been installed and is working) to
+ the c:\oracle\product\10.2.0\client32 directory in the OraHome_Client32 Home.
+
+ Step 3: Locate Oracle.dll in the new Oracle Home directory, it should be located somewhere close to
+ c:\oracle\product\10.2.0\client32\perl\site\5.8.3\MSWin32-x86-multi-thread\auto\DBD\Oracle.
+
+ Step 4: Locate Oracle.dll in the Perl 5.8.8 directory. (C:\Perl) It should be somewhere close to c:\Perl\site\lib\auto\DBD\Oracle.
+
+ Step 5: Copy the contents of the Oracle directory found in Step 3 to the Perl directory found in Step 4.
+
+ Step 6: Copy GetInfo.pm from C:\oracle\product\10.2.0\client32\perl\site\5.8.3\lib\MSWin32-x86-multi-thread\DBD\Oracle to C:\Perl\site\lib\DBD\Oracle
+
+ Step 7: Locate Oracle.pm in the new Oracle Home directory, it should be located somewhere close to
+ c:\oracle\product\10.2.0\client32\perl\site\5.8.3\MSWin32-x86-multi-thread\auto\DBD.
+
+ Step 8: Locate Oracle.pm in the Perl 5.8.8 directory. (C:\Perl) It should be somewhere close to c:\Perl\site\lib\auto\DBD.
+
+ Step 9: Copy Oracle.pm from the Oracle directory found in Step 7 to the Perl directory found in Step 8.
+
+ Step 10: Set up required ODBC connections using the 32-bit ODBC applet (odbcad32.exe) located in the C:\Windows\SysWOW64 directory.
+ Note: The ODBC applet in the Administrative Tools menu points to the odbcad32.exe located in the C:\Windows\system32 directory
+ and is actually the 64 bit version of the ODBC applet This cannot be used by Perl
+
+ Step 11: Create batch scripts to run Perl programs and include the following SET statements to point Perl to the correct Oracle Home:
+
+ SET ORACLE_HOME=c:\oracle\product\10.2.0\client32 <== 32-bit Oracle Home
+
+ SET ORACLE_SID=xyz123 <== SID of Production Database
+
+ SET NLS_LANG=.WE8ISO8859P1 <== Default Language from Database (preceding "." Is required)
+
+ SET PATH=%ORACLE_HOME%\bin;%PATH% <== Add 32-bit Oracle Home to beginning of default PATH
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,168 @@
+#PODNAME: DBD::Oracle::Troubleshooting
+#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle::Troubleshooting - Tips and Hints to Troubleshoot DBD::Oracle
+
+=head1 VERSION
+
+version 1.74
+
+=head1 CONNECTING TO ORACLE
+
+If you are reading this it is assumed that you have successfully
+installed DBD::Oracle and you are having some problems connecting to
+Oracle.
+
+First off you will have to tell DBD::Oracle where the binaries reside
+for the Oracle client it was compiled against. This is the case when
+you encounter a
+
+ DBI connect('','system',...) failed: ERROR OCIEnvNlsCreate.
+
+error in Linux or in Windows when you get
+
+ OCI.DLL not found
+
+The solution to this problem in the case of Linux is to ensure your
+'ORACLE_HOME' (or LD_LIBRARY_PATH for InstantClient) environment
+variable points to the correct directory.
+
+ export ORACLE_HOME=/app/oracle/product/xx.x.x
+
+For Windows the solution is to add this value to you PATH
+
+ PATH=c:\app\oracle\product\xx.x.x;%PATH%
+
+If you get past this stage and get a
+
+ ORA-12154: TNS:could not resolve the connect identifier specified
+
+error then the most likely cause is DBD::ORACLE cannot find your .ORA
+(F<TNSNAMES.ORA>, F<LISTENER.ORA>, F<SQLNET.ORA>) files. This can be
+solved by setting the TNS_ADMIN environment variable to the directory
+where these files can be found.
+
+If you get to this stage and you have either one of the following
+errors;
+
+ ORA-12560: TNS:protocol adapter error
+ ORA-12162: TNS:net service name is incorrectly specified
+
+usually means that DBD::Oracle can find the listener but the it cannot connect to the DB because the listener cannot find the DB you asked for.
+
+=head2 Oracle utilities
+
+If you are still having problems connecting then the Oracle adapters
+utility may offer some help. Run these two commands:
+
+ $ORACLE_HOME/bin/adapters
+ $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/sqlplus
+
+and check the output. The "Protocol Adapters" should include at least "IPC Protocol Adapter" and "TCP/IP
+Protocol Adapter".
+
+If it generates any errors which look relevant then please talk to your
+Oracle technical support (and not the dbi-users mailing list).
+
+=head2 Connecting using a bequeather
+
+If you are using a bequeather to connect to a server
+on the same host as the client, you might have
+to add
+
+ bequeath_detach = yes
+
+to your sqlnet.ora file or you won't be able to safely use fork/system
+functions in Perl.
+
+See the discussion at
+L<http://www.nntp.perl.org/group/perl.dbi.dev/2012/02/msg6837.html>
+and L<http://www.nntp.perl.org/group/perl.dbi.users/2009/06/msg34023.html>
+for more gory details.
+
+=head1 USING THE LONG TYPES
+
+Some examples related to the use of LONG types are available in
+the C<examples/> directory of the distribution.
+
+=head1 Can't find I<libclntsh.so>
+
+I<libclntsh.so> is the shared
+library composed of all the other Oracle libs you used to have to
+statically link.
+libclntsh.so should be in I<$ORACLE_HOME/lib>. If it's missing, try
+running I<$ORACLE_HOME/lib/genclntsh.sh> and it should create it.
+
+Never copy I<libclntsh.so> to a different machine or Oracle version.
+If DBD::Oracle was built on a machine with a different path to I<libclntsh.so>
+then you'll need to set an environment variable, typically
+I<LD_LIBRARY_PATH>, to include the directory containing I<libclntsh.so>.
+
+I<LD_LIBRARY_PATH> is typically ignored if the script is running set-uid
+(which is common in some httpd/CGI configurations). In this case
+either rebuild with I<LD_RUN_PATH> set to include the path to I<libclntsh>
+or create a symbolic link so that I<libclntsh> is available via the same
+path as it was when the module was built. (On Solaris the command
+"ldd -s Oracle.so" can be used to see how the linker is searching for it.)
+
+=head1 Miscellaneous
+
+=head2 Crash with an open connection and Module::Runtime in mod_perl2
+
+See RT 72989 (https://rt.cpan.org/Ticket/Display.html?id=72989)
+
+Apache2 MPM Prefork with mod_perl2 will crash if Module::Runtime is
+loaded, and an Oracle connection is opened through PerlRequire (before
+forking).
+
+It looks like this was fixed in 0.012 of Module::Runtime.
+
+=head2 bin_param_inout swapping return values
+
+See RT 71819 (https://rt.cpan.org/Ticket/Display.html?id=71819)
+
+It seems that in some older versions of Oracle Instant Client
+(certainly 10.2.0.4.0) when output parameters are bound with lengths
+greater than 3584 the output parameters can be returned in the wrong
+placeholders.
+
+It is reported fixed in Instant Client 11.2.0.2.0.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,5636 @@
+# Oracle.pm
+#
+# Copyright (c) 1994-2005 Tim Bunce, Ireland
+# Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada
+#
+# See COPYRIGHT section in the documentation below
+
+require 5.006;
+
+my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
+
+{
+package DBD::Oracle;
+$DBD::Oracle::VERSION = '1.74';
+BEGIN {
+ $DBD::Oracle::AUTHORITY = 'cpan:PYTHIAN';
+}
+# ABSTRACT: Oracle database driver for the DBI module
+
+ use DBI ();
+ use DynaLoader ();
+ use Exporter ();
+ use DBD::Oracle::Object();
+
+ # for dev version
+ $DBD::Oracle::VERSION ||= '1.00';
+
+ @ISA = qw(DynaLoader Exporter);
+ %EXPORT_TAGS = (
+ ora_types => [ qw(
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
+ ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE
+ ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE
+ SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN
+ ) ],
+ ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM) ],
+ ora_fetch_orient => [ qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST
+ OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE
+ OCI_FETCH_RELATIVE)],
+ ora_exe_modes => [ qw( OCI_STMT_SCROLLABLE_READONLY)],
+ ora_fail_over => [ qw( OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN
+ OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT
+ OCI_FO_TXNAL OCI_FO_RETRY)],
+ );
+ @EXPORT_OK = qw(OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var ora_cygwin_set_env );
+ #unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin';
+ Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient ora_exe_modes ora_fail_over));
+
+ my $Revision = substr(q$Revision: 1.103 $, 10);
+
+ require_version DBI 1.51;
+
+ DBD::Oracle->bootstrap($DBD::Oracle::VERSION);
+
+ $drh = undef; # holds driver handle once initialized
+
+ sub CLONE {
+ $drh = undef ;
+ }
+
+ sub driver{
+ return $drh if $drh;
+
+ my($class, $attr) = @_;
+ my $oci = DBD::Oracle::ORA_OCI();
+
+ $class .= "::dr";
+
+ # not a 'my' since we use it above to prevent multiple drivers
+
+ $drh = DBI::_new_drh($class, {
+ 'Name' => 'Oracle',
+ 'Version' => $VERSION,
+ 'Err' => \my $err,
+ 'Errstr' => \my $errstr,
+ 'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce",
+ });
+
+ DBD::Oracle::dr::init_oci($drh) ;
+ $drh->STORE('ShowErrorStatement', 1);
+
+ DBD::Oracle::db->install_method($_) for qw/
+ ora_lob_read
+ ora_lob_write
+ ora_lob_append
+ ora_lob_trim
+ ora_lob_length
+ ora_lob_chunk_size
+ ora_lob_is_init
+ ora_nls_parameters
+ ora_can_unicode
+ ora_can_taf
+ ora_db_startup
+ ora_db_shutdown
+ /;
+
+ DBD::Oracle::st->install_method($_) for qw/
+ ora_fetch_scroll
+ ora_scroll_position
+ ora_ping
+ ora_stmt_type_name
+ ora_stmt_type
+ /;
+
+ $drh;
+ }
+
+
+ END {
+ # Used to silence 'Bad free() ...' warnings caused by bugs in Oracle's code
+ # being detected by Perl's malloc.
+ $ENV{PERL_BADFREE} = 0;
+ #undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry;
+ }
+
+ sub AUTOLOAD {
+ (my $constname = $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname);
+ *$AUTOLOAD = sub { $val };
+ goto &$AUTOLOAD;
+ }
+
+}
+
+
+{ package # hide from PAUSE
+ DBD::Oracle::dr; # ====== DRIVER ======
+ use strict;
+
+ my %dbnames = (); # holds list of known databases (oratab + tnsnames)
+
+ sub load_dbnames {
+ my ($drh) = @_;
+ my $debug = $drh->debug;
+ my $oracle_home = DBD::Oracle::ora_env_var($ORACLE_ENV);
+ local *FH;
+ my $d;
+
+ if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) {
+ # XXX experimental, will probably change
+ $drh->trace_msg("Trying to fetch ORACLE_HOME and ORACLE_SID from the registry.\n")
+ if $debug;
+ my $sid = DBD::Oracle::ora_env_var("ORACLE_SID");
+ $dbnames{$sid} = $oracle_home if $sid and $oracle_home;
+ $drh->trace_msg("Found $sid \@ $oracle_home.\n") if $debug && $sid;
+ }
+
+ # get list of 'local' database SIDs from oratab
+ foreach $d (qw(/etc /var/opt/oracle), DBD::Oracle::ora_env_var("TNS_ADMIN")) {
+ next unless defined $d;
+ next unless open(FH, "<$d/oratab");
+ $drh->trace_msg("Loading $d/oratab\n") if $debug;
+ my $ot;
+ while (defined($ot = <FH>)) {
+ next unless $ot =~ m/^\s*(\w+)\s*:\s*(.*?)\s*:/;
+ $dbnames{$1} = $2; # store ORACLE_HOME value
+ $drh->trace_msg("Found $1 \@ $2.\n") if $debug;
+ }
+ close FH;
+ last;
+ }
+
+ # get list of 'remote' database connection identifiers
+ my @tns_admin = ( DBD::Oracle::ora_env_var("TNS_ADMIN"), '.' );
+ push @tns_admin, map { join '/', $oracle_home, $_ }
+ 'network/admin', # OCI 7 and 8.1
+ 'net80/admin', # OCI 8.0
+ if $oracle_home;
+ push @tns_admin, '/var/opt/oracle', '/etc';
+
+ TNS_ADMIN:
+ foreach $d ( grep { $_ and -d $_ } @tns_admin ) {
+ open FH, '<', "$d/tnsnames.ora" or next TNS_ADMIN;
+
+ $drh->trace_msg("Loading $d/tnsnames.ora\n") if $debug;
+ local *_;
+ while (<FH>) {
+ next unless m/^\s*([-\w\.]+)\s*=/;
+ my $name = $1;
+ $drh->trace_msg("Found $name. ".($dbnames{$name} ? "(oratab entry overridden)" : "")."\n")
+ if $debug;
+ $dbnames{$name} = 0; # exists but false (to distinguish from oratab)
+ }
+ close FH;
+ last;
+ }
+
+ $dbnames{0} = 1; # mark as loaded (even if empty)
+ }
+
+ sub data_sources {
+ my $drh = shift;
+ load_dbnames($drh) unless %dbnames;
+ my @names = sort keys %dbnames;
+ my @sources = map { $_ ? ("dbi:Oracle:$_") : () } @names;
+ return @sources;
+ }
+
+
+ sub connect {
+ my ($drh, $dbname, $user, $auth, $attr)= @_;
+
+ # Make 'sid=whatever' an alias for 'whatever'.
+ # see RT91775
+ $dbname =~ s/^sid=([^;]+)$/$1/;
+
+ if ($dbname =~ /;/) {
+ my ($n,$v);
+ $dbname =~ s/^\s+//;
+ $dbname =~ s/\s+$//;
+ my @dbname = map {
+ ($n,$v) = split /\s*=\s*/, $_, -1;
+ Carp::carp("DSN component '$_' is not in 'name=value' format")
+ unless defined $v && defined $n;
+ (uc($n), $v)
+ } split /\s*;\s*/, $dbname;
+ my %dbname = ( PROTOCOL => 'tcp', @dbname );
+
+ if ((exists $dbname{SERVER}) and ($dbname{SERVER} eq "POOLED")) {
+ $attr->{ora_drcp}=1;
+ }
+
+ # extract main attributes for connect_data portion
+ my @connect_data_attr = qw(SID INSTANCE_NAME SERVER SERVICE_NAME );
+ my %connect_data = map { ($_ => delete $dbname{$_}) }
+ grep { exists $dbname{$_} } @connect_data_attr;
+
+ my $connect_data = join "", map { "($_=$connect_data{$_})" } keys %connect_data;
+ return $drh->DBI::set_err(-1,
+ "Can't connect using this syntax without specifying a HOST and one of @connect_data_attr")
+ unless $dbname{HOST} and %connect_data;
+
+ my @addrs = map { "($_=$dbname{$_})" } keys %dbname;
+ my $addrs = join "", @addrs;
+ if ($dbname{PORT}) {
+ $addrs = "(ADDRESS=$addrs)";
+ }
+ else {
+ $addrs = "(ADDRESS_LIST=(ADDRESS=$addrs(PORT=1526))"
+ . "(ADDRESS=$addrs(PORT=1521)))";
+ }
+ $dbname = "(DESCRIPTION=$addrs(CONNECT_DATA=$connect_data))";
+ $drh->trace_msg("connect using '$dbname'");
+ }
+
+ # If the application is asking for specific database
+ # then we may have to mung the dbname
+
+ $dbname = $1 if !$dbname && $user && $user =~ s/\@(.*)//s;
+
+ $drh->trace_msg("$ORACLE_ENV environment variable not set\n")
+ if !$ENV{$ORACLE_ENV} and $^O ne "MSWin32";
+
+ # create a 'blank' dbh
+
+ $user = '' if not defined $user;
+ (my $user_only = $user) =~ s:/.*::;
+
+ if (substr($dbname,-7,7) eq ':POOLED'){
+ $dbname=substr($dbname,0,-7);
+ $attr->{ora_drcp} = 1;
+ }
+ elsif ($ENV{ORA_DRCP}){
+ $attr->{ora_drcp} = 1;
+ }
+
+ my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
+ 'Name' => $dbname,
+ 'dbi_imp_data' => $attr->{dbi_imp_data},
+ # these two are just for backwards compatibility
+ 'USER' => uc $user_only, 'CURRENT_USER' => uc $user_only,
+ });
+
+ # Call Oracle OCI logon func in Oracle.xs file
+ # and populate internal handle data.
+
+
+ if (exists $ENV{ORA_DRCP_CLASS}) {
+ $attr->{ora_drcp_class} = $ENV{ORA_DRCP_CLASS}
+ }
+ if($attr->{ora_drcp_class}){
+ # if using ora_drcp_class it cannot contain more than 1024 bytes
+ # and cannot contain a *
+ if (index($attr->{ora_drcp_class},'*') !=-1){
+ Carp::croak("ora_drcp_class cannot contain a '*'!");
+ }
+ if (length($attr->{ora_drcp_class}) > 1024){
+ Carp::croak("ora_drcp_class must be less than 1024 characters!");
+ }
+ }
+ if (exists $ENV{ORA_DRCP_MIN}) {
+ $attr->{ora_drcp_min} = $ENV{ORA_DRCP_MIN}
+ }
+ if (exists $ENV{ORA_DRCP_MAX}) {
+ $attr->{ora_drcp_max} = $ENV{ORA_DRCP_MAX}
+ }
+ if (exists $ENV{ORA_DRCP_INCR}) {
+ $attr->{ora_drcp_incr} = $ENV{ORA_DRCP_INCR}
+ }
+
+ {
+ local @SIG{ @{ $attr->{ora_connect_with_default_signals} } }
+ if $attr->{ora_connect_with_default_signals};
+ DBD::Oracle::db::_login($dbh, $dbname, $user, $auth, $attr)
+ or return undef;
+ }
+
+ unless (length $user_only) {
+ $user_only = $dbh->selectrow_array(q{
+ SELECT SYS_CONTEXT('userenv','session_user') FROM DUAL
+ })||'';
+ $dbh_inner->{Username} = $user_only;
+ # these two are just for backwards compatibility
+ $dbh_inner->{USER} = $dbh_inner->{CURRENT_USER} = uc $user_only;
+ }
+ if ($ENV{ORA_DBD_NCS_BUFFER}){
+ $dbh->{'ora_ncs_buff_mtpl'}= $ENV{ORA_DBD_NCS_BUFFER};
+ }
+ $dbh;
+
+ }
+
+ sub private_attribute_info {
+ return { ora_home_key=>undef};
+ }
+
+}
+
+
+{ package # hide from PAUSE
+ DBD::Oracle::db; # ====== DATABASE ======
+ use strict;
+ use DBI qw(:sql_types);
+
+ sub prepare {
+ my($dbh, $statement, @attribs)= @_;
+
+ # create a 'blank' sth
+
+ my $sth = DBI::_new_sth($dbh, {
+ 'Statement' => $statement,
+ });
+
+ # Call Oracle OCI parse func in Oracle.xs file.
+ # and populate internal handle data.
+
+ DBD::Oracle::st::_prepare($sth, $statement, @attribs)
+ or return undef;
+
+ $sth;
+ }
+
+#Ah! I see you have the machine that goes PING!!
+#Yes!! We leased it from the company that made it
+#then the cost came out of the operating budget
+#not the capital ...
+
+ sub ping {
+ my($dbh) = @_;
+ local $@;
+ my $ok = 0;
+ eval {
+ local $SIG{__DIE__};
+ local $SIG{__WARN__};
+ $ok=ora_ping($dbh);
+ };
+ return ($@) ? 0 : $ok;
+ }
+
+
+ sub get_info {
+ my($dbh, $info_type) = @_;
+ require DBD::Oracle::GetInfo;
+ my $v = $DBD::Oracle::GetInfo::info{int($info_type)};
+ $v = $v->($dbh) if ref $v eq 'CODE';
+ return $v;
+ }
+
+ sub private_attribute_info { #this should only be for ones that have setters and getters
+ return { ora_max_nested_cursors => undef,
+ ora_array_chunk_size => undef,
+ ora_ph_type => undef,
+ ora_ph_csform => undef,
+ ora_parse_error_offset => undef,
+ ora_dbh_share => undef,
+ ora_envhp => undef,
+ ora_svchp => undef,
+ ora_errhp => undef,
+ ora_init_mode => undef,
+ ora_charset => undef,
+ ora_ncharset => undef,
+ ora_session_mode => undef,
+ ora_verbose => undef,
+ ora_oci_success_warn => undef,
+ ora_objects => undef,
+ ora_ncs_buff_mtpl => undef,
+ ora_drcp => undef,
+ ora_drcp_class => undef,
+ ora_drcp_min => undef,
+ ora_drcp_max => undef,
+ ora_drcp_incr => undef,
+ ora_oratab_orahome => undef,
+ ora_module_name => undef,
+ ora_driver_name => undef,
+ ora_client_info => undef,
+ ora_client_identifier => undef,
+ ora_action => undef,
+ ora_taf_function => undef,
+ };
+ }
+
+
+ sub table_info {
+ my($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
+ # XXX add knowledge of temp tables, etc
+ # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
+ if (ref $CatVal eq 'HASH') {
+ ($CatVal, $SchVal, $TblVal, $TypVal) =
+ @$CatVal{'TABLE_CAT','TABLE_SCHEM','TABLE_NAME','TABLE_TYPE'};
+ }
+ 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
+ FROM DUAL
+SQL
+ }
+ elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b
+ $SQL = <<'SQL';
+SELECT NULL TABLE_CAT
+ , s TABLE_SCHEM
+ , NULL TABLE_NAME
+ , NULL TABLE_TYPE
+ , NULL REMARKS
+ FROM
+(
+ SELECT USERNAME s FROM ALL_USERS
+ UNION
+ SELECT 'PUBLIC' s FROM DUAL
+)
+ ORDER BY TABLE_SCHEM
+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 FROM DUAL
+ UNION
+ SELECT 'VIEW' tt FROM DUAL
+ UNION
+ SELECT 'SYNONYM' tt FROM DUAL
+ UNION
+ SELECT 'SEQUENCE' tt FROM DUAL
+) t
+ ORDER BY TABLE_TYPE
+SQL
+ }
+ else {
+ $SQL = <<'SQL';
+SELECT *
+ FROM
+(
+ SELECT /*+ CHOOSE */
+ NULL TABLE_CAT
+ , t.OWNER TABLE_SCHEM
+ , t.TABLE_NAME TABLE_NAME
+ , decode(t.OWNER
+ , 'SYS' , 'SYSTEM '
+ , 'SYSTEM' , 'SYSTEM '
+ , '' ) || t.TABLE_TYPE TABLE_TYPE
+ , c.COMMENTS REMARKS
+ FROM ALL_TAB_COMMENTS c
+ , ALL_CATALOG t
+ WHERE c.OWNER (+) = t.OWNER
+ AND c.TABLE_NAME (+) = t.TABLE_NAME
+ AND c.TABLE_TYPE (+) = t.TABLE_TYPE
+)
+SQL
+ if ( defined $SchVal ) {
+ push @Where, "TABLE_SCHEM LIKE '$SchVal' ESCAPE '\\'";
+ }
+ if ( defined $TblVal ) {
+ push @Where, "TABLE_NAME LIKE '$TblVal' ESCAPE '\\'";
+ }
+ 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 ($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) = @_;
+ if (ref $catalog eq 'HASH') {
+ ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'};
+ $catalog = undef;
+ }
+ my $SQL = <<'SQL';
+SELECT *
+ FROM
+(
+ SELECT /*+ CHOOSE */
+ NULL TABLE_CAT
+ , c.OWNER TABLE_SCHEM
+ , c.TABLE_NAME TABLE_NAME
+ , c.COLUMN_NAME COLUMN_NAME
+ , c.POSITION KEY_SEQ
+ , c.CONSTRAINT_NAME PK_NAME
+ FROM ALL_CONSTRAINTS p
+ , ALL_CONS_COLUMNS c
+ WHERE p.OWNER = c.OWNER
+ AND p.TABLE_NAME = c.TABLE_NAME
+ AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME
+ AND p.CONSTRAINT_TYPE = 'P'
+)
+ WHERE TABLE_SCHEM = ?
+ AND TABLE_NAME = ?
+ ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ
+SQL
+#warn "@_\n$Sql ($schema, $table)";
+ my $sth = $dbh->prepare($SQL) or return undef;
+ $sth->execute($schema, $table) or return undef;
+ $sth;
+}
+
+ sub foreign_key_info {
+ my $dbh = shift;
+ my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
+ 'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2]
+ ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] };
+ my $SQL = <<'SQL'; # XXX: DEFERABILITY
+SELECT *
+ FROM
+(
+ SELECT /*+ CHOOSE */
+ to_char( NULL ) UK_TABLE_CAT
+ , uk.OWNER UK_TABLE_SCHEM
+ , uk.TABLE_NAME UK_TABLE_NAME
+ , uc.COLUMN_NAME UK_COLUMN_NAME
+ , to_char( NULL ) FK_TABLE_CAT
+ , fk.OWNER FK_TABLE_SCHEM
+ , fk.TABLE_NAME FK_TABLE_NAME
+ , fc.COLUMN_NAME FK_COLUMN_NAME
+ , uc.POSITION ORDINAL_POSITION
+ , 3 UPDATE_RULE
+ , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 )
+ DELETE_RULE
+ , fk.CONSTRAINT_NAME FK_NAME
+ , uk.CONSTRAINT_NAME UK_NAME
+ , to_char( NULL ) DEFERABILITY
+ , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE')
+ UNIQUE_OR_PRIMARY
+ FROM ALL_CONSTRAINTS uk
+ , ALL_CONS_COLUMNS uc
+ , ALL_CONSTRAINTS fk
+ , ALL_CONS_COLUMNS fc
+ WHERE uk.OWNER = uc.OWNER
+ AND uk.CONSTRAINT_NAME = uc.CONSTRAINT_NAME
+ AND fk.OWNER = fc.OWNER
+ AND fk.CONSTRAINT_NAME = fc.CONSTRAINT_NAME
+ AND uk.CONSTRAINT_TYPE IN ('P','U')
+ AND fk.CONSTRAINT_TYPE = 'R'
+ AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME
+ AND uk.OWNER = fk.R_OWNER
+ AND uc.POSITION = fc.POSITION
+)
+ WHERE 1 = 1
+SQL
+ my @BindVals = ();
+ while ( my ( $k, $v ) = each %$attr ) {
+ if ( $v ) {
+ $SQL .= " AND $k = ?\n";
+ push @BindVals, $v;
+ }
+ }
+ $SQL .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n";
+ my $sth = $dbh->prepare( $SQL ) or return undef;
+ $sth->execute( @BindVals ) or return undef;
+ $sth;
+ }
+
+
+ sub column_info {
+ my $dbh = shift;
+ my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
+ 'TABLE_SCHEM' => $_[1],'TABLE_NAME' => $_[2],'COLUMN_NAME' => $_[3] };
+ my $ora_server_version = ora_server_version($dbh);
+ my($typecase,$typecaseend, $choose) = ('','','/*+ CHOOSE */');
+ if ($ora_server_version->[0] >= 8) {
+ $typecase = <<'SQL';
+CASE WHEN tc.DATA_TYPE LIKE 'TIMESTAMP% WITH% TIME ZONE' THEN 95
+ WHEN tc.DATA_TYPE LIKE 'TIMESTAMP%' THEN 93
+ WHEN tc.DATA_TYPE LIKE 'INTERVAL DAY% TO SECOND%' THEN 110
+ WHEN tc.DATA_TYPE LIKE 'INTERVAL YEAR% TO MONTH' THEN 107
+ELSE
+SQL
+ $typecaseend = 'END';
+ } elsif ($ora_server_version->[0] >= 11) {
+ # rt91217 CHOOSE hint deprecated
+ $choose = '';
+ }
+ my $char_length = $ora_server_version->[0] < 9 ? 'DATA_LENGTH':'CHAR_LENGTH';
+ my $SQL = <<"SQL";
+SELECT *
+ FROM
+(
+ SELECT $choose
+ to_char( NULL ) TABLE_CAT
+ , tc.OWNER TABLE_SCHEM
+ , tc.TABLE_NAME TABLE_NAME
+ , tc.COLUMN_NAME COLUMN_NAME
+ , $typecase decode( tc.DATA_TYPE
+ , 'MLSLABEL' , -9106
+ , 'ROWID' , -9104
+ , 'UROWID' , -9104
+ , 'BFILE' , -4 -- 31?
+ , 'LONG RAW' , -4
+ , 'RAW' , -3
+ , 'LONG' , -1
+ , 'UNDEFINED', 0
+ , 'CHAR' , 1
+ , 'NCHAR' , 1
+ , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
+ , 'FLOAT' , 8
+ , 'VARCHAR2' , 12
+ , 'NVARCHAR2', 12
+ , 'BLOB' , 30
+ , 'CLOB' , 40
+ , 'NCLOB' , 40
+ , 'DATE' , 93
+ , NULL
+ ) $typecaseend DATA_TYPE -- ...
+ , tc.DATA_TYPE TYPE_NAME -- std.?
+ , decode( tc.DATA_TYPE
+ , 'LONG RAW' , 2147483647
+ , 'LONG' , 2147483647
+ , 'CLOB' , 2147483647
+ , 'NCLOB' , 2147483647
+ , 'BLOB' , 2147483647
+ , 'BFILE' , 2147483647
+ , 'NUMBER' , decode( tc.DATA_SCALE
+ , NULL, 126
+ , nvl( tc.DATA_PRECISION, 38 )
+ )
+ , 'FLOAT' , tc.DATA_PRECISION
+ , 'DATE' , 19
+ , 'VARCHAR2' , tc.$char_length
+ , 'CHAR' , tc.$char_length
+ , 'NVARCHAR2', tc.$char_length
+ , 'NCHAR' , tc.$char_length
+ , tc.DATA_LENGTH
+ ) COLUMN_SIZE
+ , decode( tc.DATA_TYPE
+ , 'LONG RAW' , 2147483647
+ , 'LONG' , 2147483647
+ , 'CLOB' , 2147483647
+ , 'NCLOB' , 2147483647
+ , 'BLOB' , 2147483647
+ , 'BFILE' , 2147483647
+ , 'NUMBER' , nvl( tc.DATA_PRECISION, 38 ) + 2
+ , 'FLOAT' , 8 -- ?
+ , 'DATE' , 16
+ , tc.DATA_LENGTH
+ ) BUFFER_LENGTH
+ , decode( tc.DATA_TYPE
+ , 'DATE' , 0
+ , tc.DATA_SCALE
+ ) DECIMAL_DIGITS -- ...
+ , decode( tc.DATA_TYPE
+ , 'FLOAT' , 2
+ , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 2, 10 )
+ , NULL
+ ) NUM_PREC_RADIX
+ , decode( tc.NULLABLE
+ , 'Y' , 1
+ , 'N' , 0
+ , NULL
+ ) NULLABLE
+ , cc.COMMENTS REMARKS
+ , tc.DATA_DEFAULT COLUMN_DEF -- Column is LONG!
+ , decode( tc.DATA_TYPE
+ , 'MLSLABEL' , -9106
+ , 'ROWID' , -9104
+ , 'UROWID' , -9104
+ , 'BFILE' , -4 -- 31?
+ , 'LONG RAW' , -4
+ , 'RAW' , -3
+ , 'LONG' , -1
+ , 'UNDEFINED', 0
+ , 'CHAR' , 1
+ , 'NCHAR' , 1
+ , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
+ , 'FLOAT' , 8
+ , 'VARCHAR2' , 12
+ , 'NVARCHAR2', 12
+ , 'BLOB' , 30
+ , 'CLOB' , 40
+ , 'NCLOB' , 40
+ , 'DATE' , 9 -- not 93!
+ , NULL
+ ) SQL_DATA_TYPE -- ...
+ , decode( tc.DATA_TYPE
+ , 'DATE' , 3
+ , NULL
+ ) SQL_DATETIME_SUB -- ...
+ , to_number( NULL ) CHAR_OCTET_LENGTH -- TODO
+ , tc.COLUMN_ID ORDINAL_POSITION
+ , decode( tc.NULLABLE
+ , 'Y' , 'YES'
+ , 'N' , 'NO'
+ , NULL
+ ) IS_NULLABLE
+ FROM ALL_TAB_COLUMNS tc
+ , ALL_COL_COMMENTS cc
+ WHERE tc.OWNER = cc.OWNER
+ AND tc.TABLE_NAME = cc.TABLE_NAME
+ AND tc.COLUMN_NAME = cc.COLUMN_NAME
+)
+ WHERE 1 = 1
+SQL
+ my @BindVals = ();
+ while ( my ( $k, $v ) = each %$attr ) {
+ if ( $v ) {
+ $SQL .= " AND $k LIKE ? ESCAPE '\\'\n";
+ push @BindVals, $v;
+ }
+ }
+ $SQL .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n";
+
+
+ # Since DATA_DEFAULT is a LONG, DEFAULT values longer than 80 chars will
+ # throw an ORA-24345 by default; so we check if LongReadLen is set at
+ # the default value, and if so, set it to something less likely to fail
+ # in common usage.
+ #
+ # We do not set LongTruncOk however as that would make COLUMN_DEF
+ # incorrect, in those (extreme!) cases it would be better if the user
+ # sets LongReadLen herself.
+
+ my $long_read_len = $dbh->FETCH('LongReadLen');
+
+ my ($sth, $exc);
+
+ {
+ local $@;
+ eval {
+ $dbh->STORE(LongReadLen => 1024*1024) if $long_read_len == 80;
+ $sth = $dbh->prepare( $SQL );
+ };
+ $exc = $@;
+ }
+ if ($exc) {
+ $dbh->STORE(LongReadLen => 80) if $long_read_len == 80;
+ die $exc;
+ }
+
+ $dbh->STORE(LongReadLen => 80) if $long_read_len == 80;
+
+ return undef if not $sth;
+
+ $sth->execute( @BindVals ) or return undef;
+ $sth;
+ }
+
+ sub statistics_info {
+ my($dbh, $catalog, $schema, $table, $unique_only, $quick) = @_;
+ if (ref $catalog eq 'HASH') {
+ ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'};
+ $catalog = undef;
+ }
+ my $choose = '/*+ CHOOSE */';
+ my $ora_server_version = ora_server_version($dbh);
+ if ($ora_server_version->[0] >= 11) {
+ # rt91217 CHOOSE hint deprecated
+ $choose = '';
+ }
+ my $SQL = <<"SQL";
+SELECT *
+ FROM
+(
+ SELECT $choose
+ NULL TABLE_CAT
+ , t.OWNER TABLE_SCHEM
+ , t.TABLE_NAME TABLE_NAME
+ , to_number( NULL ) NON_UNIQUE
+ , NULL INDEX_QUALIFIER
+ , NULL INDEX_NAME
+ ,'table' TYPE
+ , to_number( NULL ) ORDINAL_POSITION
+ , NULL COLUMN_NAME
+ , NULL ASC_OR_DESC
+ , t.NUM_ROWS CARDINALITY
+ , t.BLOCKS PAGES
+ , NULL FILTER_CONDITION
+ FROM ALL_TABLES t
+ UNION
+ SELECT NULL TABLE_CAT
+ , t.OWNER TABLE_SCHEM
+ , t.TABLE_NAME TABLE_NAME
+ , decode( t.UNIQUENESS,'UNIQUE', 0, 1 ) NON_UNIQUE
+ , c.INDEX_OWNER INDEX_QUALIFIER
+ , c.INDEX_NAME INDEX_NAME
+ , decode( t.INDEX_TYPE,'NORMAL','btree','CLUSTER','clustered','other') TYPE
+ , c.COLUMN_POSITION ORDINAL_POSITION
+ , c.COLUMN_NAME COLUMN_NAME
+ , decode( c.DESCEND,'ASC','A','DESC','D') ASC_OR_DESC
+ , t.DISTINCT_KEYS CARDINALITY
+ , t.LEAF_BLOCKS PAGES
+ , NULL FILTER_CONDITION
+ FROM ALL_INDEXES t
+ , ALL_IND_COLUMNS c
+ WHERE t.OWNER = c.INDEX_OWNER
+ AND t.INDEX_NAME = c.INDEX_NAME
+ AND t.TABLE_OWNER = c.TABLE_OWNER
+ AND t.TABLE_NAME = c.TABLE_NAME
+ AND t.UNIQUENESS LIKE :3
+)
+ WHERE TABLE_SCHEM = :1
+ AND TABLE_NAME = :2
+ ORDER BY NON_UNIQUE, TYPE, INDEX_QUALIFIER, INDEX_NAME, ORDINAL_POSITION
+SQL
+ my $sth = $dbh->prepare($SQL) or return undef;
+ $sth->execute($schema, $table, $unique_only ?'UNIQUE':'%') or return undef;
+ $sth;
+ }
+
+ sub type_info_all {
+ my ($dbh) = @_;
+ my $version = ( ora_server_version($dbh)->[0] < DBD::Oracle::ORA_OCI() )
+ ? ora_server_version($dbh)->[0] : DBD::Oracle::ORA_OCI();
+ my $vc2len = ( $version < 8 ) ? "2000" : "4000";
+
+ my $type_info_all = [
+ {
+ 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,
+ },
+ [ "LONG RAW", SQL_LONGVARBINARY, 2147483647,"'", "'",
+ undef, 1,0,0,undef,0,undef,
+ "LONG RAW", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
+ [ "RAW", SQL_VARBINARY, 2000, "'", "'",
+ "max length", 1,0,3,undef,0,undef,
+ "RAW", undef,undef,SQL_VARBINARY, undef,undef,undef, ],
+ [ "LONG", SQL_LONGVARCHAR, 2147483647,"'", "'",
+ undef, 1,1,0,undef,0,undef,
+ "LONG", undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ],
+ [ "CHAR", SQL_CHAR, 2000, "'", "'",
+ "max length", 1,1,3,undef,0,0,
+ "CHAR", undef,undef,SQL_CHAR, undef,undef,undef, ],
+ [ "DECIMAL", SQL_DECIMAL, 38, undef,undef,
+ "precision,scale",1,0,3,0, 0,0,
+ "DECIMAL", 0, 38, SQL_DECIMAL, undef,10, undef, ],
+ [ "DOUBLE PRECISION",SQL_DOUBLE, 15, undef,undef,
+ undef, 1,0,3,0, 0,0,
+ "DOUBLE PRECISION",undef,undef,SQL_DOUBLE, undef,10, undef, ],
+ [ "DATE", SQL_TYPE_TIMESTAMP,19, "'", "'",
+ undef, 1,0,3,undef,0,0,
+ "DATE", 0, 0, SQL_DATE, 3, undef,undef, ],
+ [ "VARCHAR2", SQL_VARCHAR, $vc2len, "'", "'",
+ "max length", 1,1,3,undef,0,0,
+ "VARCHAR2", undef,undef,SQL_VARCHAR, undef,undef,undef, ],
+ [ "BLOB", SQL_BLOB, 2147483647,"'", "'",
+ undef, 1,1,0,undef,0,undef,
+ "BLOB", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
+ [ "BFILE", -9114, 2147483647,"'", "'",
+ undef, 1,1,0,undef,0,undef,
+ "BFILE", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
+ [ "CLOB", SQL_CLOB, 2147483647,"'", "'",
+ undef, 1,1,0,undef,0,undef,
+ "CLOB", undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ],
+ ["TIMESTAMP WITH TIME ZONE", # type name
+ SQL_TYPE_TIMESTAMP_WITH_TIMEZONE, # data type
+ 40, # column size
+ "TIMESTAMP'", # literal prefix
+ "'", # literal suffix
+ "precision", # create params
+ 1, # nullable
+ 0, # case sensitive
+ 3, # searchable
+ undef, # unsigned attribute
+ 0, # fixed prec scale
+ 0, # auto unique value
+ undef, # local type name
+ 0, # minimum scale
+ 6, # maximum scale
+ SQL_TIMESTAMP, # sql data type
+ 5, # sql datetime sub
+ undef, # num prec radix
+ undef, # interval precision
+ ],
+ [ "INTERVAL DAY TO SECOND", # type name
+ SQL_INTERVAL_DAY_TO_SECOND, # data type
+ 22, # column size '+00 11:12:10.222222200'
+ "INTERVAL'", # literal prefix
+ "'", # literal suffix
+ "precision", # create params
+ 1, # nullable
+ 0, # case sensitive
+ 3, # searchable
+ undef, # unsigned attribute
+ 0, # fixed prec scale
+ 0, # auto unique value
+ undef, # local type name
+ 0, # minimum scale
+ 9, # maximum scale
+ SQL_INTERVAL, # sql data type
+ 10, # sql datetime sub
+ undef, # num prec radix
+ undef, # interval precision
+ ],
+ [ "INTERVAL YEAR TO MONTH", # type name
+ SQL_INTERVAL_YEAR_TO_MONTH, # data type
+ 13, # column size '+012345678-01'
+ "INTERVAL'", # literal prefix
+ "'", # literal suffix
+ "precision", # create params
+ 1, # nullable
+ 0, # case sensitive
+ 3, # searchable
+ undef, # unsigned attribute
+ 0, # fixed prec scale
+ 0, # auto unique value
+ undef, # local type name
+ 0, # minimum scale
+ 9, # maximum scale
+ SQL_INTERVAL, # sql data type
+ 7, # sql datetime sub
+ undef, # num prec radix
+ undef, # interval precision
+ ]
+ ];
+
+ return $type_info_all;
+ }
+
+ sub plsql_errstr {
+ # original version thanks to Bob Menteer
+ my $sth = shift->prepare_cached(q{
+ SELECT name, type, line, position, text
+ FROM user_errors ORDER BY name, type, sequence
+ }) or return undef;
+ $sth->execute or return undef;
+ my ( @msg, $oname, $otype, $name, $type, $line, $pos, $text );
+ $oname = $otype = 0;
+ while ( ( $name, $type, $line, $pos, $text ) = $sth->fetchrow_array ) {
+ if ( $oname ne $name || $otype ne $type ) {
+ push @msg, "Errors for $type $name:";
+ $oname = $name;
+ $otype = $type;
+ }
+ push @msg, "$line.$pos: $text";
+ }
+ return join( "\n", @msg );
+ }
+
+ #
+ # note, dbms_output must be enabled prior to usage
+ #
+ sub dbms_output_enable {
+ my ($dbh, $buffersize) = @_;
+ $buffersize ||= 20000; # use oracle 7.x default
+ $dbh->do("begin dbms_output.enable(:1); end;", undef, $buffersize);
+ }
+
+ sub dbms_output_get {
+ my $dbh = shift;
+ my $sth = $dbh->prepare_cached("begin dbms_output.get_line(:l, :s); end;")
+ or return;
+ my ($line, $status, @lines);
+ my $version = join ".", @{ ora_server_version($dbh) }[0..1];
+ my $len = 32767;
+ if ($version < 10.2){
+ $len = 400;
+ }
+ # line can be greater that 255 (e.g. 7 byte date is expanded on output)
+ $sth->bind_param_inout(':l', \$line, $len, { ora_type => 1 });
+ $sth->bind_param_inout(':s', \$status, 20, { ora_type => 1 });
+ if (!wantarray) {
+ $sth->execute or return undef;
+ return $line if $status eq '0';
+ return undef;
+ }
+ push @lines, $line while($sth->execute && $status eq '0');
+ return @lines;
+ }
+
+ sub dbms_output_put {
+ my $dbh = shift;
+ my $sth = $dbh->prepare_cached("begin dbms_output.put_line(:1); end;")
+ or return;
+ my $line;
+ foreach $line (@_) {
+ $sth->execute($line) or return;
+ }
+ return 1;
+ }
+
+
+ sub dbms_msgpipe_get {
+ my $dbh = shift;
+ my $sth = $dbh->prepare_cached(q{
+ begin dbms_msgpipe.get_request(:returnpipe, :proc, :param); end;
+ }) or return;
+ my $msg = ['','',''];
+ $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
+ $sth->bind_param_inout(":proc", \$msg->[1], 30);
+ $sth->bind_param_inout(":param", \$msg->[2], 4000);
+ $sth->execute or return undef;
+ return $msg;
+ }
+
+ sub dbms_msgpipe_ack {
+ my $dbh = shift;
+ my $msg = shift;
+ my $sth = $dbh->prepare_cached(q{
+ begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;}) or return;
+ $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
+ $sth->bind_param_inout(":proc", \$msg->[1], 30);
+ $sth->bind_param_inout(":param", \$msg->[2], 4000);
+ $sth->execute or return undef;
+ return 1;
+ }
+
+ sub ora_server_version {
+ my $dbh = shift;
+ return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
+ my $banner = $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%');
+SELECT banner
+ FROM v$version
+ WHERE banner LIKE ? OR banner LIKE ?
+SQL
+ if (defined $banner) {
+ my @version = $banner =~ /(?:^|\s)(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\s|$)/;
+ $dbh->{ora_server_version} = \@version if @version;
+ }
+ }
+
+ sub ora_nls_parameters {
+ my $dbh = shift;
+ my $refresh = shift;
+
+ if ($refresh || !$dbh->{ora_nls_parameters}) {
+ my $nls_parameters = $dbh->selectall_arrayref(q{
+ SELECT parameter, value FROM v$nls_parameters
+ }) or return;
+ $dbh->{ora_nls_parameters} = { map { $_->[0] => $_->[1] } @$nls_parameters };
+ }
+
+ # return copy of params to protect against accidental editing
+ my %nls = %{$dbh->{ora_nls_parameters}};
+ return \%nls;
+ }
+
+ sub ora_can_unicode {
+ my $dbh = shift;
+ my $refresh = shift;
+ # 0 = No Unicode support.
+ # 1 = National character set is Unicode-based.
+ # 2 = Database character set is Unicode-based.
+ # 3 = Both character sets are Unicode-based.
+
+ return $dbh->{ora_can_unicode}
+ if defined $dbh->{ora_can_unicode} && !$refresh;
+
+ my $nls = $dbh->ora_nls_parameters($refresh);
+
+ $dbh->{ora_can_unicode} = 0;
+ $dbh->{ora_can_unicode} += 1 if $nls->{NLS_NCHAR_CHARACTERSET} =~ /UTF/;
+ $dbh->{ora_can_unicode} += 2 if $nls->{NLS_CHARACTERSET} =~ /UTF/;
+
+ return $dbh->{ora_can_unicode};
+ }
+
+} # end of package DBD::Oracle::db
+
+
+{ package # hide from PAUSE
+ DBD::Oracle::st; # ====== STATEMENT ======
+
+
+ sub bind_param_inout_array {
+ my $sth = shift;
+ my ($p_id, $value_array,$maxlen, $attr) = @_;
+ return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be 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_inout_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} ||= { };
+
+ $$hash_of_arrays{$p_id} = $value_array;
+ return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen, $attr);
+ 1;
+
+ }
+
+
+ sub execute_for_fetch {
+ my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
+ my $row_count = 0;
+ my $err_total = 0;
+ my $tuple_count="0E0";
+ my $tuple_batch_status;
+ my $dbh = $sth->{Database};
+ my $batch_size =($dbh->{'ora_array_chunk_size'}||= 1000);
+ if(defined($tuple_status)) {
+ @$tuple_status = ();
+ $tuple_batch_status = [ ];
+ }
+
+ my $finished;
+ while (1) {
+ my @tuple_batch;
+ for (my $i = 0; $i < $batch_size; $i++) {
+ $finished = $fetch_tuple_sub->();
+ push @tuple_batch, [@{$finished || last}];
+
+ }
+ last unless @tuple_batch;
+
+ my $err_count = 0;
+ my $res = ora_execute_array($sth,
+ \@tuple_batch,
+ scalar(@tuple_batch),
+ $tuple_batch_status,
+ $err_count );
+
+ if(defined($res)) { #no error
+ $row_count += $res;
+ } else {
+ $row_count = undef;
+ }
+
+ $err_total += $err_count;
+
+ $tuple_count+=@tuple_batch;
+ push @$tuple_status, @$tuple_batch_status
+ if defined($tuple_status);
+
+ last if !$finished;
+
+ }
+ #error check here
+ return $sth->set_err($DBI::stderr, "executing $tuple_count generated $err_total errors")
+ if $err_total;
+
+ return wantarray
+ ? ($tuple_count, defined $row_count ? $row_count : undef)
+ : $tuple_count;
+
+ }
+
+ sub private_attribute_info {
+ return { map { $_ => undef } qw/
+ ora_lengths
+ ora_types
+ ora_rowid
+ ora_est_row_width
+ ora_type
+ ora_fail_over
+ / };
+ }
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+DBD::Oracle - Oracle database driver for the DBI module
+
+=head1 VERSION
+
+version 1.74
+
+=head1 SYNOPSIS
+
+ use DBI;
+
+ $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd);
+
+ $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd);
+
+ # See the DBI module documentation for full details
+
+ # for some advanced uses you may need Oracle type values:
+ use DBD::Oracle qw(:ora_types);
+
+=head1 DESCRIPTION
+
+DBD::Oracle is a Perl module which works with the DBI module to provide
+access to Oracle databases.
+
+This documentation describes driver specific behaviour and restrictions. It is
+not supposed to be used as the only reference for the user. In any case
+consult the L<DBI> documentation first!
+
+=head1 CONSTANTS
+
+=over 4
+
+=item :ora_session_modes
+
+ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM
+
+=item :ora_types
+
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
+
+=item SQLCS_IMPLICIT
+
+=item SQLCS_NCHAR
+
+SQLCS_IMPLICIT and SQLCS_NCHAR are I<character set form> values.
+See notes about Unicode elsewhere in this document.
+
+=item SQLT_INT
+
+=item SQLT_FLT
+
+These types are used only internally, and may be specified as internal
+bind type for ORA_NUMBER_TABLE. See notes about ORA_NUMBER_TABLE elsewhere
+in this document
+
+=item ORA_OCI
+
+Oracle doesn't provide a formal API for determining the exact version
+number of the OCI client library used, so DBD::Oracle has to go digging
+(and sometimes has to more or less guess). The ORA_OCI constant
+holds the result of that process.
+
+In string context ORA_OCI returns the full "A.B.C.D" version string.
+
+In numeric context ORA_OCI returns the major.minor version number
+(8.1, 9.2, 10.0 etc). But note that version numbers are not actually
+floating point and so if Oracle ever makes a release that has a two
+digit minor version, such as C<9.10> it will have a lower numeric
+value than the preceding C<9.9> release. So use with care.
+
+The contents and format of ORA_OCI are subject to change (it may,
+for example, become a I<version object> in later releases).
+I recommend that you avoid checking for exact values.
+
+=item :ora_fetch_orient
+
+ OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST
+ OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE
+
+These constants are used to set the orientation of a fetch on a scrollable cursor.
+
+=item :ora_exe_modes
+
+ OCI_STMT_SCROLLABLE_READONLY
+
+=item :ora_fail_over
+
+ OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR
+ OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY
+
+=back
+
+=head1 DBI CLASS METHODS
+
+=head2 B<connect>
+
+This method creates a database handle by connecting to a database, and is the DBI equivalent of the "new" method.
+To open a connection to an Oracle database you need to specify a database connection string (URL), username and password.
+
+The connection string is always of the form: "dbi:Oracle:<db identifier>"
+There are several ways to identify a database:
+
+=over
+
+=item 1
+
+If the database is local, specifying the SID or service name will be enough.
+
+=item 2
+
+If the database is defined in a TNSNAMES.ORA file, you can use the service name given in the file
+
+=item 3
+
+To connect without TNSNAMES.ORA file, you can use an EZCONNECT url, of the form:
+//host[:port][/service_name]
+
+=back
+
+If port name is not specified, 1521 is the default. If service name is not specified, the hostname will be used as a service name.
+
+The following examples show several ways a connection can be created:
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password');
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username/password','');
+
+ $dbh = DBI->connect('dbi:Oracle:','username@DB','password');
+
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', '');
+
+ $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password');
+
+=head3 OS authentication
+
+To connect to a local database with a user which has been set up to
+authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"):
+
+ $dbh = DBI->connect('dbi:Oracle:','/','');
+
+Note the lack of a connection name (use the ORACLE_SID environment
+variable). If an explicit SID is used you will probably get an ORA-01004 error.
+
+That only works for local databases. (Authentication to remote Oracle
+databases using your Unix login name without a password is possible
+but it is not secure and not recommended so not documented here.
+
+=head3 Oracle Environment Variables
+
+To use DBD::ORACLE to connect to an Oracle database, ORACLE_HOME environment variable should be set correctly.
+In general, the value used should match the version of Oracle that was used to build DBD::Oracle. If using dynamic linking then ORACLE_HOME should match the version of Oracle that will be used to load in the Oracle client libraries (via LD_LIBRARY_PATH, ldconfig, or similar on Unix).
+
+Oracle can use two environment variables to specify default connections: ORACLE_SID and TWO_TASK.
+
+To use them, specify either a local SID or service name, or a service name that is specified in the TNSNAMES.ORA file.
+
+Note that if you have *both* local and remote databases, and you have ORACLE_SID *and* TWO_TASK set, and you don't specify a fully
+qualified connect string on the command line, TWO_TASK takes precedence over ORACLE_SID (i.e. you get connected to remote system).
+
+It is highly recommended not to rely on environment variables and to always explicitly specify the SID in the connection string. This can prevent serious mistakes such as dropping a schema in the wrong database, and generally makes debugging and troubleshooting easier.
+
+Also remember that depending on the operating system you are using the differing "ORACLE" environment variables may be case sensitive, so if you are not connecting as you should double check the case of both the variable and its value.
+
+=head3 Timezones
+
+If the query is run through SQL*Net (mostly queries that are executed on remote servers), Oracle will return the time zone based on the setting of the UNIX environment variable "TZ" for the user who started the listener.
+
+If the query is run locally, Oracle will return the time zone based on the "TZ" environment variable setting of the user running
+the query.
+
+With local queries, you can change the time zone for a particular user by simply changing the setting of "TZ". To check the current setting,
+issue the UNIX "date" command.
+
+=head3 Oracle DRCP
+
+DBD::Oracle supports DRCP (Database Resident Connection Pool) so
+if you have an 11.2 database and DRCP is enabled you can direct
+all of your connections to it by adding ':POOLED' to the SID or
+setting a connection attribute of ora_drcp, or set the SERVER=POOLED
+when using a TNSENTRY style connection or even by setting an
+environment variable ORA_DRCP. All of which are demonstrated below;
+
+ $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password')
+
+ $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password')
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1})
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1,
+ ora_drcp_class=>'my_app',
+ ora_drcp_min =>10})
+
+ $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '')
+
+ $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION=
+ (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521))
+ (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "")
+
+ if the ORA_DRCP environment variable is set then just this
+
+ $dbh = DBI->connect('dbi:Oracle:DB','username','password')
+
+You can find a white paper on setting up DRCP and its advantages at L<http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf>.
+
+Please note that DRCP support in DBD::Oracle is relatively new so the
+mechanics or its implementation are subject to change.
+
+=head3 TAF (Transparent Application Failover)
+
+Transparent Application Failover (TAF) is the feature in OCI that
+allows for clients to automatically reconnect to an instance in the
+event of a failure of the instance. The reconnect happens
+automatically from within the OCI (Oracle Call Interface) library.
+DBD::Oracle now supports a callback function that will fire when a TAF
+event takes place. You may use the callback to inform the
+user a failover is taking place or to setup the session again
+once the failover has succeeded.
+
+You will have to set up TAF on your instance before you can use this
+callback. You can test your instance to see if you can use TAF
+callback with
+
+ $dbh->ora_can_taf();
+
+If you try to set up a callback without it being enabled DBD::Oracle
+will croak.
+
+NOTE: Currently, you must enable TAF during DBI's connect. However
+once enabled you can change the TAF settings.
+
+It is outside the scope of this document to go through all of the
+possible TAF situations you might want to set up but here is a simple
+example:
+
+The TNS entry for the instance has had the following added to the
+CONNECT_DATA section
+
+ (FAILOVER_MODE=
+ (TYPE=select)
+ (METHOD=basic)
+ (RETRIES=10)
+ (DELAY=10))
+
+You will also have to create your own perl function that will be
+called from the client. You can name it anything you want and it will
+always be passed two parameters, the failover event value and the
+failover type. You can also set a sleep value in case of failover
+error and the OCI client will sleep for the specified seconds before it
+attempts another event.
+
+ use DBD::Oracle(qw(:ora_fail_over));
+ #import the ora fail over constants
+
+ #set up TAF on the connection
+ # NOTE since DBD::Oracle uses call_pv you may need to pass a full
+ # name space as the function e.g., 'main::handle_taf'
+ # NOTE from 1.49_00 ora_taf_function can accept a code ref as well
+ # as a sub name as it now uses call_sv
+ my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr',
+ {ora_taf_function => 'main::handle_taf'});
+
+ #create the perl TAF event function
+
+ sub handle_taf {
+ # NOTE from 1.49_00 the $dbh handle was passed to your callback
+ my ($fo_event,$fo_type, $dbh) = @_;
+ if ($fo_event == OCI_FO_BEGIN){
+
+ print " Instance Unavailable Please stand by!! \n";
+ printf(" Your TAF type is %s \n",
+ (($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_ABORT){
+ print " Failover aborted. Failover will not take place.\n";
+ }
+ elsif ($fo_event == OCI_FO_END){
+ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_REAUTH){
+ print " Failed over user. Resuming services\n";
+ }
+ elsif ($fo_event == OCI_FO_ERROR){
+ print " Failover error ...\n";
+ sleep 5; # sleep before having another go
+ return OCI_FO_RETRY;
+ }
+ else {
+ printf(" Bad Failover Event: %d.\n", $fo_event);
+
+ }
+ return 0;
+ }
+
+The TAF types are as follows
+
+ OCI_FO_SESSION indicates the user has requested only session failover.
+ OCI_FO_SELECT indicates the user has requested select failover.
+ OCI_FO_NONE indicates the user has not requested a failover type.
+ OCI_FO_TXNAL indicates the user has requested a transaction failover.
+
+The TAF events are as follows
+
+ OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting.
+ OCI_FO_END indicates successful completion of failover.
+ OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying.
+ OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover.
+ OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter).
+
+=head3 Connect Attributes
+
+=head4 ora_ncs_buff_mtpl
+
+You can customize the size of the buffer when selecting LOBs with
+the built-in AUTO Lob. The default value is 4 which is probably
+excessive for most situations but is needed for backward
+compatibility. If you not converting between a NCS on the DB and the
+Client then you might want to set this to 1 to reduce memory usage.
+
+This value can also be specified with the C<ORA_DBD_NCS_BUFFER>
+environment variable in which case it sets the value at the connect
+stage.
+
+=head4 ora_drcp
+
+For Oracle 11.2 or greater.
+
+Set to I<1> to enable DRCP. Can also be set via the C<ORA_DRCP> environment variable.
+
+=head4 ora_drcp_class
+
+If you are using DRCP, you can set a CONNECTION_CLASS for your pools
+as well. As sessions from a DRCP cannot be shared by users, you can
+use this setting to identify the same user across different
+applications. OCI will ensure that sessions belonging to a 'class' are
+not shared outside the class'.
+
+The values for ora_drcp_class cannot contain a '*' and must be less
+than 1024 characters.
+
+This value can be also be specified with the C<ORA_DRCP_CLASS>
+environment variable.
+
+=head4 ora_drcp_min
+
+This optional value specifies the minimum number of sessions that are
+initially opened. New sessions are only opened after this value has
+been reached.
+
+The default value is 4 and any value above 0 is valid.
+
+Generally, it should be set to the number of concurrent statements the
+application is planning or expecting to run.
+
+This value can also be specified with the C<ORA_DRCP_MIN> environment
+variable.
+
+=head4 ora_drcp_max
+
+This optional value specifies the maximum number of sessions that can
+be open at one time. Once reached no more sessions can be opened
+until one becomes free. The default value is 40 and any value above 1
+is valid. You should not set this value lower than ora_drcp_min as
+that will just waste resources.
+
+This value can also be specified with the C<ORA_DRCP_MAX> environment
+variable.
+
+=head4 ora_drcp_incr
+
+This optional value specifies the next increment for sessions to be
+started if the current number of sessions are less than
+ora_drcp_max. The default value is 2 and any value above 0 is
+valid as long as the value of ora_drcp_min + ora_drcp_incr is not
+greater than ora_drcp_max.
+
+This value can also be specified with the C<ORA_DRCP_INCR> environment
+variable.
+
+=head4 ora_taf
+
+This attribute was removed in 1.49_00 as it was redundant. To
+enable TAF simply set L</ora_taf_function>.
+
+=head4 ora_taf_function
+
+If your Oracle instance has been configured to use TAF events you can
+enable the TAF callback by setting this option.
+
+The name of the Perl subroutine (or a code ref from 1.49_00) that will
+be called from OCI when a TAF event occurs. You must supply a perl
+function to use the callback and it will always receive at least two
+parameters; the failover event value and the failover type. From
+1.49_00 the dbh is passed as the third argument. Below is an example
+of a TAF function
+
+ sub taf_event{
+ # NOTE from 1.49_00 the $dbh handle is passed to the callback
+ my ($event, $type, $dbh) = @_;
+
+ print "My TAF event=$event\n";
+ print "My TAF type=$type\n";
+ return;
+ }
+
+Note if passing a sub name you will probably have to use the full name
+space when setting the TAF function e.g., 'main::my_taf_function' and
+not just 'my_taf_function'.
+
+=head4 ora_taf_sleep
+
+This attribute was removed in 1.49_00 as it was redundant. If you want
+to sleep between retries simple add a sleep to your callback sub.
+
+=head4 ora_session_mode
+
+The ora_session_mode attribute can be used to connect with SYSDBA,
+SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG authorization.
+The ORA_SYSDBA, ORA_SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM
+and ORA_SYSDG constants can be imported using
+
+ use DBD::Oracle qw(:ora_session_modes);
+
+This is one case where setting ORACLE_SID may be useful since
+connecting as SYSDBA or SYSOPER via SQL*Net is frequently disabled
+for security reasons.
+
+Example:
+
+ $dsn = "dbi:Oracle:"; # no dbname here
+ $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed
+ delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set
+
+ $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA });
+
+It has been reported that this only works if C<$dsn> does not contain
+a SID so that Oracle then uses the value of ORACLE_SID (not
+TWO_TASK) environment variable to connect to a local instance. Also
+the username and password should be empty, and the user executing the
+script needs to be part of the dba group or osdba group.
+
+=head4 ora_oratab_orahome
+
+Passing a true value for the ora_oratab_orahome attribute will make
+DBD::Oracle change C<$ENV{ORACLE_HOME}> to make the Oracle home directory
+that specified in the C</etc/oratab> file I<if> the database to connect to
+is specified as a SID that exists in the oratab file, and DBD::Oracle was
+built to use the Oracle 7 OCI API (not Oracle 8+).
+
+=head4 ora_module_name
+
+After connecting to the database the value of this attribute is passed
+to the SET_MODULE() function in the C<DBMS_APPLICATION_INFO> PL/SQL
+package. This can be used to identify the application to the DBA for
+monitoring and performance tuning purposes. For example:
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 });
+
+ $dbh->{ora_module_name} = $y;
+
+The maximum size is 48 bytes.
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+=head4 ora_driver_name
+
+For 11g and later you can now set the name of the driver layer using OCI.
+Perl, Perl5, ApachePerl so on. Names starting with "ORA" are reserved. You
+can enter up to 8 characters. If none is enter then this will default to
+DBDOxxxx where xxxx is the current version number. This value can be
+retrieved on the server side using V$SESSION_CONNECT_INFO or
+GV$SESSION_CONNECT_INFO
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' });
+
+ $dbh->{ora_driver_name} = $q;
+
+=head4 ora_client_info
+
+Allows you to add any value (up to 64 bytes) to your session and it can be
+retrieved on the server side from the C<V$SESSION>a view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' });
+
+ $dbh->{ora_client_info} = "Remote2";
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+=head4 ora_client_identifier
+
+Allows you to specify the user identifier in the session handle.
+
+Most useful for web applications as it can pass in the session user
+name which might be different to the connection user name. Can be up
+to 64 bytes long but do not to include the password for security
+reasons and the first character of the identifier should not be
+':'. This value can be retrieved on the server side using C<V$SESSION>
+view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user });
+
+ $dbh->{ora_client_identifier} = $local_user;
+
+=head4 ora_action
+
+Allows you to specify any string up to 32 bytes which may be retrieved
+on the server side using C<V$SESSION> view.
+
+ my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"});
+
+ $dbh->{ora_action} = "New Long Query 22";
+
+NOTE: You will need an Oracle client 10.1 or later to use this.
+
+=head4 ora_dbh_share
+
+Requires at least Perl 5.8.0 compiled with ithreads.
+
+Allows you to share
+database connections between threads. The first connect will make the
+connection, all following calls to connect with the same ora_dbh_share
+attribute will use the same database connection. The value must be a
+reference to a already shared scalar which is initialized to an empty
+string.
+
+ our $orashr : shared = '' ;
+
+ $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ;
+
+=head4 ora_envhp
+
+The first time a connection is made a new OCI 'environment' is
+created by DBD::Oracle and stored in the driver handle.
+Subsequent connects reuse (share) that same OCI environment
+by default.
+
+The ora_envhp attribute can be used to disable the reuse of the OCI
+environment from a previous connect. If the value is C<0> then
+a new OCI environment is allocated and used for this connection.
+
+The OCI environment holds information about the client side context,
+such as the local NLS environment. By altering C<%ENV> and setting
+ora_envhp to 0 you can create connections with different NLS
+settings. This is most useful for testing.
+
+=head4 ora_charset, ora_ncharset
+
+For oracle versions >= 9.2 you can specify the client charset and
+ncharset with the ora_charset and ora_ncharset attributes. You
+still need to pass C<ora_envhp = 0> for all but the first connect.
+
+These attributes override the settings from environment variables.
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_charset => 'AL32UTF8'});
+
+=head4 ora_verbose
+
+Use this value to enable DBD::Oracle only tracing. Simply either set
+the ora_verbose attribute on the connect() method to the trace level
+you desire like this
+
+ my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6});
+
+or set it directly on the DB handle like this;
+
+ $dbh->{ora_verbose} =6;
+
+In both cases the DBD::Oracle trace level is set to 6, which is the highest
+level tracing most of the calls to OCI.
+
+NOTE: In future versions of DBD::Oracle ora_verbose will be changed so
+that it is simply a switch to turn DBI's DBD tracing on or off. A
+true value will turn it on and a false value will turn it off. DBI's
+"DBD" tracing was not available when ora_verbose was created and
+ora_verbose adds an additional test to every trace test.
+
+=head4 ora_oci_success_warn
+
+Use this value to print otherwise silent OCI warnings that may happen
+when an execute or fetch returns "Success With Info" or when you want
+to tune RowCaching and LOB Reads
+
+ $dbh->{ora_oci_success_warn} = 1;
+
+=head4 ora_objects
+
+Use this value to enable extended embedded oracle objects mode. In extended:
+
+=over 4
+
+=item 1
+
+Embedded objects are returned as <DBD::Oracle::Object> instance (including type-name etc.) instead of simple ARRAY.
+
+=item 2
+
+Determine object type for each instance. All object attributes are returned (not only super-type's attributes).
+
+=back
+
+ $dbh->{ora_objects} = 1;
+
+=head4 ora_ph_type
+
+The default placeholder datatype for the database session.
+The C<TYPE> or L</ora_type> attributes to L<DBI/bind_param> and
+L<DBI/bind_param_inout> override the datatype for individual placeholders.
+The most frequent reason for using this attribute is to permit trailing spaces
+in values passed by placeholders.
+
+Constants for the values allowed for this attribute can be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+Only the following values are permitted for this attribute.
+
+=over 4
+
+=item ORA_VARCHAR2
+
+Oracle clients using OCI 8 will strip trailing spaces and allow embedded \0 bytes.
+Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \0 bytes.
+This is the normal default placeholder type.
+
+=item ORA_STRING
+
+Do not strip trailing spaces and end the string at the first \0.
+
+=item ORA_CHAR
+
+Do not strip trailing spaces and allow embedded \0.
+Force 'blank-padded comparison semantics'.
+
+For example:
+
+ use DBD::Oracle qw(:ora_types);
+
+ $SQL="select username from all_users where username = ?";
+ #username is a char(8)
+ $sth=$dbh->prepare($SQL)";
+ $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR});
+
+Will pad bloggs out to 8 characters and return the username.
+
+=back
+
+=head4 ora_parse_error_offset
+
+If the previous error was from a failed C<prepare> due to a syntax error,
+this attribute gives the offset into the C<Statement> attribute where the
+error was found.
+
+=head4 ora_array_chunk_size
+
+Due to OCI limitations, DBD::Oracle needs to buffer up rows of
+bind values in its C<execute_for_fetch> implementation. This attribute
+sets the number of rows to buffer at a time (default value is 1000).
+
+The C<execute_for_fetch> function will collect (at most) this many
+rows in an array, send them off to the DB for execution, then go back
+to collect the next chunk of rows and so on. This attribute can be
+used to limit or extend the number of rows processed at a time.
+
+Note that this attribute also applies to C<execute_array>, since that
+method is implemented using C<execute_for_fetch>.
+
+=head4 ora_connect_with_default_signals
+
+Sometimes the Oracle client seems to change some of the signal
+handlers of the process during the connect phase. For instance, some
+users have observed Perl's default C<$SIG{INT}> handler being ignored
+after connecting to an Oracle database. If this causes problems in
+your application, set this attribute to an array reference of signals
+you would like to be localized during the connect process. Once the
+connect is complete, the signal handlers should be returned to their
+previous state.
+
+For example:
+
+ $dbh = DBI->connect ($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => [ 'INT' ] });
+
+NOTE disabling the signal handlers the OCI library sets up may affect
+functionality in the OCI library.
+
+NOTE If you are using connect_cached then the above example will lead
+to DBI thinking each connection is different as an anonymous array reference
+is being used. To avoid this when using connect_cached you are advised
+to use:
+
+ my @ora_default_signals = (...);
+ $dbh = DBI->connect($dsn, $user, $passwd,
+ {ora_connect_with_default_signals => \@ora_default_signals});
+
+In more recent Perl versions you could possibly make use of new state
+variables.
+
+=head2 B<connect_cached>
+
+Implemented by DBI, no driver-specific impact.
+Please note that connect_cached as not been tested with DRCP.
+
+=head2 B<data_sources>
+
+ @data_sources = DBI->data_sources('Oracle');
+ @data_sources = $dbh->data_sources();
+
+Returns a list of available databases. You will have to set either the 'ORACLE_HOME' or
+'TNS_ADMIN' environment value to retrieve this list. It will read these values from
+TNSNAMES.ORA file entries.
+
+=head1 METHODS COMMON TO ALL HANDLES
+
+For all of the methods below, B<$h> can be either a database handle (B<$dbh>)
+or a statement handle (B<$sth>). Note that I<$dbh> and I<$sth> can be replaced with
+any variable name you choose: these are just the names most often used. Another
+common variable used in this documentation is $I<rv>, which stands for "return value".
+
+=head2 B<err>
+
+ $rv = $h->err;
+
+Returns the error code from the last method called.
+
+=head2 B<errstr>
+
+ $str = $h->errstr;
+
+Returns the last error that was reported by Oracle. Starting with "ORA-00000" code followed by the error message.
+
+=head2 B<state>
+
+ $str = $h->state;
+
+Oracle hasn't supported SQLSTATE since the early versions OCI. It will return empty when the command succeeds and
+'S1000' (General Error) for all other errors.
+
+While this method can be called as either C<< $sth->state >> or C<< $dbh->state >>, it
+is usually clearer to always use C<< $dbh->state >>.
+
+=head2 B<trace>
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<trace_msg>
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<parse_trace_flag> and B<parse_trace_flags>
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<func>
+
+DBD::Oracle uses the C<func> method to support a variety of functions.
+
+=head2 B<Private database handle functions>
+
+Some of these functions are called through the method func()
+which is described in the DBI documentation. Any function that begins with ora_
+can be called directly.
+
+=head2 B<plsql_errstr>
+
+This function returns a string which describes the errors
+from the most recent PL/SQL function, procedure, package,
+or package body compile in a format similar to the output
+of the SQL*Plus command 'show errors'.
+
+The function returns undef if the error string could not
+be retrieved due to a database error.
+Look in $dbh->errstr for the cause of the failure.
+
+If there are no compile errors, an empty string is returned.
+
+Example:
+
+ # Show the errors if CREATE PROCEDURE fails
+ $dbh->{RaiseError} = 0;
+ if ( $dbh->do( q{
+ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as
+ BEGIN
+ PROCEDURE filltab( stuff OUT TAB ); asdf
+ END; } ) ) {} # Statement succeeded
+ }
+ elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure
+ else {
+ my $msg = $dbh->func( 'plsql_errstr' );
+ die $dbh->errstr if ! defined $msg;
+ die $msg if $msg;
+ }
+
+=head2 B<dbms_output_enable / dbms_output_put / dbms_output_get>
+
+These functions use the PL/SQL DBMS_OUTPUT package to store and
+retrieve text using the DBMS_OUTPUT buffer. Text stored in this buffer
+by dbms_output_put or any PL/SQL block can be retrieved by
+dbms_output_get or any PL/SQL block connected to the same database
+session.
+
+Stored text is not available until after dbms_output_put or the PL/SQL
+block that saved it completes its execution. This means you B<CAN NOT>
+use these functions to monitor long running PL/SQL procedures.
+
+Example 1:
+
+ # Enable DBMS_OUTPUT and set the buffer size
+ $dbh->{RaiseError} = 1;
+ $dbh->func( 1000000, 'dbms_output_enable' );
+
+ # Put text in the buffer . . .
+ $dbh->func( @text, 'dbms_output_put' );
+
+ # . . . and retrieve it later
+ @text = $dbh->func( 'dbms_output_get' );
+
+Example 2:
+
+ $dbh->{RaiseError} = 1;
+ $sth = $dbh->prepare(q{
+ DECLARE tmp VARCHAR2(50);
+ BEGIN
+ SELECT SYSDATE INTO tmp FROM DUAL;
+ dbms_output.put_line('The date is '||tmp);
+ END;
+ });
+ $sth->execute;
+
+ # retrieve the string
+ $date_string = $dbh->func( 'dbms_output_get' );
+
+=head2 B<dbms_output_enable ( [ buffer_size ] )>
+
+This function calls DBMS_OUTPUT.ENABLE to enable calls to package
+DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to
+these procedures are ignored unless DBMS_OUTPUT.ENABLE is called
+first.
+
+The buffer_size is the maximum amount of text that can be saved in the
+buffer and must be between 2000 and 1,000,000. If buffer_size is not
+given, the default is 20,000 bytes.
+
+=head2 B<dbms_output_put ( [ @lines ] )>
+
+This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer.
+
+If all lines were saved successfully the function returns 1. Depending
+on the context, an empty list or undef is returned for failure.
+
+If any line causes buffer_size to be exceeded, a buffer overflow error
+is raised and the function call fails. Some of the text might be in
+the buffer.
+
+=head2 B<dbms_output_get>
+
+This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from
+the buffer.
+
+In an array context, all complete lines are removed from the buffer and
+returned as a list. If there are no complete lines, an empty list is
+returned.
+
+In a scalar context, the first complete line is removed from the buffer
+and returned. If there are no complete lines, undef is returned.
+
+Any text in the buffer after a call to DBMS_OUTPUT.GET_LINE or
+DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE,
+DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE.
+
+=head2 B<reauthenticate ( $username, $password )>
+
+Starts a new session against the current database using the credentials
+supplied.
+
+=head2 B<private_attribute_info>
+
+ $hashref = $dbh->private_attribute_info();
+ $hashref = $sth->private_attribute_info();
+
+Returns a hash of all private attributes used by DBD::Oracle, for either
+a database or a statement handle. Currently, all the hash values are undef.
+
+=head1 ATTRIBUTES COMMON TO ALL HANDLES
+
+=head2 B<InactiveDestroy> (boolean)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<RaiseError> (boolean, inherited)
+
+Forces errors to always raise an exception. Although it defaults to off, it is recommended that this
+be turned on, as the alternative is to check the return value of every method (prepare, execute, fetch, etc.)
+manually, which is easy to forget to do.
+
+=head2 B<PrintError> (boolean, inherited)
+
+Forces database errors to also generate warnings, which can then be filtered with methods such as
+locally redefining I<$SIG{__WARN__}> or using modules such as C<CGI::Carp>. This attribute is on
+by default.
+
+=head2 B<ShowErrorStatement> (boolean, inherited)
+
+Appends information about the current statement to error messages. If placeholder information
+is available, adds that as well. Defaults to true.
+
+=head2 B<Warn> (boolean, inherited)
+
+Enables warnings. This is on by default, and should only be turned off in a local block
+for a short a time only when absolutely needed.
+
+=head2 B<Executed> (boolean, read-only)
+
+Indicates if a handle has been executed. For database handles, this value is true after the L</do> method has been called, or
+when one of the child statement handles has issued an L</execute>. Issuing a L</commit> or L</rollback> always resets the
+attribute to false for database handles. For statement handles, any call to L</execute> or its variants will flip the value to
+true for the lifetime of the statement handle.
+
+=head2 B<TraceLevel> (integer, inherited)
+
+Sets the trace level, similar to the L</trace> method. See the sections on
+L</trace> and L</parse_trace_flag> for more details.
+
+=head2 B<Active> (boolean, read-only)
+
+Indicates if a handle is active or not. For database handles, this indicates if the database has
+been disconnected or not. For statement handles, it indicates if all the data has been fetched yet
+or not. Use of this attribute is not encouraged.
+
+=head2 B<Kids> (integer, read-only)
+
+Returns the number of child processes created for each handle type. For a driver handle, indicates the number
+of database handles created. For a database handle, indicates the number of statement handles created. For
+statement handles, it always returns zero, because statement handles do not create kids.
+
+=head2 B<ActiveKids> (integer, read-only)
+
+Same as C<Kids>, but only returns those that are active.
+
+=head2 B<CachedKids> (hash ref)
+
+Returns a hashref of handles. If called on a database handle, returns all statement handles created by use of the
+C<prepare_cached> method. If called on a driver handle, returns all database handles created by the L</connect_cached>
+method.
+
+=head2 B<ChildHandles> (array ref)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<PrintWarn> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<HandleError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<HandleSetErr> (code ref, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<ErrCount> (unsigned integer)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<FetchHashKeyName> (string, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<ChopBlanks> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<Taint> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<TaintIn> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<TaintOut> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<Profile> (inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<Type> (scalar)
+
+Returns C<dr> for a driver handle, C<db> for a database handle, and C<st> for a statement handle.
+Should be rarely needed.
+
+=head2 B<LongReadLen>
+
+The maximum size of long or longraw columns to retrieve. If one of
+these columns is longer than LongReadLen then either a data truncation
+error will be raised (LongTrunkOk is false) or the column will be
+silently truncated (LongTruncOk is true).
+
+DBI currently defaults this to 80.
+
+=head2 B<LongTruncOk>
+
+Implemented by DBI, no driver-specific impact.
+
+=head2 B<CompatMode>
+
+Type: boolean, inherited
+
+The 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.
+
+=head1 ORACLE-SPECIFIC DATABASE HANDLE METHODS
+
+=head2 B<ora_can_unicode ( [ $refresh ] )>
+
+Returns a number indicating whether either of the database character sets
+is a Unicode encoding. Calls ora_nls_parameters() and passes the optional
+$refresh parameter to it.
+
+0 = Neither character set is a Unicode encoding.
+
+1 = National character set is a Unicode encoding.
+
+2 = Database character set is a Unicode encoding.
+
+3 = Both character sets are Unicode encodings.
+
+=head2 B<ora_can_taf>
+
+Returns true if the current connection supports TAF events. False if otherwise.
+
+=head2 B<ora_nls_parameters ( [ $refresh ] )>
+
+Returns a hash reference containing the current NLS parameters, as given
+by the v$nls_parameters view. The values fetched are cached between calls.
+To cause the latest values to be fetched, pass a true value to the function.
+
+=head1 ORACLE-SPECIFIC DATABASE FUNCTIONS
+
+=head2 B<ora_server_version>
+
+ $versions = $dbh->func('ora_server_version');
+
+Returns an array reference of server version strings e.g.,
+
+ [11,2,0,2,0]
+
+=head1 DATABASE HANDLE METHODS
+
+=head2 B<selectall_arrayref>
+
+ $ary_ref = $dbh->selectall_arrayref($sql);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr);
+ $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values);
+
+Returns a reference to an array containing the rows returned by preparing and executing the SQL string.
+See the DBI documentation for full details.
+
+=head2 B<selectall_hashref>
+
+ $hash_ref = $dbh->selectall_hashref($sql, $key_field);
+
+Returns a reference to a hash containing the rows returned by preparing and executing the SQL string.
+See the DBI documentation for full details.
+
+=head2 B<selectcol_arrayref>
+
+ $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values);
+
+Returns a reference to an array containing the first column
+from each rows returned by preparing and executing the SQL string. It is possible to specify exactly
+which columns to return. See the DBI documentation for full details.
+
+=head2 B<prepare>
+
+ $sth = $dbh->prepare($statement, \%attr);
+
+Prepares a statement for later execution by the database engine and returns a reference to a statement handle object.
+
+=head3 B<Prepare Attributes>
+
+These attributes may be used in the C<\%attr> parameter of the
+L<DBI/prepare> database handle method.
+
+=over 4
+
+=item ora_placeholders
+
+Set to false to disable processing of placeholders. Used mainly for loading a
+PL/SQL package that has been I<wrapped> with Oracle's C<wrap> utility.
+
+=item ora_auto_lob
+
+If true (the default), fetching retrieves the contents of the CLOB or
+BLOB column in most circumstances. If false, fetching retrieves the
+Oracle "LOB Locator" of the CLOB or BLOB value.
+
+See L</LOBS AND LONGS> for more details.
+
+See also the LOB tests in 05dbi.t of Oracle::OCI for examples
+of how to use LOB Locators.
+
+=item ora_pers_lob
+
+If true the L</Simple Fetch for CLOBs and BLOBs> method for the L</Data Interface for Persistent LOBs> will be
+used for LOBs rather than the default method L</Data Interface for LOB Locators>.
+
+=item ora_clbk_lob
+
+If true the L</Piecewise Fetch with Callback> method for the L</Data
+Interface for Persistent LOBs> will be used for LOBs.
+
+=item ora_piece_lob
+
+If true the L</Piecewise Fetch with Polling> method for the L</Data
+Interface for Persistent LOBs> will be used for LOBs.
+
+=item ora_piece_size
+
+This is the max piece size for the L</Piecewise Fetch with Callback>
+and L</Piecewise Fetch with Polling> methods, in chars for CLOBS, and
+bytes for BLOBS.
+
+=item ora_check_sql
+
+If 1 (default), force SELECT statements to be described in prepare().
+If 0, allow SELECT statements to defer describe until execute().
+
+See L</Prepare Postponed Till Execute> for more information.
+
+=item ora_exe_mode
+
+This will set the execute mode of the current statement. Presently
+only one mode is supported;
+
+ OCI_STMT_SCROLLABLE_READONLY - make result set scrollable
+
+See L</SCROLLABLE CURSORS> for more details.
+
+=item ora_prefetch_rows
+
+Sets the number of rows to be prefetched. If it is not set, then the
+default value is 1. See L</Row Prefetching> for more details.
+
+=item ora_prefetch_memory
+
+Sets the memory level for rows to be prefetched. The application then
+fetches as many rows as will fit into that much memory. See L</Row
+Prefetching> for more details.
+
+=item ora_row_cache_off
+
+By default DBD::Oracle will use a row cache when fetching to cut down
+the number of round trips to the server. If you do not want to use an
+array fetch set this value to any value other than 0;
+
+See L</Row Prefetching> for more details.
+
+=back
+
+=head3 B<Placeholders>
+
+There are three types of placeholders that can be used in
+DBD::Oracle.
+
+The first is the "question mark" type, in which each placeholder is
+represented by a single question mark character. This is the method
+recommended by the DBI and is the most portable. Each question
+mark is internally replaced by a "dollar sign number" in the order in
+which they appear in the query (important when using L</bind_param>).
+
+The second type of placeholder is "named parameters" in the format
+":foo" which is the one Oracle prefers.
+
+ $dbh->{RaiseError} = 1; # save having to check each method call
+ $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name");
+ $sth->bind_param(':name', "John%");
+ $sth->execute;
+ DBI::dump_results($sth);
+
+Note when calling bind_param with named parameters you must include
+the leading colon. The advantage of this placeholder type is that you
+can use the same placeholder more than once in the same SQL statement
+but you only need to bind it once.
+
+The last placeholder type is a variation of the two above where you
+name each placeholder :N (where N is a number). Like the named
+placeholders above you can use the same placeholder multiple times in
+the SQL but when you call bind_param you only need to pass the N
+(e.g., for :1 you use bind_param(1,...) and not bind_param(':1',...).
+
+The different types of placeholders cannot be mixed within a statement, but you may
+use different ones for each statement handle you have. This is confusing at best, so
+stick to one style within your program.
+
+=head2 B<prepare_cached>
+
+ $sth = $dbh->prepare_cached($statement, \%attr);
+
+Implemented by DBI, no driver-specific impact. This method is most useful
+if the same query is used over and over as it will cut down round trips to the server.
+
+=head2 B<do>
+
+ $rv = $dbh->do($statement);
+ $rv = $dbh->do($statement, \%attr);
+ $rv = $dbh->do($statement, \%attr, @bind_values);
+
+Prepare and execute a single statement. Returns the number of rows affected if the
+query was successful, returns undef if an error occurred, and returns -1 if the
+number of rows is unknown or not available. Note that this method will return B<0E0> instead
+of 0 for 'no rows were affected', in order to always return a true value if no error occurred.
+
+=head2 B<last_insert_id>
+
+Oracle does not implement auto_increment of serial type columns it uses predefined
+sequences where the id numbers are either selected before insert, at insert time with a trigger,
+ or as part of the query.
+
+Below is an example of you to use the latter with the SQL returning clause to get the ID number back
+on insert with the bind_param_inout method.
+.
+
+ $dbh->do('CREATE SEQUENCE lii_seq START 1');
+ $dbh->do(q{CREATE TABLE lii (
+ foobar INTEGER NOT NULL UNIQUE,
+ baz VARCHAR)});
+ $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";";
+ $sth = $dbh->prepare($SQL);
+ my $p_new_id='-1';
+ $sth->bind_param_inout(":p_new_id",\$p_new_id,38);
+ $sth->execute();
+ $db->commit();
+
+=head2 B<commit>
+
+ $rv = $dbh->commit;
+
+Issues a COMMIT to the server, indicating that the current transaction is finished and that
+all changes made will be visible to other processes. If AutoCommit is enabled, then
+a warning is given and no COMMIT is issued. Returns true on success, false on error.
+
+=head2 B<rollback>
+
+ $rv = $dbh->rollback;
+
+Issues a ROLLBACK to the server, which discards any changes made in the current transaction. If AutoCommit
+is enabled, then a warning is given and no ROLLBACK is issued. Returns true on success, and
+false on error.
+
+=head2 B<begin_work>
+
+This method turns on transactions until the next call to L</commit> or L</rollback>, if L</AutoCommit> is
+currently enabled. If it is not enabled, calling begin_work will issue an error. Note that the
+transaction will not actually begin until the first statement after begin_work is called.
+
+=head2 B<disconnect>
+
+ $rv = $dbh->disconnect;
+
+Disconnects from the Oracle database. Any uncommitted changes will be rolled back upon disconnection. It's
+good policy to always explicitly call commit or rollback at some point before disconnecting, rather than
+relying on the default rollback behavior.
+
+If the script exits before disconnect is called (or, more precisely, if the database handle is no longer
+referenced by anything), then the database handle's DESTROY method will call the rollback() and disconnect()
+methods automatically. It is best to explicitly disconnect rather than rely on this behavior.
+
+=head2 B<ping>
+
+ $rv = $dbh->ping;
+
+This C<ping> method is used to check the validity of a database handle. The value returned is
+either 0, indicating that the connection is no longer valid, or 1, indicating the connection is valid.
+This function does 1 round trip to the Oracle Server.
+
+=head2 B<get_info()>
+
+ $value = $dbh->get_info($info_type);
+
+DBD::Oracle supports C<get_info()>, but (currently) only a few info types.
+
+=head2 B<table_info()>
+
+DBD::Oracle supports attributes for C<table_info()>.
+
+In Oracle, the concept of I<user> and I<schema> is (currently) the
+same. Because database objects are owned by an user, the owner names
+in the data dictionary views correspond to schema names.
+Oracle does not support catalogues so TABLE_CAT is ignored as
+selection criterion.
+
+Search patterns are supported for TABLE_SCHEM and TABLE_NAME.
+
+TABLE_TYPE may contain a comma-separated list of table types.
+The following table types are supported:
+
+ TABLE
+ VIEW
+ SYNONYM
+ SEQUENCE
+
+The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME.
+
+The special enumerations of catalogues, schemas and table types are
+supported. However, TABLE_CAT is always NULL.
+
+An identifier is passed I<as is>, i.e. as the user provides or
+Oracle returns it.
+C<table_info()> performs a case-sensitive search. So, a selection
+criterion should respect upper and lower case.
+Normally, an identifier is case-insensitive. Oracle stores and
+returns it in upper case. Sometimes, database objects are created
+with quoted identifiers (for reserved words, mixed case, special
+characters, ...). Such an identifier is case-sensitive (if not all
+upper case). Oracle stores and returns it as given.
+C<table_info()> has no special quote handling, neither adds nor
+removes quotes.
+
+=head2 B<primary_key_info()>
+
+Oracle does not support catalogues so TABLE_CAT is ignored as
+selection criterion.
+The TABLE_CAT field of a fetched row is always NULL (undef).
+See L</table_info()> for more detailed information.
+
+If the primary key constraint was created without an identifier,
+PK_NAME contains a system generated name with the form SYS_Cn.
+
+The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ.
+
+An identifier is passed I<as is>, i.e. as the user provides or
+Oracle returns it.
+See L</table_info()> for more detailed information.
+
+=head2 B<foreign_key_info()>
+
+This method (currently) supports the extended behaviour of SQL/CLI, i.e. the
+result set contains foreign keys that refer to primary B<and> alternate keys.
+The field UNIQUE_OR_PRIMARY distinguishes these keys.
+
+Oracle does not support catalogues, so C<$pk_catalog> and C<$fk_catalog> are
+ignored as selection criteria (in the new style interface).
+The UK_TABLE_CAT and FK_TABLE_CAT fields of a fetched row are always
+NULL (undef).
+See L</table_info()> for more detailed information.
+
+If the primary or foreign key constraints were created without an identifier,
+UK_NAME or FK_NAME contains a system generated name with the form SYS_Cn.
+
+The UPDATE_RULE field is always 3 ('NO ACTION'), because Oracle (currently)
+does not support other actions.
+
+The DELETE_RULE field may contain wrong values. This is a known Bug (#1271663)
+in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and
+'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other
+actions (incl. 'SET NULL') appear as 'NO ACTION'.
+
+The DEFERABILITY field is always NULL, because this columns is
+not present in the ALL_CONSTRAINTS view of older Oracle releases.
+
+The result set is ordered by UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM,
+FK_TABLE_NAME, ORDINAL_POSITION.
+
+An identifier is passed I<as is>, i.e. as the user provides or
+Oracle returns it.
+See L</table_info()> for more detailed information.
+
+=head2 B<column_info()>
+
+Oracle does not support catalogues so TABLE_CAT is ignored as
+selection criterion.
+The TABLE_CAT field of a fetched row is always NULL (undef).
+See L</table_info()> for more detailed information.
+
+The CHAR_OCTET_LENGTH field is (currently) always NULL (undef).
+
+Don't rely on the values of the BUFFER_LENGTH field!
+Especially the length of FLOATs may be wrong.
+
+Datatype codes for non-standard types are subject to change.
+
+Attention! The DATA_DEFAULT (COLUMN_DEF) column is of type LONG so you
+may have to set LongReadLen on the connection handle before calling
+column_info if you have a large default column. After DBD::Oracle 1.40
+LongReadLen is set automatically to 1Mb when calling column_info and
+reset aftwerwards.
+
+The result set is ordered by TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION.
+
+An identifier is passed I<as is>, i.e. as the user provides or
+Oracle returns it.
+See L</table_info()> for more detailed information.
+
+It is possible with Oracle to make the names of the various DB objects (table,column,index etc)
+case sensitive.
+
+ alter table bloggind add ("Bla_BLA" NUMBER)
+
+So in the example the exact case "Bla_BLA" must be used to get it info on the column. While this
+
+ alter table bloggind add (Bla_BLA NUMBER)
+
+any case can be used to get info on the column.
+
+=head2 B<statistics_info()>
+
+Oracle does not support catalogues so TABLE_CAT is ignored as
+selection criterion.
+The TABLE_CAT field of a fetched row is always NULL (undef).
+See L</table_info()> for more detailed information.
+
+The INDEX_QUALIFIER field of a fetched row is always NULL (undef),
+for the same reason as for TABLE_CAT.
+
+If an index was created without an identifier
+(e.g. in the course of a PK creation),
+INDEX_NAME contains a system generated name with the form SYS_.
+
+COLUMN_NAME may contain a system generated name
+(e.g. for function-based indexes).
+
+For the TYPE column, a simple mapping is used:
+
+ NORMAL btree
+ CLUSTER clustered
+ ... other
+
+The C<$quick> parameter is currently ignored.
+The method uses the dictionary with the gathered statistics,
+thus cannot ensure that the values for CARDINALITY and PAGES are current.
+
+The result set is ordered by
+NON_UNIQUE, TYPE, INDEX_QUALIFIER, INDEX_NAME, ORDINAL_POSITION.
+
+An identifier is passed I<as is>, i.e. as the user provides or
+Oracle returns it.
+See L</table_info()> for more detailed information.
+
+=head2 B<selectrow_array>
+
+ @row_ary = $dbh->selectrow_array($sql);
+ @row_ary = $dbh->selectrow_array($sql, \%attr);
+ @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values);
+
+Returns an array of row information after preparing and executing the provided SQL string. The rows are returned
+by calling L</fetchrow_array>. The string can also be a statement handle generated by a previous prepare. Note that
+only the first row of data is returned. If called in a scalar context, only the first column of the first row is
+returned. Because this is not portable, it is not recommended that you use this method in that way.
+
+=head2 B<selectrow_arrayref>
+
+ $ary_ref = $dbh->selectrow_arrayref($statement);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
+
+Exactly the same as L</selectrow_array>, except that it returns a reference to an array, by internal use of
+the L</fetchrow_arrayref> method.
+
+=head2 B<selectrow_hashref>
+
+ $hash_ref = $dbh->selectrow_hashref($sql);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr);
+ $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values);
+
+Exactly the same as L</selectrow_array>, except that it returns a reference to an hash, by internal use of
+the L</fetchrow_hashref> method.
+
+=head2 B<clone>
+
+ $other_dbh = $dbh->clone();
+
+Creates a copy of the database handle by connecting with the same parameters as the original
+handle, then trying to merge the attributes. See the DBI documentation for complete usage.
+
+=head1 DATABASE HANDLE ATTRIBUTES
+
+=head2 B<AutoCommit> (boolean)
+
+Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is on, but this may change
+in the future, so it is highly recommended that you explicitly set it when
+calling L</connect>.
+
+=head2 B<ReadOnly> (boolean)
+
+ $dbh->{ReadOnly} = 1;
+
+Specifies if the current database connection should be in read-only mode or not.
+
+Please not that this method is not foolproof: there are still ways to update the
+database. Consider this a safety net to catch applications that should not be
+issuing commands such as INSERT, UPDATE, or DELETE.
+
+This method method requires DBI version 1.55 or better.
+
+=head2 B<Name> (string, read-only)
+
+Returns the name of the current database. This is the same as the DSN, without the
+"dbi:Oracle:" part.
+
+=head2 B<Username> (string, read-only)
+
+Returns the name of the user connected to the database.
+
+=head2 B<Driver> (handle, read-only)
+
+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}
+
+=head2 B<RowCacheSize>
+
+DBD::Oracle supports both Server pre-fetch and Client side row caching. By default both
+are turned on to give optimum performance. Most of the time one can just let DBD::Oracle
+figure out the best optimization.
+
+=head3 B<Row Caching>
+
+Row caching occurs on the client side and the object of it is to cut down the number of round
+trips made to the server when fetching rows. At each fetch a set number of rows will be retrieved
+from the server and stored locally. Further calls the server are made only when the end of the
+local buffer(cache) is reached.
+
+Rows up to the specified top level row
+count C<RowCacheSize> are fetched if it occupies no more than the specified memory usage limit.
+The default value is 0, which means that memory size is not included in computing the number of rows to prefetch. If
+the C<RowCacheSize> value is set to a negative number then the positive value of RowCacheSize is used
+to compute the number of rows to prefetch.
+
+By default C<RowCacheSize> is automatically set. If you want to totally turn off prefetching set this to 1.
+
+For any SQL statement that contains a LOB, Long or Object Type Row Caching will be turned off. However server side
+caching still works. If you are only selecting a LOB Locator then Row Caching will still work.
+
+=head3 Row Prefetching
+
+Row prefetching occurs on the server side and uses the DBI database handle attribute C<RowCacheSize> and or the
+Prepare Attribute 'ora_prefetch_memory'. Tweaking these values may yield improved performance.
+
+ $dbh->{RowCacheSize} = 100;
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000});
+
+In the above example 10 rows will be prefetched up to a maximum of 10000 bytes of data. The Oracle Call Interface Programmer's Guide,
+suggests a good row cache value for a scrollable cursor is about 20% of expected size of the record set.
+
+The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes) when it needs to get new rows. This happens on the first
+fetch that sets the current_positon to any value other than 0. In the above example if we do a OCI_FETCH_FIRST the first 10 rows are
+loaded into the buffer and DBD::Oracle will not have to go back to the server for more rows. When record 11 is fetched DBD::Oracle
+fetches and returns this row and the next 9 rows are loaded into the buffer. In this case if you fetch backwards from 10 to 1
+no server round trips are made.
+
+With large record sets it is best not to attempt to go to the last record as this may take some time, A large buffer size might even slow down
+the fetch. If you must get the number of rows in a large record set you might try using an few large OCI_FETCH_ABSOLUTEs and then an OCI_FETCH_LAST,
+this might save some time. So if you had a record set of 10000 rows and you set the buffer to 5000 and did a OCI_FETCH_LAST one would fetch the first 5000 rows into the buffer then the next 5000 rows.
+If one requires only the first few rows there is no need to set a large prefetch value.
+
+If the ora_prefetch_memory less than 1 or not present then memory size is not included in computing the
+number of rows to prefetch otherwise the number of rows will be limited to memory size. Likewise if the RowCacheSize is less than 1 it
+is not included in the computing of the prefetch rows.
+
+=head1 ORACLE-SPECIFIC STATEMENT HANDLE METHODS
+
+=head2 B<ora_stmt_type>
+
+Returns the OCI Statement Type number for the SQL of a statement handle.
+
+=head2 B<ora_stmt_type_name>
+
+Returns the OCI Statement Type name for the SQL of a statement handle.
+
+=head1 DBI STATEMENT HANDLE OBJECT METHODS
+
+=head2 B<bind_param>
+
+ $rv = $sth->bind_param($param_num, $bind_value);
+ $rv = $sth->bind_param($param_num, $bind_value, $bind_type);
+ $rv = $sth->bind_param($param_num, $bind_value, \%attr);
+
+Allows the user to bind a value and/or a data type to a placeholder.
+
+The value of C<$param_num> is a number if using the '?' or if using ":foo" style placeholders, the complete name
+(e.g. ":foo") must be given.
+The C<$bind_value> argument is fairly self-explanatory. A value of C<undef> will
+bind a C<NULL> to the placeholder. Using C<undef> is useful when you want
+to change just the type and will be overwriting the value later.
+(Any value is actually usable, but C<undef> is easy and efficient).
+
+The C<\%attr> hash is used to indicate the data type of the placeholder.
+The default value is "varchar". If you need something else, you must
+use one of the values provided by DBI or by DBD::Pg. To use a SQL value,
+modify your "use DBI" statement at the top of your script as follows:
+
+ use DBI qw(:sql_types);
+
+This will import some constants into your script. You can plug those
+directly into the L</bind_param> call. Some common ones that you will
+encounter are:
+
+ SQL_INTEGER
+
+To use Oracle SQL data types, import the list of values like this:
+
+ use DBD::Pg qw(:ora_types);
+
+You can then set the data types by setting the value of the C<ora_type>
+key in the hash passed to L</bind_param>.
+The current list of Oracle data types exported is:
+
+ ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW
+ ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB
+ ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI
+ SQLT_CHR SQLT_BIN
+
+Data types are "sticky," in that once a data type is set to a certain placeholder,
+it will remain for that placeholder, unless it is explicitly set to something
+else afterwards. If the statement has already been prepared, and you switch the
+data type to something else, DBD::Oracle will re-prepare the statement for you before
+doing the next execute.
+
+Examples:
+
+ use DBI qw(:sql_types);
+ use DBD::Pg qw(:ora_types);
+
+ $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?";
+ $sth = $dbh->prepare($SQL);
+
+ ## Both arguments below are bound to placeholders as "varchar"
+ $sth->execute(123, "Merk");
+
+ ## Reset the datatype for the first placeholder to an integer
+ $sth->bind_param(1, undef, SQL_INTEGER);
+
+ ## The "undef" bound above is not used, since we supply params to execute
+ $sth->execute(123, "Merk");
+
+ ## Set the first placeholder's value and data type
+ $sth->bind_param(1, 234, { pg_type => ORA_NUMBER });
+
+ ## Set the second placeholder's value and data type.
+ ## We don't send a third argument, so the default "varchar" is used
+ $sth->bind_param('$2', "Zool");
+
+ ## We realize that the wrong data type was set above, so we change it:
+ $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER });
+
+ ## We also got the wrong value, so we change that as well.
+ ## Because the data type is sticky, we don't need to change it
+ $sth->bind_param(1, 567);
+
+ ## This executes the statement with 567 (integer) and "Zool" (varchar)
+ $sth->execute();
+
+These attributes may be used in the C<\%attr> parameter of the
+L<DBI/bind_param> or L<DBI/bind_param_inout> statement handle methods.
+
+=over 4
+
+=item ora_type
+
+Specify the placeholder's datatype using an Oracle datatype.
+A fatal error is raised if C<ora_type> and the DBI C<TYPE> attribute
+are used for the same placeholder.
+Some of these types are not supported by the current version of
+DBD::Oracle and will cause a fatal error if used.
+Constants for the Oracle datatypes may be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+Potentially useful values when DBD::Oracle was built using OCI 7 and later:
+
+ ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW,
+ ORA_CHAR, ORA_MLSLABEL, ORA_RSET
+
+Additional values when DBD::Oracle was built using OCI 8 and later:
+
+ ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE
+
+Additional values when DBD::Oracle was built using OCI 9.2 and later:
+
+ SQLT_CHR, SQLT_BIN
+
+See L</Binding Cursors> for the correct way to use ORA_RSET.
+
+See L</LOBS AND LONGS> for how to use ORA_CLOB and ORA_BLOB.
+
+See L</SYS.DBMS_SQL datatypes> for ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE.
+
+See L</Data Interface for Persistent LOBs> for the correct way to use SQLT_CHR and SQLT_BIN.
+
+See L</OTHER DATA TYPES> for more information.
+
+See also L<DBI/Placeholders and Bind Values>.
+
+=item ora_csform
+
+Specify the OCI_ATTR_CHARSET_FORM for the bind value. Valid values
+are SQLCS_IMPLICIT (1) and SQLCS_NCHAR (2). Both those constants can
+be imported from the DBD::Oracle module. Rarely needed.
+
+=item ora_csid
+
+Specify the I<integer> OCI_ATTR_CHARSET_ID for the bind value.
+Character set names can't be used currently.
+
+=item ora_maxdata_size
+
+Specify the integer OCI_ATTR_MAXDATA_SIZE for the bind value.
+May be needed if a character set conversion from client to server
+causes the data to use more space and so fail with a truncation error.
+
+=item ora_maxarray_numentries
+
+Specify the maximum number of array entries to allocate. Used with
+ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. Define the maximum number of
+array entries Oracle can pass back to you in OUT variable of type
+TABLE OF ... .
+
+=item ora_internal_type
+
+Specify internal data representation. Currently is supported only for
+ORA_NUMBER_TABLE.
+
+=back
+
+=head3 Optimizing Results
+
+=head4 Prepare Postponed Till Execute
+
+The DBD::Oracle module can avoid an explicit 'describe' operation
+prior to the execution of the statement unless the application requests
+information about the results (such as $sth->{NAME}). This reduces
+communication with the server and increases performance (reducing the
+number of PARSE_CALLS inside the server).
+
+However, it also means that SQL errors are not detected until
+C<execute()> (or $sth->{NAME} etc) is called instead of when
+C<prepare()> is called. Note that if the describe is triggered by the
+use of $sth->{NAME} or a similar attribute and the describe fails then
+I<an exception is thrown> even if C<RaiseError> is false!
+
+Set L</ora_check_sql> to 0 in prepare() to enable this behaviour.
+
+=head2 B<bind_param_inout>
+
+ $rv = $sth->bind_param_inout($param_num, \$scalar, 0);
+
+DBD::Oracle fully supports bind_param_inout below are some uses for this method.
+
+=head3 B<Returning A Value from an INSERT>
+
+Oracle supports an extended SQL insert syntax which will return one
+or more of the values inserted. This can be particularly useful for
+single-pass insertion of values with re-used sequence values
+(avoiding a separate "select seq.nextval from dual" step).
+
+ $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, :bar)
+ RETURNING id INTO :id
+ });
+ $sth->bind_param(":bar", 42);
+ $sth->bind_param_inout(":id", \my $new_id, 99);
+ $sth->execute;
+ print "The id of the new record is $new_id\n";
+
+If you have many columns to bind you can use code like this:
+
+ @params = (... column values for record to be inserted ...);
+ $sth->bind_param($_, $params[$_-1]) for (1..@params);
+ $sth->bind_param_inout(@params+1, \my $new_id, 99);
+ $sth->execute;
+
+If you have many rows to insert you can take advantage of Oracle's built in execute array feature
+with code like this:
+
+ my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10');
+ my @out_values;
+ my @status;
+ my $sth = $dbh->prepare(qq{
+ INSERT INTO foo (id, bar)
+ VALUES (foo_id_seq.nextval, ?)
+ RETURNING id INTO ?
+ });
+ $sth->bind_param_array(1,\@in_values);
+ $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2});
+ $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting";
+ foreach my $id (@out_values){
+ print 'returned id='.$id.'\n';
+ }
+
+Which will return all the ids into @out_values.
+
+=over
+
+=item B<Note:>
+
+=item This will only work for numbered (?) placeholders,
+
+=item The third parameter of bind_param_inout_array, (0 in the example), "maxlen" is required by DBI but not used by DBD::Oracle
+
+=item The "ora_type" attribute is not needed but only ORA_VARCHAR2 will work.
+
+=back
+
+=head3 Returning A Recordset
+
+DBD::Oracle does not currently support binding a PL/SQL table (aka array)
+as an IN OUT parameter to any Perl data structure. You cannot therefore call
+a PL/SQL function or procedure from DBI that uses a non-atomic datatype as
+either a parameter, or a return value. However, if you are using Oracle 9.0.1
+or later, you can make use of table (or pipelined) functions.
+
+For example, assume you have the existing PL/SQL Package :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ --
+ l_Ret taRec ;
+ --
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+ --
+ END Array_Example ;
+ /
+
+Currently, there is no way to directly call the function
+Array_Example.Array_Func from DBI. However, by making the following relatively
+painless additions, its not only possible, but extremely efficient.
+
+First, you need to create database object types that correspond to the record
+and table types in the package. From the above example, these would be :
+
+ CREATE OR REPLACE TYPE tArray_Example__taRec
+ AS OBJECT (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE
+ ) ;
+
+ CREATE OR REPLACE TYPE taArray_Example__taRec
+ AS TABLE OF tArray_Example__taRec ;
+
+Now, assuming the existing function needs to remain unchanged (it is probably
+being called from other PL/SQL code), we need to add a new function to the
+package. Here's the new package specification and body :
+
+ CREATE OR REPLACE PACKAGE Array_Example AS
+ --
+ TYPE tRec IS RECORD (
+ Col1 NUMBER,
+ Col2 VARCHAR2 (10),
+ Col3 DATE) ;
+ --
+ TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ;
+ --
+ FUNCTION Array_Func RETURN taRec ;
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ;
+ --
+ END Array_Example ;
+
+ CREATE OR REPLACE PACKAGE BODY Array_Example AS
+ --
+ FUNCTION Array_Func RETURN taRec AS
+ l_Ret taRec ;
+ BEGIN
+ FOR i IN 1 .. 5 LOOP
+ l_Ret (i).Col1 := i ;
+ l_Ret (i).Col2 := 'Row : ' || i ;
+ l_Ret (i).Col3 := TRUNC (SYSDATE) + i ;
+ END LOOP ;
+ RETURN l_Ret ;
+ END ;
+
+ FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS
+ l_Set taRec ;
+ BEGIN
+ l_Set := Array_Func ;
+ FOR i IN l_Set.FIRST .. l_Set.LAST LOOP
+ PIPE ROW (
+ tArray_Example__taRec (
+ l_Set (i).Col1,
+ l_Set (i).Col2,
+ l_Set (i).Col3
+ )
+ ) ;
+ END LOOP ;
+ RETURN ;
+ END ;
+ --
+ END Array_Example ;
+
+As you can see, the new function is very simple. Now, it is a simple matter
+of calling the function as a straight-forward SELECT from your DBI code. From
+the above example, the code would look something like this :
+
+ my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)');
+ $sth->execute;
+ while ( my ($col1, $col2, $col3) = $sth->fetchrow_array {
+ ...
+ }
+
+=head3 B<SYS.DBMS_SQL datatypes>
+
+DBD::Oracle has built-in support for B<SYS.DBMS_SQL.VARCHAR2_TABLE>
+and B<SYS.DBMS_SQL.NUMBER_TABLE> datatypes. The simple example is here:
+
+ my $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl.count();
+ tbl(1) := \'def\';
+ tbl(2) := \'ijk\';
+ :mytable := tbl;
+ END;
+ ';
+
+ my $sth=$dbh->prepare( $statement );
+
+ my @arr=( "abc","efg","hij" );
+
+ $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_VARCHAR2_TABLE,
+ ora_maxarray_numentries => 100
+ } ) ;
+ $sth->bind_param_inout(":cc", \$cc, 100 );
+ $sth->execute();
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+=over
+
+=item B<Note:>
+
+=item Take careful note that we use '\\@arr' here because the 'bind_param_inout'
+ will only take a reference to a scalar.
+
+=back
+
+=head3 B<ORA_VARCHAR2_TABLE>
+
+SYS.DBMS_SQL.VARCHAR2_TABLE object is always bound to array reference.
+( in bind_param() and bind_param_inout() ). When you bind array, you need
+to specify full buffer size for OUT data. So, there are two parameters:
+I<max_len> (specified as 3rd argument of bind_param_inout() ),
+and I<ora_maxarray_numentries>. They define maximum array entry length and
+maximum rows, that can be passed to Oracle and back to you. In this
+example we send array with 1 element with length=3, but allocate space for 100
+Oracle array entries with maximum length 10 of each. So, you can get no more
+than 100 array entries with length <= 10.
+
+If you set I<max_len> to zero, maximum array entry length is calculated
+as maximum length of entry of array bound. If 0 < I<max_len> < length( $some_element ),
+truncation occur.
+
+If you set I<ora_maxarray_numentries> to zero, current (at bind time) bound
+array length is used as maximum. If 0 < I<ora_maxarray_numentries> < scalar(@array),
+not all array entries are bound.
+
+=head3 B<ORA_NUMBER_TABLE>
+
+SYS.DBMS_SQL.NUMBER_TABLE object handling is much alike ORA_VARCHAR2_TABLE.
+The main difference is internal data representation. Currently 2 types of
+bind is allowed : as C-integer, or as C-double type. To select one of them,
+you may specify additional bind parameter I<ora_internal_type> as either
+B<SQLT_INT> or B<SQLT_FLT> for C-integer and C-double types.
+Integer size is architecture-specific and is usually 32 or 64 bit.
+Double is standard IEEE 754 type.
+
+I<ora_internal_type> defaults to double (SQLT_FLT).
+
+I<max_len> is ignored for OCI_NUMBER_TABLE.
+
+Currently, you cannot bind full native Oracle NUMBER(38). If you really need,
+send request to dbi-dev list.
+
+The usage example is here:
+
+ $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.NUMBER_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl(2);
+ tbl(4) := -1;
+ tbl(5) := -2;
+ :mytable := tbl;
+ END;
+ ';
+
+ $sth=$dbh->prepare( $statement );
+
+ if( ! defined($sth) ){
+ die "Prepare error: ",$dbh->errstr,"\n";
+ }
+
+ @arr=( 1,"2E0","3.5" );
+
+ # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE .
+ if( not $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_NUMBER_TABLE,
+ ora_maxarray_numentries => (scalar(@arr)+2),
+ ora_internal_type => SQLT_FLT
+ } ) ){
+ die "bind :mytable error: ",$dbh->errstr,"\n";
+ }
+ $cc=undef;
+ if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
+ die "bind :cc error: ",$dbh->errstr,"\n";
+ }
+
+ if( not $sth->execute() ){
+ die "Execute failed: ",$dbh->errstr,"\n";
+ }
+ print "Result: cc=",$cc,"\n",
+ "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+The result is like:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ '1',
+ '2',
+ '3.5',
+ '-1',
+ '-2'
+ ];
+
+If you change bind type to B<SQLT_INT>, like:
+
+ ora_internal_type => SQLT_INT
+
+you get:
+
+ Result: cc=2
+ arr=$VAR1 = [
+ 1,
+ 2,
+ 3,
+ -1,
+ -2
+ ];
+
+=head2 B<bind_param_inout_array>
+
+DBD::Oracle supports this undocumented feature of DBI. See L</Returning A Value from an INSERT> for an example.
+
+=head2 B<bind_param_array>
+
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type)
+ $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr)
+
+Binds an array of values to a placeholder, so that each is used in turn by a call
+to the L</execute_array> method.
+
+=head2 B<execute>
+
+ $rv = $sth->execute(@bind_values);
+
+Perform whatever processing is necessary to execute the prepared statement.
+
+=head2 B<execute_array>
+
+ $tuples = $sth->execute_array() or die $sth->errstr;
+ $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 a prepared statement once for each item in a passed-in hashref, or items that
+were previously bound via the L</bind_param_array> method. See the DBI documentation
+for more details.
+
+DBD::Oracle takes full advantage of OCI's array interface so inserts and updates using this interface will run very
+quickly.
+
+=head2 B<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);
+
+Used internally by the L</execute_array> method, and rarely used directly. See the
+DBI documentation for more details.
+
+=head2 B<fetchrow_arrayref>
+
+ $ary_ref = $sth->fetchrow_arrayref;
+
+Fetches the next row of data from the statement handle, and returns a reference to an array
+holding the column values. Any columns that are NULL are returned as undef within the array.
+
+If there are no more rows or if an error occurs, the this method return undef. You should
+check C<< $sth->err >> afterwards (or use the L</RaiseError> attribute) to discover if the 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>.
+
+=head2 B<fetchrow_array>
+
+ @ary = $sth->fetchrow_array;
+
+Similar to the L</fetchrow_arrayref> method, but returns a list of column information rather than
+a reference to a list. Do not use this in a scalar context.
+
+=head2 B<fetchrow_hashref>
+
+ $hash_ref = $sth->fetchrow_hashref;
+ $hash_ref = $sth->fetchrow_hashref($name);
+
+Fetches the next row of data and returns a hashref containing the name of the columns as the keys
+and the data itself as the values. Any NULL value is returned as undef value.
+
+If there are no more rows or if an error occurs, the this method return undef. You should
+check C<< $sth->err >> afterwards (or use the L</RaiseError> attribute) to discover if the undef returned
+was due to an error.
+
+The optional C<$name> argument should be either C<NAME>, C<NAME_lc> or C<NAME_uc>, and indicates
+what sort of transformation to make to the keys in the hash. By default Oracle uses upper case.
+
+=head2 B<fetchall_arrayref>
+
+ $tbl_ary_ref = $sth->fetchall_arrayref();
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice );
+ $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
+
+Returns a reference to an array of arrays that contains all the remaining rows to be fetched from the
+statement handle. If there are no more rows, an empty arrayref will be returned. If an error occurs,
+the data read in so far will be returned. Because of this, you should always check C<< $sth->err >> after
+calling this method, unless L</RaiseError> has been enabled.
+
+If C<$slice> is an array reference, fetchall_arrayref uses the L</fetchrow_arrayref> method to fetch each
+row as an array ref. If the C<$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, fetchall_arrayref acts as if passed an empty array ref.
+
+If C<$slice> is a hash reference, fetchall_arrayref uses L</fetchrow_hashref> to fetch each row as a hash reference.
+
+See the DBI documentation for a complete discussion.
+
+=head2 B<fetchall_hashref>
+
+ $hash_ref = $sth->fetchall_hashref( $key_field );
+
+Returns a hashref containing all rows to be fetched from the statement handle. See the DBI documentation for
+a full discussion.
+
+=head2 B<finish>
+
+ $rv = $sth->finish;
+
+Indicates to DBI that you are finished with the statement handle and are not going to use it again. Only needed
+when you have not fetched all the possible rows.
+
+=head2 B<rows>
+
+ $rv = $sth->rows;
+
+Returns the number of rows affected for updates, deletes and inserts and -1 for selects.
+
+=head2 B<bind_col>
+
+ $rv = $sth->bind_col($column_number, \$var_to_bind);
+ $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr );
+ $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
+
+Binds a Perl variable and/or some attributes to an output column of a SELECT statement.
+Column numbers count up from 1. You do not need to bind output columns in order to fetch data.
+
+NOTE: DBD::Oracle does not use the C<$bind_type> to determine how to
+bind the column; it uses what Oracle says the data type is. You can
+however set the StrictlyTyped/DiscardString attributes and these will
+take effect as these attributes are applied after the column is
+retrieved.
+
+See the DBI documentation for a discussion of the optional parameters C<\%attr> and C<$bind_type>
+
+=head2 B<bind_columns>
+
+ $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
+
+Calls the L</bind_col> method for each column in the SELECT statement, using the supplied list.
+
+=head2 B<dump_results>
+
+ $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
+
+Fetches all the rows from the statement handle, calls C<DBI::neat_list> for each row, and
+prints the results to C<$fh> (which defaults to F<STDOUT>). Rows are separated by C<$lsep> (which defaults
+to a newline). Columns are separated by C<$fsep> (which defaults to a comma). The C<$maxlen> controls
+how wide the output can be, and defaults to 35.
+
+This method is designed as a handy utility for prototyping and testing queries. Since it uses
+"neat_list" to format and edit the string for reading by humans, it is not recommended
+for data transfer applications.
+
+=head1 STATEMENT HANDLE ATTRIBUTES
+
+=head2 B<NUM_OF_FIELDS> (integer, read-only)
+
+Returns the number of columns returned by the current statement. A number will only be returned for
+SELECT statements for INSERT,
+UPDATE, and DELETE statements which contain a RETURNING clause.
+This method returns undef if called before C<execute()>.
+
+=head2 B<NUM_OF_PARAMS> (integer, read-only)
+
+Returns the number of placeholders in the current statement.
+
+=head2 B<NAME> (arrayref, read-only)
+
+Returns an arrayref of column names for the current statement. This
+method will only work for SELECT statements, for SHOW statements, and for
+INSERT, UPDATE, and DELETE statements which contain a RETURNING clause.
+This method returns undef if called before C<execute()>.
+
+=head2 B<NAME_lc> (arrayref, read-only)
+
+The same as the C<NAME> attribute, except that all column names are forced to lower case.
+
+=head2 B<NAME_uc> (arrayref, read-only)
+
+The same as the C<NAME> attribute, except that all column names are forced to upper case.
+
+=head2 B<NAME_hash> (hashref, read-only)
+
+Similar to the C<NAME> attribute, but returns a hashref of column names instead of an arrayref. The names of the columns
+are the keys of the hash, and the values represent the order in which the columns are returned, starting at 0.
+This method returns undef if called before C<execute()>.
+
+=head2 B<NAME_lc_hash> (hashref, read-only)
+
+The same as the C<NAME_hash> attribute, except that all column names are forced to lower case.
+
+=head2 B<NAME_uc_hash> (hashref, read-only)
+
+The same as the C<NAME_hash> attribute, except that all column names are forced to lower case.
+
+=head2 B<TYPE> (arrayref, read-only)
+
+Returns an arrayref indicating the data type for each column in the statement.
+This method returns undef if called before C<execute()>.
+
+=head2 B<PRECISION> (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement.
+The number indicates the precision for C<NUMERIC> columns, the size in number of
+characters for C<CHAR> and C<VARCHAR> columns, and for all other types of columns
+it returns the number of I<bytes>.
+This method returns undef if called before C<execute()>.
+
+=head2 B<SCALE> (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement. The number
+indicates the scale of the that column. The only type that will return a value is C<NUMERIC>.
+This method returns undef if called before C<execute()>.
+
+=head2 B<NULLABLE> (arrayref, read-only)
+
+Returns an arrayref of integer values for each column returned by the statement. The number
+indicates if the column is nullable or not. 0 = not nullable, 1 = nullable, 2 = unknown.
+This method returns undef if called before C<execute()>.
+
+=head2 B<Database> (dbh, read-only)
+
+Returns the database handle this statement handle was created from.
+
+=head2 B<ParamValues> (hash ref, read-only)
+
+Returns a reference to a hash containing the values currently bound to placeholders. If the "named parameters"
+type of placeholders are being used (such as ":foo"), then the keys of the hash will be the names of the
+placeholders (without the colon). If the "dollar sign numbers" type of placeholders are being used, the keys of the hash will
+be the numbers, without the dollar signs. If the "question mark" type is used, integer numbers will be returned,
+starting at one and increasing for every placeholder.
+
+If this method is called before L</execute>, the literal values passed in are returned. If called after
+L</execute>, then the quoted versions of the values are returned.
+
+=head2 B<ParamTypes> (hash ref, read-only)
+
+Returns a reference to a hash containing the type names currently bound to placeholders. The keys
+are the same as returned by the ParamValues method. The values are hashrefs containing a single key value
+pair, in which the key is either 'TYPE' if the type has a generic SQL equivalent, and 'pg_type' if the type can
+only be expressed by a Postgres type. The value is the internal number corresponding to the type originally
+passed in. (Placeholders that have not yet been bound will return undef as the value). This allows the output of
+ParamTypes to be passed back to the L</bind_param> method.
+
+=head2 B<Statement> (string, read-only)
+
+Returns the statement string passed to the most recent "prepare" method called in this database handle, even if that method
+failed. This is especially useful where "RaiseError" is enabled and the exception handler checks $@ and sees that a C<prepare>
+method call failed.
+
+=head2 B<RowsInCache>
+
+Returns the number of un-fetched rows in the cache for selects.
+
+=head1 SCROLLABLE CURSORS
+
+Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where
+the rows can be fetched either sequentially or non-sequentially. One can fetch rows forward,
+backwards, from any given position or the n-th row from the current position in the result set.
+
+Rows are numbered sequentially starting at one and client-side caching of the partial or entire result set
+can improve performance by limiting round trips to the server.
+
+Oracle does not support DML type operations with scrollable cursors so you are limited
+to simple 'Select' operations only. As well you can not use this functionality with remote
+mapped queries or if the LONG datatype is part of the select list.
+
+However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind, and fetch methods.
+
+Only use scrollable cursors if you really have a good reason to. They do use up considerable
+more server and client resources and have poorer response times than non-scrolling cursors.
+
+=head2 Enabling Scrollable Cursors
+
+To enable this functionality you must first import the 'Fetch Orientation' and the 'Execution Mode' constants by using;
+
+ use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes);
+
+Next you will have to tell DBD::Oracle that you will be using scrolling by setting the ora_exe_mode attribute on the
+statement handle to 'OCI_STMT_SCROLLABLE_READONLY' with the prepare method;
+
+ $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+
+When the statement is executed you will then be able to use 'ora_fetch_scroll' method to get a row
+or you can still use any of the other fetch methods but with a poorer response time than if you used a
+non-scrolling cursor. As well scrollable cursors are compatible with any applicable bind methods.
+
+=head2 Scrollable Cursor Methods
+
+The following driver-specific methods are used with scrollable cursors.
+
+=over
+
+=item ora_scroll_position
+
+ $position = $sth->ora_scroll_position();
+
+This method returns the current position (row number) attribute of the result set. Prior to the first fetch this value is 0. This is the only time
+this value will be 0 after the first fetch the value will be set, so you can use this value to test if any rows have been fetched.
+The minimum value will always be 1 after the first fetch. The maximum value will always be the total number of rows in the record set.
+
+=item ora_fetch_scroll
+
+ $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset);
+
+Works the same as C<fetchrow_arrayref>, excepts one passes in a 'Fetch Orientation' constant and a fetch_offset
+value which will then determine the row that will be fetched. It returns the row as a list containing the field values.
+Null fields are returned as I<undef> values in the list.
+
+The valid orientation constant and fetch offset values combination are detailed below
+
+ OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored.
+ OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value
+ is ignored.
+ OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored.
+ OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored.
+ OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset
+ value is ignored.
+
+ OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the
+ fetch offset value.
+
+ OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT.
+ OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR.
+
+The effect that a ora_fetch_scroll method call has on the current_positon attribute is detailed below.
+
+ OCI_FETCH_CURRENT, has no effect on the current_positon attribute.
+ OCI_FETCH_NEXT, increments current_positon attribute by 1
+ OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT
+ OCI_FETCH_FIRST, sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the
+ record set.
+ OCI_FETCH_PRIOR, decrements current_positon attribute by 1.
+ OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon
+ attribute, it is equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change
+ current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in
+ the record set, does not change current_positon attribute, it is
+ equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute +
+ fetch offset value).
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1,
+ does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records
+ in the record set, does not change fetch offset value so it is equivalent
+ to a OCI_FETCH_CURRENT.
+
+The effects of the differing orientation constants on the first fetch (current_postion attribute at 0) are as follows.
+
+ OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute.
+ OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1.
+ OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon
+ attribute to the total number of rows in the record set.
+ OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST.
+ OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT.
+
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a
+ OCI_FETCH_CURRENT.
+ OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of
+ records in the record set is equivalent to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent
+ to a OCI_FETCH_CURRENT.
+ OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number
+ of records in the record set, is equivalent to a OCI_FETCH_CURRENT.
+
+=back
+
+=head2 Scrollable Cursor Usage
+
+Given a simple code like this:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes);
+ my $dbh = DBI->connect($dsn, $dbuser, '');
+ my $SQL = "select id,
+ first_name,
+ last_name
+ from employee";
+ my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+ $sth->execute();
+ my $value;
+
+and one assumes that the number of rows returned from the query is 20, the code snippets below will illustrate the use of ora_fetch_scroll
+method;
+
+=over
+
+=item Fetching the Last Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute to will be 20 after this snippet. This is also a way to get the number of rows in the record set, however,
+if the record set is large this could take some time.
+
+=item Fetching the Current Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will still be 20 after this snippet.
+
+=item Fetching the First Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 1 after this snippet.
+
+=item Fetching the Next Row
+
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 5 after this snippet.
+
+=item Fetching the Prior Row
+
+ for(my $i=0;$i<=3;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 1 after this snippet.
+
+=item Fetching the 10th Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 10 after this snippet.
+
+=item Fetching the 10th to 14th Row
+
+ for(my $i=10;$i<15;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 14 after this snippet.
+
+=item Fetching the 14th to 10th Row
+
+ for(my $i=14;$i>9;$i--){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 10 after this snippet.
+
+=item Fetching the 5th Row From the Present Position.
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 15 after this snippet.
+
+=item Fetching the 9th Row Prior From the Present Position
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+The current_positon attribute will be 6 after this snippet.
+
+=item Use Finish
+
+ $sth->finish();
+
+When using scrollable cursors it is required that you use the $sth->finish() method when you are done with the cursor as this type of
+cursor has to be explicitly cancelled on the server. If you do not do this you may cause resource problems on your database.
+
+=back
+
+=head1 LOBS AND LONGS
+
+The key to working with LOBs (CLOB, BLOBs) is to remember the value of an Oracle LOB column is not the content of the LOB. It's a
+'LOB Locator' which, after being selected or inserted needs extra processing to read or write the content of the LOB. There are also legacy LONG types (LONG, LONG RAW, VARCHAR2)
+which are presently deprecated by Oracle but are still in use. These LONG types do not utilize a 'LOB Locator' and also are more limited in
+functionality than CLOB or BLOB fields.
+
+DBD::Oracle now offers three interfaces to LOB and LONG data,
+
+=over
+
+=item L</Data Interface for Persistent LOBs>
+
+With this interface DBD::Oracle handles your data directly utilizing regular OCI calls, Oracle itself takes care of the LOB Locator operations in the case of
+BLOBs and CLOBs treating them exactly as if they were the same as the legacy LONG or LONG RAW types.
+
+=item L</Data Interface for LOB Locators>
+
+With this interface DBD::Oracle handles your data utilizing LOB Locator OCI calls so it only works with CLOB and BLOB datatypes. With this interface DBD::Oracle takes care of the LOB Locator operations for you.
+
+=item L</LOB Locator Method Interface>
+
+This allows the user direct access to the LOB Locator methods, so you have to take case of the LOB Locator operations yourself.
+
+=back
+
+Generally speaking the interface that you will chose will be dependent on what end you are trying to achieve. All have their benefits and
+drawbacks.
+
+One point to remember when working with LOBs (CLOBs, BLOBs) is if your LOB column can be in one of three states;
+
+=over
+
+=item NULL
+
+The table cell is created, but the cell holds no locator or value.
+If your LOB field is in this state then there is no LOB Locator that DBD::Oracle can work so if your encounter a
+
+ DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr
+
+error when working with a LOB.
+
+You can correct this by using an SQL UPDATE statement to reset the LOB column to a non-NULL (or empty LOB) value with either EMPTY_BLOB or EMPTY_CLOB as in this example;
+
+ UPDATE lob_example
+ SET bindata=EMPTY_BLOB()
+ WHERE bindata IS NULL.
+
+=item Empty
+
+A LOB instance with a locator exists in the cell, but it has no value. The length of the LOB is zero. In this case DBD::Oracle will return 'undef' for the field.
+
+=item Populated
+
+A LOB instance with a locator and a value exists in the cell. You actually get the LOB value.
+
+=back
+
+=head2 Data Interface for Persistent LOBs
+
+This is the original interface for LONG and LONG RAW datatypes and from Oracle 9iR1 and later the OCI API was extended to work directly with the other LOB datatypes.
+In other words you can treat all LOB type data (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using the same techniques
+you would use on other datatypes that store character or binary data. In some cases there are fewer round trips to the server as no 'LOB Locators' are
+used, normally one can get an entire LOB is a single round trip.
+
+=head3 Simple Fetch for LONGs and LONG RAWs
+
+As the name implies this is the simplest way to use this interface. DBD::Oracle just attempts to get your LONG datatypes as a single large piece.
+There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LONG or LONG RAW.
+If the size of the LONG or LONG RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'.
+The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on. You have most likely reached this limit if you run into
+an 'ORA-01062: unable to allocate memory for define buffer' error. One solution is to set the size of 'LongReadLen' to a lower value.
+
+For example give this table;
+
+ CREATE TABLE test_long (
+ id NUMBER,
+ long1 long)
+
+this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select out all of the long1 fields in the table as long as they are all under 2MB in length. A value in long1 longer than this will throw an error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+before the execute will return all the long1 fields but they will be truncated at 2MBs.
+
+=head3 Using ora_ncs_buff_mtpl
+
+When getting CLOBs and NCLOBs in or out of Oracle, the Server will translate from the Server's NCharSet to the
+Client's. If they happen to be the same or at least compatible then all of these actions are a 1 char to 1 char bases.
+Thus if you set your LongReadLen buffer to 10_000_000 you will get up to 10_000_000 char.
+
+However if the Server has to translate from one NCharSet to another it will use bytes for conversion. The buffer
+value is set to 4 * LONG_READ_LEN which was very wasteful as you might only be asking for 10_000_000 bytes
+but you were actually using 40_000_000 bytes of buffer under the hood. You would still get 10_000_000 bytes
+(maybe less characters though) but you are using allot more memory that you need.
+
+You can now customize the size of the buffer by setting the 'ora_ncs_buff_mtpl' either on the connection or statement handle. You can
+also set this as 'ORA_DBD_NCS_BUFFER' OS environment variable so you will have to go back and change all your code if you are getting into trouble.
+
+The default value is still set to 4 for backward compatibility. You can lower this value and thus increase the amount of data you can retrieve. If the
+ora_ncs_buff_mtpl is too small DBD::Oracle will throw and error telling you to increase this buffer by one.
+
+If the error is not captured then you may get at some random point later on, usually at a finish() or disconnect() or even a fetch() this error;
+
+ ORA-03127: no new operations allowed until the active operation ends
+
+This is one of the more obscure ORA errors (have some fun and report it to Meta-Link they will scratch their heads for hours)
+
+If you get this, simply increment the ora_ncs_buff_mtpl by one until it goes away.
+
+This should greatly increase your ability to select very large CLOBs or NCLOBs, by freeing up a large block of memory.
+
+You can tune this value by setting ora_oci_success_warn which will display the following
+
+ OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen
+ 20(characters), BufLen 80(characters), Got 28(characters)
+
+In the case above the query Got 28 characters (well really only 20 characters of 28 bytes) so we could use ora_ncs_buff_mtpl=>2 (20*2=40) thus saving 40bytes of memory.
+
+=head3 Simple Fetch for CLOBs and BLOBs
+
+To use this interface for CLOBs and LOBs datatypes set the 'ora_pers_lob' attribute of the statement handle to '1' with the prepare method, as well
+set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. If the size of the LOB exceeds
+the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'.
+The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on in the same way that LONGs and LONG RAWs are.
+
+For CLOBs and NCLOBs the limit is 64k chars if there is no truncation, this is an internal OCI limit complain to them if you want it changed. However if you CLOB is longer than this
+and also larger than the 'LongReadLen' than the 'LongReadLen' in chars is returned.
+
+It seems with BLOBs you are not limited by the 64k.
+
+For example give this table;
+
+ CREATE TABLE test_lob (id NUMBER,
+ clob1 CLOB,
+ clob2 CLOB,
+ blob1 BLOB,
+ blob2 BLOB)
+
+this code;
+
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 2MB in length. Longer lobs will throw an error. Adding this line;
+
+ $dbh->{LongTruncOk}=1;
+
+before the execute will return all the lobs but they will be truncated at 2MBs.
+
+=head3 Piecewise Fetch with Callback
+
+With a piecewise callback fetch DBD::Oracle sets up a function that will 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece.
+To use this interface set the 'ora_clbk_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that
+you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected
+size of the LOB. Like the L</Simple Fetch for LONGs and LONG RAWs> and L</Simple Fetch for CLOBs and BLOBs> the if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB
+or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on
+the Simple Fetch interface. If you encounter an 'ORA-01062' error try setting the value of 'ora_piece_size' to a smaller value. The value for 'LongReadLen' is
+dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs
+in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance.
+
+Using the table from the last example this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will throw an error.
+
+Using the table from the first example (LONG) this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 filed is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error.
+
+=head4 Piecewise Fetch with Polling
+
+With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora_piece_lob'
+attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that
+you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected
+size of the LOB. Like the L</Piecewise Fetch with Callback> and Simple Fetches if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB
+or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on
+the L</Piecewise Fetch with Callback>.
+
+Using the table from the example above this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #20 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will throw an error.
+
+Finally with this code;
+
+ $dbh->{LongReadLen} = 20*1024*1024; #2 meg
+ $SQL='select p_id,long1 from test_long';
+ $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024});
+ $sth->execute();
+ while (my ( $p_id,$long )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "long=".$long."\n";
+ }
+
+Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 field is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a
+maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error.
+
+=head3 Binding for Updates and Inserts for CLOBs and BLOBs
+
+To bind for updates and inserts all that is required to use this interface is to set the statement handle's prepare method
+'ora_type' attribute to 'SQLT_CHR' in the case of CLOBs and NCLOBs or 'SQLT_BIN' in the case of BLOBs as in this example for an insert;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+ my $in_blob ="0101" for 1 .. 10_000;
+
+ $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)';
+ $sth=$dbh->prepare($SQL );
+ $sth->bind_param(1,3);
+ $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR});
+ $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN});
+ $sth->execute();
+
+So far the only limit reached with this form of insert is the LOBs must be under 2GB in size.
+
+=head3 Support for Remote LOBs;
+
+Starting with Oracle 10gR2 the interface for Persistent LOBs was expanded to support remote LOBs (access over a dblink). Given a database called 'lob_test' that has a 'LINK' defined like this;
+
+ CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test';
+
+to a remote database called 'test_lobs', the following code will work;
+
+ $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test');
+ $dbh->{LongReadLen} = 2*1024*1024; #2 meg
+ $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test';
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth->execute();
+ while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
+ print "p_id=".$p_id."\n";
+ print "clob1=".$clob1."\n";
+ print "clob2=".$clob2."\n";
+ print "blob1=".$blob2."\n";
+ print "blob2=".$blob2."\n";
+ }
+
+Below are the limitations of Remote LOBs;
+
+=over
+
+=item Queries involving more than one database are not supported;
+
+so the following returns an error:
+
+ SELECT t1.lobcol,
+ a2.lobcol
+ FROM t1,
+ t2.lobcol@dbs2 a2 W
+ WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol);
+
+as does:
+
+ SELECT t1.lobcol
+ FROM t1@dbs1
+ UNION ALL
+ SELECT t2.lobcol
+ FROM t2@dbs2;
+
+=item DDL commands are not supported;
+
+so the following returns an error:
+
+ CREATE VIEW v AS SELECT lob_col FROM tab@dbs;
+
+=item Only binds and defines for data going into remote persistent LOBs are supported.
+
+so that parameter passing in PL/SQL where CHAR data is bound or defined for remote LOBs is not allowed .
+
+These statements all produce errors:
+
+ SELECT foo() FROM table1@dbs2;
+
+ SELECT foo()@dbs INTO char_val FROM DUAL;
+
+ SELECT XMLType().getclobval FROM table1@dbs2;
+
+=item If the remote object is a view such as
+
+ CREATE VIEW v AS SELECT foo() FROM ...
+
+the following would not work:
+
+ SELECT * FROM v@dbs2;
+
+=item Limited PL/SQL parameter passing
+
+PL/SQL parameter passing is not allowed where the actual argument is a LOB type
+and the remote argument is one of VARCHAR2, NVARCHAR2, CHAR, NCHAR, or RAW.
+
+=item RETURNING INTO does not support implicit conversions between CHAR and CLOB.
+
+so the following returns an error:
+
+ SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test
+
+=back
+
+=head2 Locator Data Interface
+
+=head3 Simple Usage
+
+When fetching LOBs with this interface a 'LOB Locator' is created then used to get the lob with the LongReadLen and LongTruncOk attributes.
+The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs
+in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance.
+
+When inserting or updating LOBs some I<major> magic has to be performed
+behind the scenes to make it transparent. Basically the driver has to
+insert a 'LOB Locator' and then refetch the newly inserted LOB
+Locator before being able to write the data into it. However, it works
+well most of the time, and I've made it as fast as possible, just one
+extra server-round-trip per insert or update after the first. For the
+time being, only single-row LOB updates are supported.
+
+To insert or update a large LOB using a placeholder, DBD::Oracle has to
+know in advance that it is a LOB type. So you need to say:
+
+ $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB });
+
+The ORA_CLOB and ORA_BLOB constants can be imported using
+
+ use DBD::Oracle qw(:ora_types);
+
+or use the corresponding integer values (112 and 113).
+
+One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has
+to be able to tell which parameters relate to which table fields.
+In all cases where it can possibly work it out for itself, it does,
+however, if there are multiple LOB fields of the same type in the table
+then you need to tell it which field each LOB param relates to:
+
+ $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' });
+
+There are some limitations inherent in the way DBD::Oracle makes typical
+LOB operations simple by hiding the LOB Locator processing:
+
+ - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL)
+ - To INSERT a LOB, you need UPDATE privilege.
+
+The alternative is to disable the automatic LOB Locator processing.
+If L</ora_auto_lob> is 0 in prepare(), you can fetch the LOB Locators and
+do all the work yourself using the ora_lob_*() methods.
+See the L</Data Interface for LOB Locators> section below.
+
+=head3 LOB support in PL/SQL
+
+LOB Locators can be passed to PL/SQL calls by binding them to placeholders
+with the proper C<ora_type>. If L</ora_auto_lob> is true, output LOB
+parameters will be automatically returned as strings.
+
+If the Oracle driver has support for temporary LOBs (Oracle 9i and higher),
+strings can be bound to input LOB placeholders and will be automatically
+converted to LOBs.
+
+Example:
+ # Build a large XML document, bind it as a CLOB,
+ # extract elements through PL/SQL and return as a CLOB
+
+ # $dbh is a connected database handle
+ # output will be large
+
+ local $dbh->{LongReadLen} = 1_000_000;
+
+ my $in_clob = "<document>\n";
+ $in_clob .= " <value>$_</value>\n" for 1 .. 10_000;
+ $in_clob .= "</document>\n";
+
+ my $out_clob;
+
+
+ my $sth = $dbh->prepare(<<PLSQL_END);
+ -- extract 'value' nodes
+ DECLARE
+ x XMLTYPE := XMLTYPE(:in);
+ BEGIN
+ :out := x.extract('/document/value').getClobVal();
+ END;
+
+ PLSQL_END
+
+ # :in param will be converted to a temp lob
+ # :out parameter will be returned as a string.
+
+ $sth->bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } );
+ $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } );
+ $sth->execute;
+
+If you ever get an
+
+ ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt
+
+error, while attempting to insert a LOB, this means the Oracle user has insufficient space for LOB you are trying to insert.
+One solution it to use "alter database datafile 'sss.ggg' resize Mnnn" to increase the available memory for LOBs.
+
+=head2 Persistent & Locator Interface Caveats
+
+Now that one has the option of using the Persistent or the Locator interface for LOBs the questions arises
+which one to use. For starters, if you want to access LOBs over a dblink you will have to use the Persistent
+interface so that choice is simple. The question of which one to use after that is a little more tricky.
+It basically boils down to a choice between LOB size and speed.
+
+The Callback and Polling piecewise fetches are very very slow
+when compared to the Simple and the Locator fetches but they can handle very large blocks of data. Given a situation where a
+large LOB is to be read the Locator fetch may time out while either of the piecewise fetches may not.
+
+With the Simple fetch you are limited by physical memory of your server but it runs a little faster than the Locator, as there are fewer round trips
+to the server. So if you have small LOBs and need to save a little bandwidth this is the one to use. It you are going after large LOBs then the Locator interface is the one to use.
+
+If you need to update more than a single row of with LOB data then the Persistent interface can do it while the Locator can't.
+
+If you encounter a situation where you have to access the legacy LOBs (LONG, LONG RAW) and the values are to large for you system then you can use
+the Callback or Polling piecewise fetches to get all of the data.
+
+Not all of the Persistent interface has been implemented yet, the following are not supported;
+
+ 1) Piecewise, polling and callback binds for INSERT and UPDATE operations.
+ 2) Piecewise array binds for SELECT, INSERT and UPDATE operations.
+
+Most of the time you should just use the L</Locator Data Interface> as this is in one that has the best combination of speed and size.
+
+All this being said if you are doing some critical programming I would use the L</Data Interface for LOB Locators> as this gives you very
+fine grain control of your LOBs, of course the code for this will be somewhat more involved.
+
+=head2 Data Interface for LOB Locators
+
+The following driver-specific methods let you manipulate "LOB Locators" directly.
+To select a LOB locator directly set the if the C<ora_auto_lob>
+attribute to false, or alternatively they can be returned via PL/SQL procedure calls.
+
+(If using a DBI version earlier than 1.36 they must be called via the
+func() method. Note that methods called via func() don't honour
+RaiseError etc, and so it's important to check $dbh->err after each call.
+It's recommended that you upgrade to DBI 1.38 or later.)
+
+Note that LOB locators are only valid while the statement handle that
+created them is valid. When all references to the original statement
+handle are lost, the handle is destroyed and the locators are freed.
+
+=over 4
+
+=item ora_lob_read
+
+ $data = $dbh->ora_lob_read($lob_locator, $offset, $length);
+
+Read a portion of the LOB. $offset starts at 1.
+Uses the Oracle OCILobRead function.
+
+NOTE: DBD::Oracle post 1.46 will return undef for any read lob if the
+length specified in the ora_lob_read is 0. See RT 55028. This avoids
+the potential problem with empty lobs (created with empty_clob) which
+return a length of 0 from ora_lob_length and prior to 1.46 a call to
+ora_lob_read with a 0 length would segfault.
+
+=item ora_lob_write
+
+ $rc = $dbh->ora_lob_write($lob_locator, $offset, $data);
+
+Write/overwrite a portion of the LOB. $offset starts at 1.
+Uses the Oracle OCILobWrite function.
+
+=item ora_lob_append
+
+ $rc = $dbh->ora_lob_append($lob_locator, $data);
+
+Append $data to the LOB. Uses the Oracle OCILobWriteAppend function.
+
+=item ora_lob_trim
+
+ $rc = $dbh->ora_lob_trim($lob_locator, $length);
+
+Trims the length of the LOB to $length.
+Uses the Oracle OCILobTrim function.
+
+=item ora_lob_length
+
+ $length = $dbh->ora_lob_length($lob_locator);
+
+Returns the length of the LOB.
+Uses the Oracle OCILobGetLength function.
+
+=item ora_lob_is_init
+
+ $is_init = $dbh->ora_lob_is_init($lob_locator);
+
+Returns true(1) if the Lob Locator is initialized false(0) if it is not, or 'undef'
+if there is an error.
+Uses the Oracle OCILobLocatorIsInit function.
+
+=item ora_lob_chunk_size
+
+ $chunk_size = $dbh->ora_lob_chunk_size($lob_locator);
+
+Returns the chunk size of the LOB.
+Uses the Oracle OCILobGetChunkSize function.
+
+For optimal performance, Oracle recommends reading from and
+writing to a LOB in batches using a multiple of the LOB chunk size.
+In Oracle 10g and before, when all defaults are in place, this
+chunk size defaults to 8k (8192).
+
+=back
+
+=head3 LOB Locator Method Examples
+
+I<Note:> Make sure you first read the note in the section above about
+multi-byte character set issues with these methods.
+
+The following examples demonstrate the usage of LOB Locators
+to read, write, and append data, and to query the size of
+large data.
+
+The following examples assume a table containing two large
+object columns, one binary and one character, with a primary
+key column, defined as follows:
+
+ CREATE TABLE lob_example (
+ lob_id INTEGER PRIMARY KEY,
+ bindata BLOB,
+ chardata CLOB
+ )
+
+It also assumes a sequence for use in generating unique
+lob_id field values, defined as follows:
+
+ CREATE SEQUENCE lob_example_seq
+
+=head3 Example: Inserting a new row with large data
+
+Unless enough memory is available to store and bind the
+entire LOB data for insert all at once, the LOB columns must
+be written interactively, piece by piece. In the case of a new row,
+this is performed by first inserting a row, with empty values in
+the LOB columns, then modifying the row by writing the large data
+interactively to the LOB columns using their LOB locators as handles.
+
+The insert statement must create token values in the LOB
+columns. Here, we use the empty string for both the binary
+and character large object columns 'bindata' and 'chardata'.
+
+After the INSERT statement, a SELECT statement is used to
+acquire LOB locators to the 'bindata' and 'chardata' fields
+of the newly inserted row. Because these LOB locators are
+subsequently written, they must be acquired from a select
+statement containing the clause 'FOR UPDATE' (LOB locators
+are only valid within the transaction that fetched them, so
+can't be used effectively if AutoCommit is enabled).
+
+ my $lob_id = $dbh->selectrow_array( <<" SQL" );
+ SELECT lob_example_seq.nextval FROM DUAL
+ SQL
+
+ my $sth = $dbh->prepare( <<" SQL" );
+ INSERT INTO lob_example
+ ( lob_id, bindata, chardata )
+ VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() )
+ SQL
+ $sth->execute( $lob_id );
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata, chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator, $char_locator ) = $sth->fetchrow_array();
+ $sth->finish();
+
+ open BIN_FH, "/binary/data/source" or die;
+ open CHAR_FH, "/character/data/source" or die;
+ my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator );
+
+ # BEGIN WRITING BIN_DATA COLUMN
+ my $offset = 1; # Offsets start at 1, not 0
+ my $length = 0;
+ my $buffer = '';
+ while( $length = read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $bin_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+ # BEGIN WRITING CHAR_DATA COLUMN
+ $chunk_size = $dbh->ora_lob_chunk_size( $char_locator );
+ $offset = 1; # Offsets start at 1, not 0
+ $length = 0;
+ $buffer = '';
+ while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_write( $char_locator, $offset, $buffer );
+ $offset += $length;
+ }
+
+In this example we demonstrate the use of ora_lob_write()
+interactively to append data to the columns 'bin_data' and
+'char_data'. Had we used ora_lob_append(), we could have
+saved ourselves the trouble of keeping track of the offset
+into the lobs. The snippet of code beneath the comment
+'BEGIN WRITING BIN_DATA COLUMN' could look as follows:
+
+ my $buffer = '';
+ while ( read( BIN_FH, $buffer, $chunk_size ) ) {
+ $dbh->ora_lob_append( $bin_locator, $buffer );
+ }
+
+The scalar variables $offset and $length are no longer
+needed, because ora_lob_append() keeps track of the offset
+for us.
+
+=head3 Example: Updating an existing row with large data
+
+In this example, we demonstrate a technique for overwriting
+a portion of a blob field with new binary data. The blob
+data before and after the section overwritten remains
+unchanged. Hence, this technique could be used for updating
+fixed length subfields embedded in a binary field.
+
+ my $lob_id = 5; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ WHERE lob_id = ?
+ FOR UPDATE
+ SQL
+ $sth->execute( $lob_id );
+ my ( $bin_locator ) = $sth->fetchrow_array();
+
+ my $offset = 100234;
+ my $data = "This string will overwrite a portion of the blob";
+ $dbh->ora_lob_write( $bin_locator, $offset, $data );
+
+After running this code, the row where lob_id = 5 will
+contain, starting at position 100234 in the bin_data column,
+the string "This string will overwrite a portion of the blob".
+
+=head3 Example: Streaming character data from the database
+
+In this example, we demonstrate a technique for streaming
+data from the database to a file handle, in this case
+STDOUT. This allows more data to be read in and written out
+than could be stored in memory at a given time.
+
+ my $lob_id = 17; # Arbitrary row identifier, for example
+
+ $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT chardata
+ FROM lob_example
+ WHERE lob_id = ?
+ SQL
+ $sth->execute( $lob_id );
+ my ( $char_locator ) = $sth->fetchrow_array();
+
+ my $chunk_size = 1034; # Arbitrary chunk size, for example
+ my $offset = 1; # Offsets start at 1, not 0
+ while(1) {
+ my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size );
+ last unless length $data;
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+Notice that the select statement does not contain the phrase
+"FOR UPDATE". Because we are only reading from the LOB
+Locator returned, and not modifying the LOB it refers to,
+the select statement does not require the "FOR UPDATE"
+clause.
+
+A word of caution when using the data returned from an ora_lob_read in a conditional statement.
+for example if the code below;
+
+ while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) {
+ print STDOUT $data;
+ $offset += $chunk_size;
+ }
+
+was used with a chunk size of 4096 against a blob that requires more than 1 chunk to return
+the data and the last chunk is one byte long and contains a zero (ASCII 48) you will miss this last byte
+as $data will contain 0 which PERL will see as false and not print it out.
+
+=head3 Example: Truncating existing large data
+
+In this example, we truncate the data already present in a
+large object column in the database. Specifically, for each
+row in the table, we truncate the 'bindata' value to half
+its previous length.
+
+After acquiring a LOB Locator for the column, we query its
+length, then we trim the length by half. Because we modify
+the large objects with the call to ora_lob_trim(), we must
+select the LOB locators 'FOR UPDATE'.
+
+ my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } );
+ SELECT bindata
+ FROM lob_example
+ FOR UPATE
+ SQL
+ $sth->execute();
+ while( my ( $bin_locator ) = $sth->fetchrow_array() ) {
+ my $binlength = $dbh->ora_lob_length( $bin_locator );
+ if( $binlength > 0 ) {
+ $dbh->ora_lob_trim( $bin_locator, $binlength/2 );
+ }
+ }
+
+=head1 SPACES AND PADDING
+
+=head2 Trailing Spaces
+
+Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder
+values and uses Nonpadded Comparison Semantics with the result.
+This causes trouble if the spaces are needed for
+comparison with a CHAR value or to prevent the value from
+becoming '' which Oracle treats as NULL.
+Look for Blank-padded Comparison Semantics and Nonpadded
+Comparison Semantics in Oracle's SQL Reference or Server
+SQL Reference for more details.
+
+To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8,
+either change the default placeholder type with L</ora_ph_type> or the placeholder
+type for a particular call to L<DBI/bind> or L<DBI/bind_param_inout>
+with L</ora_type> or C<TYPE>.
+Using L<ORA_CHAR> with L<ora_type> or C<SQL_CHAR> with C<TYPE>
+allows the placeholder to be used with Padded Comparison Semantics
+if the value it is being compared to is a CHAR, NCHAR, or literal.
+
+Please remember that using spaces as a value or at the end of
+a value makes visually distinguishing values with different
+numbers of spaces difficult and should be avoided.
+
+Oracle Clients that use OCI 9.2 do not strip trailing spaces.
+
+=head2 Padded Char Fields
+
+Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR.
+As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access this behaviour you will
+have to change the default placeholder type with L</ora_ph_type> or placeholder
+type for a particular call with L<DBI/bind> or L<DBI/bind_param_inout>
+with L</ORA_CHAR>.
+
+=head1 UNICODE
+
+DBD::Oracle now supports Unicode UTF-8. There are, however, a number
+of issues you should be aware of, so please read all this section
+carefully.
+
+In this section we'll discuss "Perl and Unicode", then "Oracle and
+Unicode", and finally "DBD::Oracle and Unicode".
+
+Information about Unicode in general can be found at:
+L<http://www.unicode.org/>. It is well worth reading because there are
+many misconceptions about Unicode and you may be holding some of them.
+
+=head2 Perl and Unicode
+
+Perl began implementing Unicode with version 5.6, but the implementation
+did not mature until version 5.8 and later. If you plan to use Unicode
+you are I<strongly> urged to use Perl 5.8.2 or later and to I<carefully> read
+the Perl documentation on Unicode:
+
+ perldoc perluniintro # in Perl 5.8 or later
+ perldoc perlunicode
+
+And then read it again.
+
+Perl's internal Unicode format is UTF-8
+which corresponds to the Oracle character set called AL32UTF8.
+
+=head2 Oracle and Unicode
+
+Oracle supports many characters sets, including several different forms
+of Unicode. These include:
+
+ AL16UTF16 => valid for NCHAR columns (CSID=2000)
+ UTF8 => valid for NCHAR columns (CSID=871), deprecated
+ AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873)
+
+When you create an Oracle database, you must specify the DATABASE
+character set (used for DDL, DML and CHAR datatypes) and the NATIONAL
+character set (used for NCHAR and NCLOB types).
+The character sets used in your database can be found using:
+
+ $hash_ref = $dbh->ora_nls_parameters()
+ $database_charset = $hash_ref->{NLS_CHARACTERSET};
+ $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET};
+
+The Oracle 9.2 and later default for the national character set is AL16UTF16.
+The default for the database character set is often US7ASCII.
+Although many experienced DBAs will consider an 8bit character set like
+WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle
+other than US7ASCII, requires that the NLS_LANG environment variable be set.
+See the L<"Oracle UTF8 is not UTF-8"> section below.
+
+You are strongly urged to read the Oracle Internationalization documentation
+specifically with respect the choices and trade offs for creating
+a databases for use with international character sets.
+
+Oracle uses the NLS_LANG environment variable to indicate what
+character set is being used on the client. When fetching data Oracle
+will convert from whatever the database character set is to the client
+character set specified by NLS_LANG. Similarly, when sending data to
+the database Oracle will convert from the character set specified by
+NLS_LANG to the database character set.
+
+The NLS_NCHAR environment variable can be used to define a different
+character set for 'national' (NCHAR) character types.
+
+Both UTF8 and AL32UTF8 can be used in NLS_LANG and NLS_NCHAR.
+For example:
+
+ NLS_LANG=AMERICAN_AMERICA.UTF8
+ NLS_LANG=AMERICAN_AMERICA.AL32UTF8
+ NLS_NCHAR=UTF8
+ NLS_NCHAR=AL32UTF8
+
+=head2 Oracle UTF8 is not UTF-8
+
+AL32UTF8 should be used in preference to UTF8 if it works for you,
+which it should for Oracle 9.2 or later. If you're using an old
+version of Oracle that doesn't support AL32UTF8 then you should
+avoid using any Unicode characters that require surrogates, in other
+words characters beyond the Unicode BMP (Basic Multilingual Plane).
+
+That's because the character set that Oracle calls "UTF8" doesn't
+conform to the UTF-8 standard in its handling of surrogate characters.
+Technically the encoding that Oracle calls "UTF8" is known as "CESU-8".
+Here are a couple of extracts from L<http://www.unicode.org/reports/tr26/>:
+
+ CESU-8 is useful in 8-bit processing environments where binary
+ collation with UTF-16 is required. It is designed and recommended
+ for use only within products requiring this UTF-16 binary collation
+ equivalence. It is not intended nor recommended for open interchange.
+
+ As a very small percentage of characters in a typical data stream
+ are expected to be supplementary characters, there is a strong
+ possibility that CESU-8 data may be misinterpreted as UTF-8.
+ Therefore, all use of CESU-8 outside closed implementations is
+ strongly discouraged, such as the emittance of CESU-8 in output
+ files, markup language or other open transmission forms.
+
+Oracle uses this internally because it collates (sorts) in the same order
+as UTF16, which is the basis of Oracle's internal collation definitions.
+
+Rather than change UTF8 for clients Oracle chose to define a new character
+set called "AL32UTF8" which does conform to the UTF-8 standard.
+(The AL32UTF8 character set can't be used on the server because it
+would break collation.)
+
+Because of that, for the rest of this document we'll use "AL32UTF8".
+If you're using an Oracle version below 9.2 you'll need to use "UTF8"
+until you upgrade.
+
+=head2 DBD::Oracle and Unicode
+
+DBD::Oracle Unicode support has been implemented for Oracle versions 9
+or greater, and Perl version 5.6 or greater (though we I<strongly>
+suggest that you use Perl 5.8.2 or later).
+
+You can check which Oracle version your DBD::Oracle was built with by
+importing the C<ORA_OCI> constant from DBD::Oracle.
+
+B<Fetching Data>
+
+Any data returned from Oracle to DBD::Oracle in the AL32UTF8
+character set will be marked as UTF-8 to ensure correct handling by Perl.
+
+For Oracle to return data in the AL32UTF8 character set the
+NLS_LANG or NLS_NCHAR environment variable I<must> be set as described
+in the previous section.
+
+When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle
+will set the Perl UTF-8 flag on the returned data if either NLS_NCHAR
+is AL32UTF8, or NLS_NCHAR is not set and NLS_LANG is AL32UTF8.
+
+When fetching other character data from Oracle, DBD::Oracle
+will set the Perl UTF-8 flag on the returned data if NLS_LANG is AL32UTF8.
+
+B<Sending Data using Placeholders>
+
+Data bound to a placeholder is assumed to be in the default client
+character set (specified by NLS_LANG) except for a few special
+cases. These are listed here with the highest precedence first:
+
+If the C<ora_csid> attribute is given to bind_param() then that
+is passed to Oracle and takes precedence.
+
+If the value is a Perl Unicode string (UTF-8) then DBD::Oracle
+ensures that Oracle uses the Unicode character set, regardless of
+the NLS_LANG and NLS_NCHAR settings.
+
+If the placeholder is for inserting an NCLOB then the client NLS_NCHAR
+character set is used. (That's useful but inconsistent with the other behaviour
+so may change. Best to be explicit by using the C<ora_csform>
+attribute.)
+
+If the C<ora_csform> attribute is given to bind_param() then that
+determines if the value should be assumed to be in the default
+(NLS_LANG) or NCHAR (NLS_NCHAR) client character set.
+
+ use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR );
+ ...
+ $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR });
+
+or
+
+ $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders
+
+Binding with bind_param_array and execute_array is also UTF-8 compatible in the same way. If you attempt to
+insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert
+will still happen but a error code of 0 will be returned with the following warning;
+
+ DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data.
+ The Query charset id=1, name=US7ASCII
+
+The warning will report the parameter number and the NCHAR setting that the query is running.
+
+B<Sending Data using SQL>
+
+Oracle assumes the SQL statement is in the default client character
+set (as specified by NLS_LANG). So Unicode strings containing
+non-ASCII characters should not be used unless the default client
+character set is AL32UTF8.
+
+=head2 DBD::Oracle and Other Character Sets and Encodings
+
+The only multi-byte Oracle character set supported by DBD::Oracle is
+"AL32UTF8" (and "UTF8"). Single-byte character sets should work well.
+
+=head1 OBJECT & COLLECTION DATA TYPES
+
+Oracle databases allow for the creation of object oriented like user-defined types.
+There are two types of objects, Embedded--an object stored in a column of a regular table
+and REF--an object that uses the REF retrieval mechanism.
+
+DBD::Oracle supports only the 'selection' of embedded objects of the following types OBJECT, VARRAY
+and TABLE in any combination. Support is seamless and recursive, meaning you
+need only supply a simple SQL statement to get all the values in an embedded object.
+You can either get the values as an array of scalars or they can be returned into a DBD::Oracle::Object.
+
+Array example, given this type and table;
+
+ CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30);
+
+ CREATE TABLE "CONTACT"
+ ( "COMPANYNAME" VARCHAR2(40),
+ "ADDRESS" VARCHAR2(100),
+ "PHONE_NUMBERS" "PHONE_NUMBERS"
+ )
+
+The code to access all the data in the table could be something like this;
+
+ my $sth = $dbh->prepare('SELECT * FROM CONTACT');
+ $sth->execute;
+ while ( my ($company, $address, $phone) = $sth->fetchrow()) {
+ print "Company: ".$company."\n";
+ print "Address: ".$address."\n";
+ print "Phone #: ";
+
+ foreach my $items (@$phone){
+ print $items.", ";
+ }
+ print "\n";
+ }
+
+Note that values in PHONE_NUMBERS are returned as an array reference '@$phone'.
+
+As stated before DBD::Oracle will automatically drill into the embedded object and extract
+all of the data as reference arrays of scalars. The example below has OBJECT type embedded in a TABLE type embedded in an
+SQL TABLE;
+
+ CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER;
+
+ CREATE OR REPLACE TYPE STUDENT AS OBJECT(
+ NAME VARCHAR2(60),
+ SOME_GRADES GRADELIST);
+
+ CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT;
+
+ CREATE TABLE GROUPS(
+ GRP_ID NUMBER(4),
+ GRP_NAME VARCHAR2(10),
+ STUDENTS STUDENTS_T)
+ NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB
+ (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB);
+
+The following code will access all of the embedded data;
+
+ $SQL='select grp_id,grp_name,students as my_students_test from groups';
+ $sth=$dbh->prepare($SQL);
+ $sth->execute();
+ while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){
+ print "Group ID#".$grp_id." Group Name =".$grp_name."\n";
+ foreach my $student (@$students){
+ print "Name:".$student->[0]."\n";
+ print "Marks:";
+ foreach my $grades (@$student->[1]){
+ foreach my $marks (@$grades){
+ print $marks.",";
+ }
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+
+Object example, given this object and table;
+
+ CREATE OR REPLACE TYPE Person AS OBJECT (
+ name VARCHAR2(20),
+ age INTEGER)
+ ) NOT FINAL;
+
+ CREATE TYPE Employee UNDER Person (
+ salary NUMERIC(8,2)
+ );
+
+ CREATE TABLE people (id INTEGER, obj Person);
+
+ INSERT INTO people VALUES (1, Person('Black', 25));
+ INSERT INTO people VALUES (2, Employee('Smith', 44, 5000));
+
+The following code will access the data;
+
+ $dbh{'ora_objects'} =>1;
+
+ $sth = $dbh->prepare("select * from people order by id");
+ $sth->execute();
+
+ # object are fetched as instance of DBD::Oracle::Object
+ my ($id1, $obj1) = $sth->fetchrow();
+ my ($id2, $obj2) = $sth->fetchrow();
+
+ # get full type-name of object
+ print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed
+ print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed
+
+ # get attribute NAME from object
+ print $obj1->attr('NAME')."3\n"; # 'Black' is printed
+ print $obj2->attr('NAME')."3\n"; # 'Smith' is printed
+
+ # get all atributes as hash reference
+ my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25}
+ my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44,
+ # 'SALARY' => 5000 }
+
+ # get all attributes (names and values) as array
+ my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25)
+ my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44,
+ # 'SALARY', 5000 )
+
+So far DBD::Oracle has been tested on a table with 20 embedded Objects, Varrays and Tables
+nested to 10 levels.
+
+Any NULL values found in the embedded object will be returned as 'undef'.
+
+=head1 OTHER DATA TYPES
+
+DBD::Oracle does not I<explicitly> support most Oracle datatypes.
+It simply asks Oracle to return them as strings and Oracle does so.
+Mostly. Similarly when binding placeholder values DBD::Oracle binds
+them as strings and Oracle converts them to the appropriate type,
+such as DATE, when used.
+
+Some of these automatic conversions to and from strings use NLS
+settings to control the formatting for output and the parsing for
+input. The most common example is the DATE type. The default NLS
+format for DATE might be DD-MON-YYYY and so when a DATE type is
+fetched that's how Oracle will format the date. NLS settings also
+control the default parsing of strings into DATE values. An error
+will be generated if the contents of the string don't match the
+NLS format. If you're dealing in dates which don't match the default
+NLS format then you can either change the default NLS format or, more
+commonly, use TO_CHAR(field, "format") and TO_DATE(?, "format")
+to explicitly specify formats for converting to and from strings.
+
+A slightly more subtle problem can occur with NUMBER types. The
+default NLS settings might format numbers with a fullstop ("C<.>")
+to separate thousands and a comma ("C<,>") as the decimal point.
+Perl will generate warnings and use incorrect values when numbers,
+returned and formatted as strings in this way by Oracle, are used
+in a numeric context. You could explicitly convert each numeric
+value using the TO_CHAR(...) function but that gets tedious very
+quickly. The best fix is to change the NLS settings. That can be
+done for an individual connection by doing:
+
+ $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'");
+
+There are some types, like BOOLEAN, that Oracle does not automatically
+convert to or from strings (pity). These need to be converted
+explicitly using SQL or PL/SQL functions.
+
+Examples:
+
+ # DATE values
+ my $sth0 = $dbh->prepare( <<SQL_END );
+ SELECT username, TO_CHAR( created, ? )
+ FROM all_users
+ WHERE created >= TO_DATE( ?, ? )
+ SQL_END
+ $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' );
+
+ # BOOLEAN values
+ my $sth2 = $dbh->prepare( <<PLSQL_END );
+ DECLARE
+ b0 BOOLEAN;
+ b1 BOOLEAN;
+ o0 VARCHAR2(32);
+ o1 VARCHAR2(32);
+
+ FUNCTION to_bool( i VARCHAR2 ) RETURN BOOLEAN IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i = 'F' OR i = '0' THEN RETURN FALSE;
+ ELSE RETURN TRUE;
+ END IF;
+ END;
+ FUNCTION from_bool( i BOOLEAN ) RETURN NUMBER IS
+ BEGIN
+ IF i IS NULL THEN RETURN NULL;
+ ELSIF i THEN RETURN 1;
+ ELSE RETURN 0;
+ END IF;
+ END;
+ BEGIN
+ -- Converting values to BOOLEAN
+ b0 := to_bool( :i0 );
+ b1 := to_bool( :i1 );
+
+ -- Converting values from BOOLEAN
+ :o0 := from_bool( b0 );
+ :o1 := from_bool( b1 );
+ END;
+ PLSQL_END
+ my ( $i0, $i1, $o0, $o1 ) = ( "", "Something else" );
+ $sth2->bind_param( ":i0", $i0 );
+ $sth2->bind_param( ":i1", $i1 );
+ $sth2->bind_param_inout( ":o0", \$o0, 32 );
+ $sth2->bind_param_inout( ":o1", \$o1, 32 );
+ $sth2->execute();
+ foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) {
+ $_ = "(undef)" if ! defined $_;
+ }
+ print "$i0 to $o0, $i1 to $o1\n";
+ # Result is : "'' to '(undef)', 'Something else' to '1'"
+
+=head2 Support for Insert of XMLType (ORA_XMLTYPE)
+
+Inserting large XML data sets into tables with XMLType fields is now supported by DBD::Oracle. The only special
+requirement is the use of bind_param() with an attribute hash parameter that specifies ora_type as ORA_XMLTYPE. For
+example with a table like this;
+
+ create table books (book_id number, book_xml XMLType);
+
+one can insert data using this code
+
+ $SQL='insert into books values (1,:p_xml)';
+ $xml= '<Books>
+ <Book id=1>
+ <Title>Programming the Perl DBI</Title>
+ <Subtitle>The Cheetah Book</Subtitle>
+ <Authors>
+ <Author>T. Bunce</Author>
+ <Author>Alligator Descartes</Author>
+ </Authors>
+
+ </Book>
+ <Book id=10000>...
+ </Books>';
+ my $sth =$dbh-> prepare($SQL);
+ $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE });
+ $sth-> execute();
+
+In the above case we will assume that $xml has 10000 Book nodes and is over 32k in size and is well formed XML.
+This will also work for XML that is smaller than 32k as well. Attempting to insert malformed XML will cause an error.
+
+=head2 Binding Cursors
+
+Cursors can be returned from PL/SQL blocks, either from stored
+functions (or procedures with OUT parameters) or
+from direct C<OPEN> statements, as shown below:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types);
+ my $dbh = DBI->connect(...);
+ my $sth1 = $dbh->prepare(q{
+ BEGIN OPEN :cursor FOR
+ SELECT table_name, tablespace_name
+ FROM user_tables WHERE tablespace_name = :space;
+ END;
+ });
+ $sth1->bind_param(":space", "USERS");
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+The only special requirement is the use of C<bind_param_inout()> with an
+attribute hash parameter that specifies C<ora_type> as C<ORA_RSET>.
+If you don't do that you'll get an error from the C<execute()> like:
+"ORA-06550: line X, column Y: PLS-00306: wrong number or types of
+arguments in call to ...".
+
+Here's an alternative form using a function that returns a cursor.
+This example uses the pre-defined weak (or generic) REF CURSOR type
+SYS_REFCURSOR. This is an Oracle 9 feature.
+
+ # Create the function that returns a cursor
+ $dbh->do(q{
+ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR
+ AS l_cursor SYS_REFCURSOR;
+ BEGIN
+ OPEN l_cursor FOR select ename, empno from emp
+ ORDER BY ename;
+ RETURN l_cursor;
+ END;
+ });
+
+ # Use the function that returns a cursor
+ my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
+ my $sth2;
+ $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ $sth1->execute;
+ # $sth2 is now a valid DBI statement handle for the cursor
+ while ( my @row = $sth2->fetchrow_array ) { ... }
+
+A cursor obtained from PL/SQL as above may be passed back to PL/SQL
+by binding for input, as shown in this example, which explicitly
+closes a cursor:
+
+ my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;");
+ $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } );
+ $sth3->execute;
+
+It is not normally necessary to close a cursor explicitly in this
+way. Oracle will close the cursor automatically at the first
+client-server interaction after the cursor statement handle is
+destroyed. An explicit close may be desirable if the reference to the
+cursor handle from the PL/SQL statement handle delays the destruction
+of the cursor handle for too long. This reference remains until the
+PL/SQL handle is re-bound, re-executed or destroyed.
+
+NOTE: From DBD::Oracle 1.57 functions or procedures returning
+SYS_REFCURSORs which have not been opened (are still in the
+initialised state) will return undef for the cursor statement handle
+e.g., in the example above if the sp_ListEmp function simply returned l_cursor
+instead of opening it. This means you can have a function/procedure
+which can elect to open the cursor or not, Before this change if you called
+a function/procedure which returned a SYS_REFCURSOR which was not opened
+DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised
+cursor.
+
+See the C<curref.pl> script in the Oracle.ex directory in the DBD::Oracle
+source distribution for a complete working example.
+
+=head2 Fetching Nested Cursors
+
+Oracle supports the use of select list expressions of type REF CURSOR.
+These may be explicit cursor expressions - C<CURSOR(SELECT ...)>, or
+calls to PL/SQL functions which return REF CURSOR values. The values
+of these expressions are known as nested cursors.
+
+The value returned to a Perl program when a nested cursor is fetched
+is a statement handle. This statement handle is ready to be fetched from.
+It should not (indeed, must not) be executed.
+
+Oracle imposes a restriction on the order of fetching when nested
+cursors are used. Suppose C<$sth1> is a handle for a select statement
+involving nested cursors, and C<$sth2> is a nested cursor handle fetched
+from C<$sth1>. C<$sth2> can only be fetched from while C<$sth1> is
+still active, and the row containing C<$sth2> is still current in C<$sth1>.
+Any attempt to fetch another row from C<$sth1> renders all nested cursor
+handles previously fetched from C<$sth1> defunct.
+
+Fetching from such a defunct handle results in an error with the message
+C<ERROR nested cursor is defunct (parent row is no longer current)>.
+
+This means that the C<fetchall...> or C<selectall...> methods are not useful
+for queries returning nested cursors. By the time such a method returns,
+all the nested cursor handles it has fetched will be defunct.
+
+It is necessary to use an explicit fetch loop, and to do all the
+fetching of nested cursors within the loop, as the following example
+shows:
+
+ use DBI;
+ my $dbh = DBI->connect(...);
+ my $sth = $dbh->prepare(q{
+ SELECT dname, CURSOR(
+ SELECT ename FROM emp
+ WHERE emp.deptno = dept.deptno
+ ORDER BY ename
+ ) FROM dept ORDER BY dname
+ });
+ $sth->execute;
+ while ( my ($dname, $nested) = $sth->fetchrow_array ) {
+ print "$dname\n";
+ while ( my ($ename) = $nested->fetchrow_array ) {
+ print " $ename\n";
+ }
+ }
+
+The cursor returned by the function C<sp_ListEmp> defined in the
+previous section can be fetched as a nested cursor as follows:
+
+ my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual});
+ $sth->execute;
+ my ($nested) = $sth->fetchrow_array;
+ while ( my @row = $nested->fetchrow_array ) { ... }
+
+=head2 Pre-fetching Nested Cursors
+
+By default, DBD::Oracle pre-fetches rows in order to reduce the number of
+round trips to the server. For queries which do not involve nested cursors,
+the number of pre-fetched rows is controlled by the DBI database handle
+attribute C<RowCacheSize> (q.v.).
+
+In Oracle, server side open cursors are a controlled resource, limited in
+number, on a per session basis, to the value of the initialization
+parameter C<OPEN_CURSORS>. Nested cursors count towards this limit.
+Each nested cursor in the current row counts 1, as does
+each nested cursor in a pre-fetched row. Defunct nested cursors do not count.
+
+An Oracle specific database handle attribute, C<ora_max_nested_cursors>,
+further controls pre-fetching for queries involving nested cursors. For
+each statement handle, the total number of nested cursors in pre-fetched
+rows is limited to the value of this parameter. The default value
+is 0, which disables pre-fetching for queries involving nested cursors.
+
+=head1 PL/SQL Examples
+
+Most of these PL/SQL examples come from: Eric Bartley <bartley@cc.purdue.edu>.
+
+ /*
+ * PL/SQL to create package with stored procedures invoked by
+ * Perl examples. Execute using sqlplus.
+ *
+ * Use of "... OR REPLACE" prevents failure in the event that the
+ * package already exists.
+ */
+
+ CREATE OR REPLACE PACKAGE plsql_example
+ IS
+ PROCEDURE proc_np;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ );
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ );
+
+ FUNCTION func_np
+ RETURN VARCHAR2;
+
+ END plsql_example;
+ /
+
+ CREATE OR REPLACE PACKAGE BODY plsql_example
+ IS
+ PROCEDURE proc_np
+ IS
+ whoami VARCHAR2(20) := NULL;
+ BEGIN
+ SELECT USER INTO whoami FROM DUAL;
+ END;
+
+ PROCEDURE proc_in (
+ err_code IN NUMBER
+ )
+ IS
+ BEGIN
+ RAISE_APPLICATION_ERROR(err_code, 'This is a test.');
+ END;
+
+ PROCEDURE proc_in_inout (
+ test_num IN NUMBER,
+ is_odd IN OUT NUMBER
+ )
+ IS
+ BEGIN
+ is_odd := MOD(test_num, 2);
+ END;
+
+ FUNCTION func_np
+ RETURN VARCHAR2
+ IS
+ ret_val VARCHAR2(20);
+ BEGIN
+ SELECT USER INTO ret_val FROM DUAL;
+ RETURN ret_val;
+ END;
+
+ END plsql_example;
+ /
+ /* End PL/SQL for example package creation. */
+
+ use DBI;
+
+ my($db, $csr, $ret_val);
+
+ $db = DBI->connect('dbi:Oracle:database','user','password')
+ or die "Unable to connect: $DBI::errstr";
+
+ # So we don't have to check every DBI call we set RaiseError.
+ # See the DBI docs now if you're not familiar with RaiseError.
+ $db->{RaiseError} = 1;
+
+ # Example 1 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Calling a PLSQL procedure that takes no parameters. This shows you the
+ # basic's of what you need to execute a PLSQL procedure. Just wrap your
+ # procedure call in a BEGIN END; block just like you'd do in SQL*Plus.
+ #
+ # p.s. If you've used SQL*Plus's exec command all it does is wrap the
+ # command in a BEGIN END; block for you.
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_NP;
+ END;
+ });
+ $csr->execute;
+
+
+ # Example 2 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Now we call a procedure that has 1 IN parameter. Here we use bind_param
+ # to bind out parameter to the prepared statement just like you might
+ # do for an INSERT, UPDATE, DELETE, or SELECT statement.
+ #
+ # I could have used positional placeholders (e.g. :1, :2, etc.) or
+ # ODBC style placeholders (e.g. ?), but I prefer Oracle's named
+ # placeholders (but few DBI drivers support them so they're not portable).
+
+ my $err_code = -20001;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN(:err_code);
+ END;
+ });
+
+ $csr->bind_param(":err_code", $err_code);
+
+ # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'.
+ # Because we set RaiseError, the DBI will croak (die) so we catch that with eval.
+ eval {
+ $csr->execute;
+ };
+ print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n";
+
+
+ # Example 3 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # Building on the last example, I've added 1 IN OUT parameter. We still
+ # use a placeholders in the call to prepare, the difference is that
+ # we now call bind_param_inout to bind the value to the place holder.
+ #
+ # Note that the third parameter to bind_param_inout is the maximum size
+ # of the variable. You normally make this slightly larger than necessary.
+ # But note that the Perl variable will have that much memory assigned to
+ # it even if the actual value returned is shorter.
+
+ my $test_num = 5;
+ my $is_odd;
+
+ $csr = $db->prepare(q{
+ BEGIN
+ PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd);
+ END;
+ });
+
+ # The value of $test_num is _copied_ here
+ $csr->bind_param(":test_num", $test_num);
+
+ $csr->bind_param_inout(":is_odd", \$is_odd, 1);
+
+ # The execute will automagically update the value of $is_odd
+ $csr->execute;
+
+ print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n";
+
+
+ # Example 4 Eric Bartley <bartley@cc.purdue.edu>
+ #
+ # What about the return value of a PLSQL function? Well treat it the same
+ # as you would a call to a function from SQL*Plus. We add a placeholder
+ # for the return value and bind it with a call to bind_param_inout so
+ # we can access it's value after execute.
+
+ my $whoami = "";
+
+ $csr = $db->prepare(q{
+ BEGIN
+ :whoami := PLSQL_EXAMPLE.FUNC_NP;
+ END;
+ });
+
+ $csr->bind_param_inout(":whoami", \$whoami, 20);
+ $csr->execute;
+ print "Your database user name is $whoami\n";
+
+ $db->disconnect;
+
+You can find more examples in the t/plsql.t file in the DBD::Oracle
+source directory.
+
+Oracle 9.2 appears to have a bug where a variable bound
+with bind_param_inout() that isn't assigned to by the executed
+PL/SQL block may contain garbage.
+See L<http://www.mail-archive.com/dbi-users@perl.org/msg18835.html>
+
+=head2 Avoid Using "SQL Call"
+
+Avoid using the "SQL Call" statement with DBD:Oracle as you might find that
+DBD::Oracle will not raise an exception in some case. Specifically if you use
+"SQL Call" to run a procedure all "No data found" exceptions will be quietly
+ignored and returned as null. According to Oracle support this is part of the same
+mechanism where;
+
+ select (select * from dual where 0=1) from dual
+
+returns a null value rather than an exception.
+
+=head1 CONTRIBUTING
+
+If you'd like DBD::Oracle to do something new or different the best way
+to make that happen is to do it yourself and email to dbi-dev@perl.org a
+patch of the source code (using 'diff' - see below) that shows the changes.
+
+=head2 How to create a patch using Subversion
+
+The DBD::Oracle source code is maintained using Subversion (a replacement
+for CVS, see L<http://subversion.tigris.org/>). To access the source
+you'll need to install a Subversion client. Then, to get the source
+code, do:
+
+ svn checkout http://svn.perl.org/modules/dbd-oracle/trunk
+
+If it prompts for a username and password use your perl.org account
+if you have one, else just 'guest' and 'guest'. The source code will
+be in a new subdirectory called C<trunk>.
+
+To keep informed about changes to the source you can send an empty email
+to dbd-oracle-changes-subscribe@perl.org after which you'll get an email with the
+change log message and diff of each change checked-in to the source.
+
+After making your changes you can generate a patch file, but before
+you do, make sure your source is still upto date using:
+
+ svn update
+
+If you get any conflicts reported you'll need to fix them first.
+Then generate the patch file from within the C<trunk> directory using:
+
+ svn diff > foo.patch
+
+Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org.
+
+=head2 How to create a patch without Subversion
+
+Unpack a fresh copy of the distribution:
+
+ tar xfz DBD-Oracle-1.40.tar.gz
+
+Rename the newly created top level directory:
+
+ mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo
+
+Edit the contents of DBD-Oracle-1.40.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 DBD-Oracle-1.40.tar.gz
+
+Then create a patch file by performing a recursive C<diff> on the two
+top level directories:
+
+ diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.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.
+
+=head2 GitHub repository
+
+A git mirror of the subversion is also available at
+`https://github.com/yanick/DBD-Oracle`.
+
+=head1 WHICH VERSION OF DBD::ORACLE IS FOR ME?
+
+From version 1.25 onwards DBD::Oracle only support Oracle clients
+9.2 or greater. Support for ProC connections was dropped in 1.29.
+
+If you are still stuck with an older version of Oracle or its client you might want to look at the table below.
+
+ +---------------------+-----------------------------------------------------+
+ | | Oracle Version |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 0.1~16 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.17 | Y | Y | Y | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.18 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.19 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.20 | N | N | N | Y | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.21~1.24 | N | N | N | N | Y | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+ | 1.25+ | N | N | N | N | N | Y |
+ +---------------------+----+-------------+---------+------+--------+--------+
+
+As there are dozens of different versions of Oracle's clients this
+list does not include all of them, just the major released versions of
+Oracle.
+
+Note that one can still connect to any Oracle version with the older
+DBD::Oracle versions the only problem you will have is that some of
+the newer OCI and Oracle features available in later DBD::Oracle
+releases will not be available to you.
+
+So to make a short story a little longer:
+
+=over
+
+=item 1
+
+If you are using Oracle 7 or early 8 DB and you can manage to get a 9 client and you can use
+any DBD::Oracle version.
+
+=item 2
+
+If you have to use an Oracle 7 client then DBD::Oracle 1.17 should work
+
+=item 3
+
+Same thing for 8 up to R2, use 1.17, if you are lucky and have the right patch-set you might
+go with 1.18.
+
+=item 4
+
+For 8iR3 you can use any of the DBD::Oracle versions up to 1.21. Again this depends on your
+patch-set, If you run into trouble go with 1.19
+
+=item 5
+
+After 9.2 you can use any version you want.
+
+=item 6
+
+It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go back to 7
+and even get to 10. I am not sure what the 11g client can connect to.
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+There is a known problem with the 11.2g Oracle client and the
+C<DBMS_LOB.GETLENGTH()> PL/SQL function.
+See L<https://rt.cpan.org/Public/Bug/Display.html?id=69350> for the details.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<DBI>
+
+http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in
+the DBD::Oracle source distribution including the examples in the
+Oracle.ex directory
+
+=item DBD::Oracle Tutorial
+
+http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-oracle.html
+
+=item Oracle Instant Client
+
+http://www.oracle.com/technology/tech/oci/instantclient/index.html
+
+=item Oracle on Linux
+
+http://www.ixora.com.au/
+
+=item Free Oracle Tools and Links
+
+ora_explain supplied and installed with DBD::Oracle.
+
+http://www.orafaq.com/
+
+http://vonnieda.org/oracletool/
+
+=item Commercial Oracle Tools and Links
+
+Assorted tools and references for general information.
+No recommendation implied.
+
+http://www.platinum.com
+
+http://www.SoftTreeTech.com
+
+Also PL/Vision from RevealNet and Steven Feuerstein, and
+"Q" from Savant Corporation.
+
+=back
+
+=head1 AUTHORS
+
+DBI by Tim Bunce L<http://www.tim.bunce.name>.
+
+The original C<DBD::Oracle> was by Tim Bunce.
+Maintained as of release 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the
+auspice of the Pythian Group (L<http://www.pythian.com>).
+
+=head1 ACKNOWLEDGEMENTS
+
+A great many people have helped with DBD::Oracle over the 17 years
+between 1994 and 2011. Far too many to name, but we thank them all.
+Many are named in the Changes file.
+
+=head1 COPYRIGHT
+
+The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland.
+The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The Pythian Group). Canada.
+The DBD::Oracle module is Copyright (c) 2011 John Scoles. Canada.
+
+The DBD::Oracle module is free open source software; you can
+redistribute it and/or modify it under the same terms as Perl 5.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Tim Bunce <timb@cpan.org>
+
+=item *
+
+John Scoles <byterock@cpan.org>
+
+=item *
+
+Yanick Champoux <yanick@cpan.org>
+
+=item *
+
+Martin J. Evans <mjevans@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994 by Tim Bunce.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
@@ -0,0 +1,108 @@
+#!/bin/env perl -w
+
+# mkta - make-test-all
+#
+# quick hack to run test suite against multiple dbs
+# for each db runn alternate charset tests in parallel
+# keep log files from failures
+
+use strict;
+use Symbol;
+
+local $| = 1;
+
+use DBI;
+use DBD::Oracle qw(ORA_OCI);
+my @sid = DBI->data_sources('Oracle');
+s/^dbi:Oracle://i for @sid;
+
+# set TEST_FILES env var to override which tests are run
+my $opt_full = 1;
+my $opt_dir = "mkta";
+my $opt_tf = $ENV{TEST_FILES};
+my $opt_j = 6;
+
+my $seq = 0;
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my (@queue, @run, %running, %skipped, @fail, $tested);
+
+my @cs_utf8 = (ORA_OCI() < 9.2) ? ("UTF8") : ("AL32UTF8", ($opt_full) ? ("UTF8") : ());
+my @cs_8bit = ($opt_full) ? ("WE8ISO8859P1", "WE8MSWIN1252") : ("WE8MSWIN1252");
+my @charsets = ("", @cs_utf8, @cs_8bit);
+
+# need to add in:
+# multiple perl versions/achitectures
+# multiple oracle versions
+
+for my $sid (@sid) {
+ mkta_sid_cs($sid, \@charsets);
+}
+
+sub mkta_sid_cs {
+ my ($sid, $charsets) = @_;
+ my $start_time = time;
+
+ local $ENV{ORACLE_SID} = $sid;
+ my $dbh = DBI->connect("dbi:Oracle:", $dbuser, undef, { PrintError=>0 });
+ unless ($dbh) {
+ (my $errstr = $DBI::errstr) =~ s/\n.*//s;
+ push @{ $skipped{$errstr} }, $sid;
+ return;
+ }
+ mkdir $opt_dir, 0771 unless -d $opt_dir;
+ print "$sid: testing with @$charsets ...\n";
+
+ system("make") == 0
+ or die "$0 aborted - make failed\n";
+ system("rm -f $opt_dir/$sid-*-*.log");
+
+ for my $ochar (@$charsets) {
+ for my $nchar (@$charsets) {
+ # because empty NLS_NCHAR is same as NLS_LANG charset
+ next if $nchar eq '' && $ochar ne '';
+ push @queue, [ $sid, $ochar, $nchar ];
+ }
+ }
+ while (@queue) {
+ while (@queue && keys %running < $opt_j) {
+ my ($tag, $fh) = start_test(@{ shift @queue });
+ $running{$tag} = $fh;
+ push @run, $tag;
+ ++$tested;
+ }
+ wait_for_tests();
+ }
+ wait_for_tests();
+ printf "$sid: completed in %.1f minutes\n", (time-$start_time)/60;
+ print "\n";
+}
+
+sub start_test {
+ my ($sid, $ochar, $nchar) = @_;
+ local $ENV{NLS_LANG} = ($ochar) ? ".$ochar" : "";
+ local $ENV{NLS_NCHAR} = ($nchar) ? $nchar : "";
+ local $ENV{DBD_ORACLE_SEQ} = ++$seq; # unique id for parallel runs
+ my $tag = join "-", map { $_ || "unset" } ($sid, $ochar, $nchar);
+ my $fh = gensym();
+ my @make_opts;
+ push @make_opts, "TEST_FILES='$opt_tf'" if $opt_tf;
+ open $fh, "make test @make_opts > $opt_dir/$tag.log 2>&1 && rm $opt_dir/$tag.log |";
+ print "$tag: started\n";
+ return ($tag, $fh);
+}
+
+sub wait_for_tests {
+ while(%running) {
+ my @running = grep { $running{$_} } @run;
+ my $tag = $running[0] or die;
+ close $running{ $tag };
+ printf "$tag: %s\n", ($?) ? "FAILED" : "pass";
+ push @fail, $tag if $?;
+ delete $running{$tag};
+ }
+}
+
+print "Skipped due to $_: @{ $skipped{$_} }\n" for keys %skipped;
+
+printf "Failed %d out of %d: @fail\n", scalar @fail, $tested;
+print "done.\n"
@@ -7,6 +7,8 @@
;
LIBRARY OCI.dll
EXPORTS
+OCILobGetChunkSize
+OCINlsCharSetIdToName
OCIAQDeq
OCIAQEnq
OCIAttrGet
@@ -32,6 +34,8 @@ OCICollGetElem
OCICollMax
OCICollSize
OCICollTrim
+OCIDBStartup
+OCIDBShutdown
OCIDateAddDays
OCIDateAddMonths
OCIDateAssign
@@ -89,6 +93,7 @@ OCILobLocatorIsInit
OCILobRead
OCILobTrim
OCILobWrite
+OCILobWriteAppend
OCILogoff
OCILogon
OCINumberAbs
@@ -223,12 +228,14 @@ OCISecurity_PKEncrypt
OCIServerAttach
OCIServerDetach
OCIServerVersion
+OCIServerRelease
OCISessionBegin
OCISessionEnd
OCIStmtBindByName
OCIStmtBindByPos
OCIStmtExecute
OCIStmtFetch
+OCIStmtFetch2
OCIStmtGetBindInfo
OCIStmtGetPieceInfo
OCIStmtPrepare
@@ -366,3 +373,21 @@ orol
ortgcty
osetpi
osql3
+OCINlsEnvironmentVariableGet
+OCIEnvNlsCreate
+OCINlsCharSetNameToId
+OCILobIsTemporary
+OCILobFreeTemporary
+OCILobLocatorAssign
+OCILobCreateTemporary
+OCIXMLTypeCreateFromSrc
+OCIDateTimeToText
+OCIIntervalToText
+OCIDateTimeGetTimeZoneOffset
+OCIPing
+OCISessionRelease
+OCISessionPoolDestroy
+OCISessionPoolCreate
+OCISessionGet
+OCISessionPoolDestroy
+
@@ -1,561 +0,0 @@
-/*
- $Id: oci7.c,v 1.16 2003/03/13 14:28:50 timbo Exp $
-
- Copyright (c) 1994,1995,1996,1997,1998,1999 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,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
-
-*/
-
-#include "Oracle.h"
-
-
-#ifdef OCI_V8_SYNTAX
-
- /* see oci8.c */
-
-#else
-
-DBISTATE_DECLARE;
-
-/* JLU: Looks like these are being moved to imp_drh... */
-#if 0
-static SV *ora_long;
-static SV *ora_trunc;
-static SV *ora_cache;
-static SV *ora_cache_o; /* for ora_open() cache override */
-#endif
-
-void
- dbd_init_oci(dbistate_t *dbistate)
-{
- DBIS = dbistate;
-}
-
-void
- dbd_init_oci_drh(imp_drh_t * imp_drh)
-{
- imp_drh->ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI);
- imp_drh->ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI);
- imp_drh->ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI);
- imp_drh->ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI);
-}
-
-
-void
-ora_error(h, lda, rc, what)
- SV *h;
- Lda_Def *lda;
- int rc;
- char *what;
-{
- D_imp_xxh(h);
- SV *errstr = DBIc_ERRSTR(imp_xxh);
- sv_setiv(DBIc_ERR(imp_xxh), (IV)rc); /* set err early */
- if (lda) { /* is oracle error (allow for non-oracle errors) */
- int len;
- char msg[1024];
- /* Oracle oerhms can do duplicate free if connect fails. */
- /* Ignore 'with different width due to prototype' gcc warning */
- oerhms(lda, rc, (text*)msg, sizeof(msg)); /* may hang! */
- len = strlen(msg);
- if (len && msg[len-1] == '\n')
- msg[len-1] = '\0'; /* trim off \n from end of message */
- sv_setpv(errstr, (char*)msg);
- if (what) {
- sv_catpv(errstr, " (DBD: ");
- sv_catpv(errstr, what);
- sv_catpv(errstr, ")");
- }
- }
- else sv_setpv(errstr, what);
- DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), errstr);
-}
-
-
-int
-dbd_describe(h, imp_sth)
- SV *h;
- imp_sth_t *imp_sth;
-{
- static sb4 *f_cbufl; /* XXX not thread safe */
- static U32 f_cbufl_max;
-
- D_imp_dbh_from_sth;
- D_imp_drh_from_dbh;
- I32 long_buflen;
- sb1 *cbuf_ptr;
- int t_cbufl=0;
- I32 num_fields;
- int has_longs = 0;
- int est_width = 0; /* estimated avg row width (for cache) */
- int i = 0;
-
-
- if (imp_sth->done_desc)
- return 1; /* success, already done it */
- imp_sth->done_desc = 1;
-
- /* ora_trunc is checked at fetch time */
- /* long_buflen: length for long/longraw (if >0), else 80 (ora app dflt) */
- /* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */
- long_buflen = (SvOK(imp_drh->ora_long) && SvIV(imp_drh->ora_long)>0)
- ? SvIV(imp_drh->ora_long) : DBIc_LongReadLen(imp_sth);
- if (long_buflen < 0) /* trap any sillyness */
- long_buflen = 80; /* typical oracle app default */
-
-#ifndef FT_SELECT
-#define FT_SELECT 4
-#endif
- if (imp_sth->cda->ft != FT_SELECT) {
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " dbd_describe skipped for non-select (sql f%d, lb %ld, csr 0x%lx)\n",
- imp_sth->cda->ft, (long)long_buflen, (long)imp_sth->cda);
- /* imp_sth memory was cleared when created so no setup required here */
- return 1;
- }
-
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " dbd_describe (for sql f%d after oci f%d, lb %ld, csr 0x%lx)...\n",
- imp_sth->cda->ft, imp_sth->cda->fc, (long)long_buflen, (long)imp_sth->cda);
-
- if (!f_cbufl) {
- f_cbufl_max = 120;
- New(1, f_cbufl, f_cbufl_max, sb4);
- }
-
- /* number of rows to cache */
- if (SvOK(imp_drh->ora_cache_o)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o);
- else if (SvOK(imp_drh->ora_cache)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache);
- else imp_sth->cache_rows = imp_dbh->RowCacheSize;
-
- /* Get number of fields and space needed for field names */
- while(++i) { /* break out within loop */
- sb1 cbuf[257]; /* generous max column name length */
- sb2 dbtype = 0; /* workaround for Oracle bug #405032 */
- sb4 dbsize;
- if (i >= f_cbufl_max) {
- f_cbufl_max *= 2;
- Renew(f_cbufl, f_cbufl_max, sb4);
- }
- f_cbufl[i] = sizeof(cbuf);
- odescr(imp_sth->cda, i, &dbsize, &dbtype,
- cbuf, &f_cbufl[i], (sb4*)0, (sb2*)0, (sb2*)0, (sb2*)0);
- if (imp_sth->cda->rc || dbtype == 0)
- break;
- t_cbufl += f_cbufl[i];
-
- /* now we calculate the approx average on-the-wire width of */
- /* each field (and thus row) to determine a 'good' cache size. */
- if (imp_sth->cache_rows > 0)
- continue; /* no need, user specified a size */
- if (dbsize==0) { /* is a LONG type or 'select NULL' */
- if (OTYPE_IS_LONG(dbtype)) {
- est_width += long_buflen;
- ++has_longs; /* hint to auto cache sizing code */
- }
- }
- else /* deal with dbtypes with overblown dbsizes */
- switch(dbtype) {
- case 1: /* VARCHAR2 - result of to_char() has dbsize==75 */
- /* for all but small strings we take off 25% */
- est_width += (dbsize < 32) ? dbsize : dbsize-(dbsize>>2);
- break;
- case 2: /* NUMBER - e.g., from a sum() or max(), dbsize==22 */
- /* Most numbers are _much_ smaller than 22 bytes */
- est_width += 4; /* > approx +/- 1_000_000 ? */
- break;
- default: est_width += dbsize;
- break;
- }
- }
- if (imp_sth->cda->rc && imp_sth->cda->rc != 1007) {
- D_imp_dbh_from_sth;
- ora_error(h, imp_dbh->lda, imp_sth->cda->rc, "odescr failed");
- return 0;
- }
- imp_sth->cda->rc = 0;
- num_fields = i - 1;
- DBIc_NUM_FIELDS(imp_sth) = num_fields;
-
- /* --- Setup the row cache for this query --- */
-
- /* Use guessed average on-the-wire row width calculated above */
- /* and add in overhead of 5 bytes per field plus 8 bytes per row. */
- /* The n*5+8 was determined by studying SQL*Net v2 packets. */
- /* It could probably benefit from a more detailed analysis. */
- est_width += num_fields*5 + 8;
-
- if (has_longs) /* override/disable caching */
- imp_sth->cache_rows = 1; /* else read_blob can't work */
-
- else if (imp_sth->cache_rows < 1) { /* automatically size the cache */
- int txfr_size;
- /* 0 == try to pick 'optimal' cache for this query (default) */
- /* <0 == base cache on target transfer size of -n bytes. */
- if (imp_sth->cache_rows == 0) {
- /* Oracle packets on ethernet have max size of around 1460. */
- /* We'll aim to fill our row cache with slightly less than */
- /* two packets (to err on the safe side and avoid a third */
- /* almost empty packet being generated in some cases). */
- txfr_size = 1460 * 3.6; /* default transfer/cache size */
- }
- else { /* user is specifying desired transfer size in bytes */
- txfr_size = -imp_sth->cache_rows;
- }
- imp_sth->cache_rows = txfr_size / est_width; /* maybe 1 or 0 */
- /* To ensure good performance with large rows (near or larger */
- /* than our target transfer size) we set a minimum cache size. */
- if (imp_sth->cache_rows < 6) /* is cache a 'useful' size? */
- imp_sth->cache_rows = (imp_sth->cache_rows>0) ? 6 : 4;
- }
- if (imp_sth->cache_rows > 32767) /* keep within Oracle's limits */
- imp_sth->cache_rows = 32767;
- /* Initialise cache counters */
- imp_sth->in_cache = 0;
- imp_sth->eod_errno = 0;
-
-
- /* allocate field buffers */
- Newz(42, imp_sth->fbh, num_fields, imp_fbh_t);
- /* allocate a buffer to hold all the column names */
- Newz(42, imp_sth->fbh_cbuf, t_cbufl + num_fields, char);
-
- cbuf_ptr = (sb1*)imp_sth->fbh_cbuf;
- for(i=1; i <= num_fields && imp_sth->cda->rc != 10; ++i) {
- imp_fbh_t *fbh = &imp_sth->fbh[i-1];
- fb_ary_t *fb_ary;
- sb4 defin_len;
-
- fbh->imp_sth = imp_sth;
- fbh->name = (char*)cbuf_ptr;
- fbh->cbufl = f_cbufl[i];
- /* DESCRIBE */
- odescr(imp_sth->cda, i,
- &fbh->dbsize, &fbh->dbtype, (sb1*)fbh->name, &fbh->cbufl,
- &fbh->disize, &fbh->prec, &fbh->scale, &fbh->nullok);
- fbh->name[fbh->cbufl] = '\0'; /* ensure null terminated */
- cbuf_ptr += fbh->cbufl + 1; /* increment name pointer */
-
- /* Now define the storage for this field data. */
-
- if (fbh->dbtype==23) { /* RAW type */
- if (fbh->prec == 0) { fbh->prec = fbh->dbsize; }
- fbh->dbsize *= 2;
- fbh->disize *= 2;
- }
- else if ((fbh->dbtype == 1 || fbh->dbtype == 96) && fbh->prec == 0) {
- fbh->prec = fbh->dbsize;
- }
-
- if (OTYPE_IS_LONG(fbh->dbtype)) {
- long lbl;
- if (fbh->dbtype==24 || fbh->dbtype==95) {
- lbl = long_buflen * 2;
- fbh->ftype = 95; /* get long in var raw form */
- }
- else {
- lbl = long_buflen;
- fbh->ftype = 94; /* get long in var form */
- }
- fbh->dbsize = lbl;
- fbh->disize = lbl;
- defin_len = fbh->disize + 4;
-
- } else {
- /* for the time being we fetch everything (except longs) */
- /* as strings, that'll change (IV, NV and binary data etc) */
- fbh->ftype = 5; /* oraperl used 5 'STRING' */
- defin_len = fbh->disize + 1; /* +1: STRING null */
- }
- /* dbsize can be zero for 'select NULL ...' */
- imp_sth->t_dbsize += fbh->dbsize;
-
- fbh->fb_ary = fb_ary = fb_ary_alloc(defin_len, imp_sth->cache_rows);
-
- /* DEFINE output column variable storage */
- if (odefin(imp_sth->cda, i, fb_ary->abuf, defin_len,
- fbh->ftype, -1, fb_ary->aindp, (text*)0, -1, -1,
- fb_ary->arlen, fb_ary->arcode)) {
- warn("odefin error on %s: %d", fbh->name, imp_sth->cda->rc);
- }
-
- if (DBIS->debug >= 2)
- dbd_fbh_dump(fbh, i, 0);
- }
- imp_sth->est_width = est_width;
-
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " dbd_describe'd %d columns (Row bytes: %d max, %d est avg. Cache: %d rows)\n",
- (int)num_fields, imp_sth->t_dbsize, est_width, imp_sth->cache_rows);
-
- if (imp_sth->cda->rc && imp_sth->cda->rc != 1007) {
- D_imp_dbh_from_sth;
- ora_error(h, imp_dbh->lda, imp_sth->cda->rc, "odescr failed");
- return 0;
- }
-
- return 1;
-}
-
-
-AV *
-dbd_st_fetch(sth, imp_sth)
- SV * sth;
- imp_sth_t *imp_sth;
-{
- int debug = DBIS->debug;
- int num_fields;
- int ChopBlanks;
- int err = 0;
- int i;
- AV *av;
- D_imp_dbh_from_sth;
- D_imp_drh_from_dbh;
-
- if (!imp_sth->in_cache) { /* refill cache if empty */
- int previous_rpc;
-
- /* Check that execute() was executed sucessfully. This also implies */
- /* that dbd_describe() executed sucessfuly so the memory buffers */
- /* are allocated and bound. */
- if ( !DBIc_ACTIVE(imp_sth) ) {
- ora_error(sth, NULL, 1, "no statement executing (perhaps you need to call execute first)");
- return Nullav;
- }
-
- if (imp_sth->eod_errno) {
- end_of_data:
- { dTHR; /* for DBIc_ACTIVE_off */
- DBIc_ACTIVE_off(imp_sth); /* eg finish */
- }
- if (imp_sth->eod_errno != 1403) { /* was not just end-of-fetch */
- ora_error(sth, imp_sth->cda, imp_sth->eod_errno, "cached ofetch error");
- } else { /* is simply no more data */
- sv_setiv(DBIc_ERR(imp_sth), 0); /* ensure errno set to 0 here */
- if (debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_fetch no-more-data, rc=%d, rpc=%ld\n",
- imp_sth->cda->rc, (long)imp_sth->cda->rpc);
- }
- /* further fetches without an execute will arrive back here */
- return Nullav;
- }
-
- previous_rpc = imp_sth->cda->rpc; /* remember rpc before re-fetch */
- if (ofen(imp_sth->cda, imp_sth->cache_rows)) {
- /* Note that errors may happen after one or more rows have been */
- /* added to the cache. We record the error but don't handle it till */
- /* the cache is empty (which may be at once if no rows returned). */
- imp_sth->eod_errno = imp_sth->cda->rc; /* store rc for later */
- if (imp_sth->cda->rpc == previous_rpc) /* no more rows fetched */
- goto end_of_data;
- /* else fall through and return the first of the fetched rows */
- }
- imp_sth->next_entry = 0;
- imp_sth->in_cache = imp_sth->cda->rpc - previous_rpc;
- if (debug >= 4)
- PerlIO_printf(DBILOGFP,
- " dbd_st_fetch load-cache: prev rpc %d, new rpc %ld, in_cache %d\n",
- previous_rpc, (long)imp_sth->cda->rpc, imp_sth->in_cache);
- assert(imp_sth->in_cache > 0);
- }
-
- av = DBIS->get_fbav(imp_sth);
- num_fields = AvFILL(av)+1;
-
- if (debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields, rpc %ld (cache: %d/%d/%d)\n",
- num_fields, (long)imp_sth->cda->rpc, imp_sth->next_entry,
- imp_sth->in_cache, imp_sth->cache_rows);
-
- ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks);
-
- for(i=0; i < num_fields; ++i) {
- imp_fbh_t *fbh = &imp_sth->fbh[i];
- int cache_entry = imp_sth->next_entry;
- fb_ary_t *fb_ary = fbh->fb_ary;
- int rc = fb_ary->arcode[cache_entry];
- SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */
- ub4 datalen;
-
- if (rc == 1406 && OTYPE_IS_LONG(fbh->ftype)) {
- /* We have a LONG field which has been truncated. */
- int oraperl = DBIc_COMPAT(imp_sth);
- if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh->ora_trunc))) {
- /* user says truncation is ok */
- /* Oraperl recorded the truncation in ora_errno so we */
- /* so also but only for Oraperl mode handles. */
- if (oraperl)
- sv_setiv(DBIc_ERR(imp_sth), (IV)rc);
- rc = 0; /* but don't provoke an error here */
- }
- /* else fall through and let rc trigger failure below */
- }
-
- if (rc == 0) { /* the normal case */
- char *p;
- if (fbh->ftype == 94 || fbh->ftype == 95) { /* LONG VAR */
- p = (char*)&fb_ary->abuf[cache_entry * fb_ary->bufl];
- datalen = *(ub4*)p; /* XXX alignment ? */
- p += 4;
- sv_setpvn(sv, p, (STRLEN)datalen);
- }
- else {
- datalen = fb_ary->arlen[cache_entry];
- p = (char*)&fb_ary->abuf[cache_entry * fb_ary->bufl];
- /* if ChopBlanks check for Oracle CHAR type (blank padded) */
- if (ChopBlanks && fbh->dbtype == 96) {
- while(datalen && p[datalen - 1]==' ')
- --datalen;
- }
- sv_setpvn(sv, p, (STRLEN)datalen);
- }
-
- } else if (rc == 1405) { /* field is null - return undef */
- datalen = 0;
- (void)SvOK_off(sv);
-
- } else { /* See odefin rcode arg description in OCI docs */
- char buf[200];
- char *hint = "";
- datalen = 0;
- /* These may get more case-by-case treatment eventually. */
- if (rc == 1406) { /* field truncated (see above) */
- if (OTYPE_IS_LONG(fbh->ftype)) { /* double check */
- hint = (DBIc_LongReadLen(imp_sth) > 65535)
- ? ", DBI attribute LongTruncOk not set and/or LongReadLen too small or > 65535 max"
- : ", DBI attribute LongTruncOk not set and/or LongReadLen too small";
- }
- else {
- /* Copy the truncated value anyway, it may be of use, */
- /* but it'll only be accessible via prior bind_column() */
- sv_setpvn(sv, (char*)&fb_ary->abuf[cache_entry * fb_ary->bufl],
- fb_ary->arlen[cache_entry]);
- }
- }
- else {
- (void*)SvOK_off(sv); /* set field that caused error to undef */
- }
- ++err; /* 'fail' this fetch but continue getting fields */
- /* Some should probably be treated as warnings but */
- /* for now we just treat them all as errors */
- sprintf(buf,"ORA-%05d error on field %d of %d, ora_type %d%s",
- rc, i+1, num_fields, fbh->dbtype, hint);
- ora_error(sth, imp_sth->cda, rc, buf);
- }
-
- if (debug >= 5)
- PerlIO_printf(DBILOGFP, " %d (rc=%d, otype %d, len %lu): %s\n",
- i, rc, fbh->dbtype, (unsigned long)datalen, neatsvpv(sv,0));
- }
-
- /* update cache counters */
- if (ora_fetchtest) /* unless we're testing performance */
- --ora_fetchtest;
- else {
- --imp_sth->in_cache;
- ++imp_sth->next_entry;
- }
-
- return (err) ? Nullav : av;
-}
-
-
-/* ------------------------------------------------------------ */
-
-
-
-int
-dbd_st_prepare(sth, imp_sth, statement, attribs)
- SV *sth;
- imp_sth_t *imp_sth;
- char *statement;
- SV *attribs;
-{
- D_imp_dbh_from_sth;
- ub4 oparse_lng = 1; /* auto v6 or v7 as suits db connected to */
-
- if (!DBIc_ACTIVE(imp_dbh)) {
- ora_error(sth, NULL, -1, "Database disconnected");
- return 0;
- }
-
- imp_sth->done_desc = 0;
-
- if (DBIc_COMPAT(imp_sth)) {
- static SV *ora_pad_empty;
- if (!ora_pad_empty) {
- ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty", GV_ADDMULTI);
- if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY"))
- sv_setiv(ora_pad_empty, atoi(getenv("ORAPERL_PAD_EMPTY")));
- }
- imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ? SvIV(ora_pad_empty) : 0;
- }
-
- if (attribs) {
- SV **svp;
- DBD_ATTRIB_GET_IV( attribs, "ora_parse_lang", 14, svp, oparse_lng);
- }
-
- /* scan statement for '?', ':1' and/or ':foo' style placeholders */
- dbd_preparse(imp_sth, statement);
-
- if (oopen(&imp_sth->cdabuf, imp_dbh->lda, (text*)0, -1, -1, (text*)0, -1)) {
- ora_error(sth, &imp_sth->cdabuf, imp_sth->cdabuf.rc, "oopen error");
- return 0;
- }
- imp_sth->cda = &imp_sth->cdabuf;
-
- /* parse the (possibly edited) SQL statement */
- imp_sth->cda->peo = 0;
- if (oparse(imp_sth->cda, (text*)imp_sth->statement, (sb4)-1,
- (sword)0/*oparse_defer*/, (ub4)oparse_lng)
- ) {
- char buf[99];
- char *hint = "";
- if (1) { /* XXX could make optional one day */
- SV *msgsv, *sqlsv;
- sprintf(buf,"error possibly near <*> indicator at char %d in '",
- imp_sth->cda->peo+1);
- msgsv = sv_2mortal(newSVpv(buf,0));
- sqlsv = sv_2mortal(newSVpv(imp_sth->statement,0));
- sv_insert(sqlsv, imp_sth->cda->peo, 0, "<*>",3);
- sv_catsv(msgsv, sqlsv);
- sv_catpv(msgsv, "'");
- hint = SvPV(msgsv,na);
- }
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, hint);
- oclose(imp_sth->cda); /* close the cursor */
- imp_sth->cda = NULL;
- return 0;
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql f%d\n", imp_sth->cda->ft);
-
- /* Describe and allocate storage for results. */
- if (!dbd_describe(sth, imp_sth)) {
- return 0;
- }
-
- DBIc_IMPSET_on(imp_sth);
- return 1;
-}
-
-int
-ora_db_reauthenticate(dbh, imp_dbh, uid, pwd)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- char * uid;
- char * pwd;
-{
- ora_error(dbh, NULL, 1, "reauthenticate not possible when using Oracle OCI 7");
- return 0;
-}
-
-#endif
@@ -1,12 +1,11 @@
/*
- $Id: oci8.c,v 1.38 2003/03/27 16:44:15 timbo Exp $
+ vim:sw=4:ts=8
+ oci8.c
- Copyright (c) 1998,1999,2000,2001 Tim Bunce
+ Copyright (c) 1998-2006 Tim Bunce Ireland
+ Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada
- You may distribute under the terms of either the GNU General Public
- License or the Artistic License, as specified in the Perl README file,
- with the exception that it cannot be placed on a CD-ROM or similar media
- for commercial distribution without the prior approval of the author.
+ See the COPYRIGHT section in the Oracle.pm file for terms.
*/
@@ -16,201 +15,921 @@
#include <utf8.h>
#endif
-#ifdef OCI_V8_SYNTAX
-
+#define sv_set_undef(sv) if (SvROK(sv)) sv_unref(sv); else SvOK_off(sv)
DBISTATE_DECLARE;
-extern int pp_exec_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec));
+int describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level );
+int dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level);
+
+/*
+char *
+dbd_yes_no(int yes_no)
+{
+ dTHX;
+ if (yes_no) {
+ return "Yes";
+ }
+ return "No";
+}
+*/
void
dbd_init_oci(dbistate_t *dbistate)
{
- DBIS = dbistate;
+ dTHX;
+ DBIS = dbistate;
}
void
dbd_init_oci_drh(imp_drh_t * imp_drh)
{
- imp_drh->ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI);
- imp_drh->ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI);
- imp_drh->ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI);
- imp_drh->ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI);
+ dTHX;
+ imp_drh->ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI);
+ imp_drh->ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI);
+ imp_drh->ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI);
+ imp_drh->ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI);
+
+}
+
+/*
+char *
+oci_sql_function_code_name(int sqlfncode)
+{
+ dTHX;
+ SV *sv;
+ switch (sqlfncode) {
+ case 1 : return "CREATE TABLE";
+ case 3 : return "INSERT";
+ case 4 : return "SELECT";
+ case 5 : return "UPDATE";
+ case 8 : return "DROP TABLE";
+ case 9 : return "DELETE";
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN SQL FN Code %d)", sqlfncode);
+ return SvPVX(sv);
+}
+*/
+
+ /*
+char *
+oci_ptype_name(int ptype)
+{
+ dTHX;
+ SV *sv;
+ switch (ptype) {
+ case OCI_PTYPE_UNK: return "UNKNOWN";
+ case OCI_PTYPE_TABLE: return "TABLE";
+ case OCI_PTYPE_VIEW: return "VIEW";
+ case OCI_PTYPE_PROC: return "PROCEDURE";
+ case OCI_PTYPE_FUNC: return "FUNCTION";
+ case OCI_PTYPE_PKG: return "PACKAGE";
+ case OCI_PTYPE_TYPE: return "USER DEFINED TYPE";
+ case OCI_PTYPE_SYN: return "SYNONYM";
+ case OCI_PTYPE_SEQ: return "SEQUENCE";
+ case OCI_PTYPE_COL: return "COLUMN";
+ case OCI_PTYPE_ARG: return "ARGUMENT";
+ case OCI_PTYPE_LIST: return "LIST";
+ case OCI_PTYPE_TYPE_ATTR: return "USER-DEFINED TYPE'S ATTRIBUTE";
+ case OCI_PTYPE_TYPE_COLL: return "COLLECTION TYPE'S ELEMENT";
+ case OCI_PTYPE_TYPE_METHOD: return "USER-DEFINED TYPE'S METHOD";
+ case OCI_PTYPE_TYPE_ARG: return "USER-DEFINED TYPE METHOD'S ARGUMENT";
+ case OCI_PTYPE_TYPE_RESULT: return "USER-DEFINED TYPE METHOD'S RESULT";
+ case OCI_PTYPE_SCHEMA: return "SCHEMA";
+ case OCI_PTYPE_DATABASE: return "DATABASE";
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN PTYPE Code %d)", ptype);
+ return SvPVX(sv);
+}
+ */
+
+char *
+oci_exe_mode(ub4 mode)
+{
+
+ dTHX;
+ SV *sv;
+ switch (mode) {
+ /*----------------------- Execution Modes -----------------------------------*/
+ case OCI_DEFAULT: return "DEFAULT";
+ case OCI_BATCH_MODE: return "BATCH_MODE"; /* batch the oci stmt for exec */
+ case OCI_EXACT_FETCH: return "EXACT_FETCH"; /* fetch exact rows specified */
+ case OCI_STMT_SCROLLABLE_READONLY : return "STMT_SCROLLABLE_READONLY";
+ case OCI_DESCRIBE_ONLY: return "DESCRIBE_ONLY"; /* only describe the statement */
+ case OCI_COMMIT_ON_SUCCESS: return "COMMIT_ON_SUCCESS"; /* commit, if successful exec */
+ case OCI_NON_BLOCKING: return "NON_BLOCKING"; /* non-blocking */
+ case OCI_BATCH_ERRORS: return "BATCH_ERRORS"; /* batch errors in array dmls */
+ case OCI_PARSE_ONLY: return "PARSE_ONLY"; /* only parse the statement */
+ case OCI_SHOW_DML_WARNINGS: return "SHOW_DML_WARNINGS";
+/* case OCI_RESULT_CACHE: return "RESULT_CACHE"; hint to use query caching only 11 so wait this one out*/
+/* case OCI_NO_RESULT_CACHE : return "NO_RESULT_CACHE"; hint to bypass query caching*/
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN OCI EXECUTE MODE %d)", mode);
+ return SvPVX(sv);
+}
+
+/* SQL Types we support for placeholders basically we support types that can be returned as strings */
+char *
+sql_typecode_name(int dbtype) {
+ dTHX;
+ SV *sv;
+ switch(dbtype) {
+ case 0: return "DEFAULT (varchar)";
+ case 1: return "VARCHAR";
+ case 2: return "NVARCHAR2";
+ case 5: return "STRING";
+ case 8: return "LONG";
+ case 21: return "BINARY FLOAT os-endian";
+ case 22: return "BINARY DOUBLE os-endian";
+ case 23: return "RAW";
+ case 24: return "LONG RAW";
+ case 96: return "CHAR";
+ case 97: return "CHARZ";
+ case 100: return "BINARY FLOAT oracle-endian";
+ case 101: return "BINARY DOUBLE oracle-endian";
+ case 106: return "MLSLABEL";
+ case 102: return "SQLT_CUR OCI 7 cursor variable";
+ case 112: return "SQLT_CLOB / long";
+ case 113: return "SQLT_BLOB / long";
+ case 116: return "SQLT_RSET OCI 8 cursor variable";
+ case ORA_VARCHAR2_TABLE:return "ORA_VARCHAR2_TABLE";
+ case ORA_NUMBER_TABLE: return "ORA_NUMBER_TABLE";
+ case ORA_XMLTYPE: return "ORA_XMLTYPE or SQLT_NTY";/* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN SQL TYPECODE %d)", dbtype);
+ return SvPVX(sv);
}
+
+char *
+oci_typecode_name(int typecode){
+
+ dTHX;
+ SV *sv;
+
+ switch (typecode) {
+ case OCI_TYPECODE_INTERVAL_YM: return "INTERVAL_YM";
+ case OCI_TYPECODE_INTERVAL_DS: return "NTERVAL_DS";
+ case OCI_TYPECODE_TIMESTAMP_TZ: return "TIMESTAMP_TZ";
+ case OCI_TYPECODE_TIMESTAMP_LTZ: return "TIMESTAMP_LTZ";
+ case OCI_TYPECODE_TIMESTAMP: return "TIMESTAMP";
+ case OCI_TYPECODE_DATE: return "DATE";
+ case OCI_TYPECODE_CLOB: return "CLOB";
+ case OCI_TYPECODE_BLOB: return "BLOB";
+ case OCI_TYPECODE_BFILE: return "BFILE";
+ case OCI_TYPECODE_RAW: return "RAW";
+ case OCI_TYPECODE_CHAR: return "CHAR";
+ case OCI_TYPECODE_VARCHAR: return "VARCHAR";
+ case OCI_TYPECODE_VARCHAR2: return "VARCHAR2";
+ case OCI_TYPECODE_SIGNED8: return "SIGNED8";
+ case OCI_TYPECODE_UNSIGNED8: return "DECLARE";
+ case OCI_TYPECODE_UNSIGNED16 : return "UNSIGNED8";
+ case OCI_TYPECODE_UNSIGNED32 : return "UNSIGNED32";
+ case OCI_TYPECODE_REAL : return "REAL";
+ case OCI_TYPECODE_DOUBLE : return "DOUBLE";
+ case OCI_TYPECODE_INTEGER : return "INT";
+ case OCI_TYPECODE_SIGNED16 : return "SHORT";
+ case OCI_TYPECODE_SIGNED32 : return "LONG";
+ case OCI_TYPECODE_DECIMAL : return "DECIMAL";
+ case OCI_TYPECODE_FLOAT : return "FLOAT";
+ case OCI_TYPECODE_NUMBER : return "NUMBER";
+ case OCI_TYPECODE_SMALLINT: return "SMALLINT";
+ case OCI_TYPECODE_OBJECT: return "OBJECT";
+ case OCI_TYPECODE_OPAQUE: return "XMLTYPE~OPAQUE";
+ case OCI_TYPECODE_VARRAY: return "VARRAY";
+ case OCI_TYPECODE_TABLE: return "TABLE";
+ case OCI_TYPECODE_NAMEDCOLLECTION: return "NAMEDCOLLECTION";
+ }
+
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN OCI TYPECODE %d)", typecode);
+ return SvPVX(sv);
+
+}
+
char *
oci_status_name(sword status)
{
- SV *sv;
- switch (status) {
- case OCI_SUCCESS: return "SUCCESS";
- case OCI_SUCCESS_WITH_INFO: return "SUCCESS_WITH_INFO";
- case OCI_NEED_DATA: return "NEED_DATA";
- case OCI_NO_DATA: return "NO_DATA";
- case OCI_ERROR: return "ERROR";
- case OCI_INVALID_HANDLE: return "INVALID_HANDLE";
- case OCI_STILL_EXECUTING: return "STILL_EXECUTING";
- case OCI_CONTINUE: return "CONTINUE";
- }
- sv = sv_2mortal(newSVpv("",0));
- sv_grow(sv, 50);
- sprintf(SvPVX(sv),"(UNKNOWN OCI STATUS %d)", status);
- return SvPVX(sv);
+ dTHX;
+ SV *sv;
+ switch (status) {
+ case OCI_SUCCESS: return "SUCCESS";
+ case OCI_SUCCESS_WITH_INFO: return "SUCCESS_WITH_INFO";
+ case OCI_NEED_DATA: return "NEED_DATA";
+ case OCI_NO_DATA: return "NO_DATA";
+ case OCI_ERROR: return "ERROR";
+ case OCI_INVALID_HANDLE: return "INVALID_HANDLE";
+ case OCI_STILL_EXECUTING: return "STILL_EXECUTING";
+ case OCI_CONTINUE: return "CONTINUE";
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN OCI STATUS %d)", status);
+ return SvPVX(sv);
+}
+/* the various modes used in OCI */
+char *
+oci_define_options(ub4 options)
+{
+ dTHX;
+ SV *sv;
+ switch (options) {
+ /*------------------------Bind and Define Options----------------------------*/
+ case OCI_DEFAULT: return "DEFAULT";
+ case OCI_DYNAMIC_FETCH: return "DYNAMIC_FETCH"; /* fetch dynamically */
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN OCI DEFINE MODE %d)", options);
+ return SvPVX(sv);
+}
+
+char *
+oci_bind_options(ub4 options)
+{
+ dTHX;
+ SV *sv;
+ switch (options) {
+ /*------------------------Bind and Define Options----------------------------*/
+ case OCI_DEFAULT: return "DEFAULT";
+ case OCI_SB2_IND_PTR: return "SB2_IND_PTR"; /* unused */
+ case OCI_DATA_AT_EXEC: return "DATA_AT_EXEC"; /* data at execute time */
+ case OCI_PIECEWISE: return "PIECEWISE"; /* piecewise DMLs or fetch */
+/* case OCI_BIND_SOFT: return "BIND_SOFT"; soft bind or define */
+/* case OCI_DEFINE_SOFT: return "DEFINE_SOFT"; soft bind or define */
+/* case OCI_IOV: return ""; 11g only release 1.23 me thinks For scatter gather bind/define */
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN BIND MODE %d)", options);
+ return SvPVX(sv);
}
+/* the various modes used in OCI */
+char *
+oci_mode(ub4 mode)
+{
+ dTHX;
+ SV *sv;
+ switch (mode) {
+ case 3: return "THREADED | OBJECT";
+ case OCI_DEFAULT: return "DEFAULT";
+ /* the default value for parameters and attributes */
+ /*-------------OCIInitialize Modes / OCICreateEnvironment Modes -------------*/
+ case OCI_THREADED: return "THREADED"; /* appl. in threaded environment */
+ case OCI_OBJECT: return "OBJECT"; /* application in object environment */
+ case OCI_EVENTS: return "EVENTS"; /* application is enabled for events */
+ case OCI_SHARED: return "SHARED"; /* the application is in shared mode */
+ /* The following *TWO* are only valid for OCICreateEnvironment call */
+ case OCI_NO_UCB: return "NO_UCB "; /* No user callback called during ini */
+ case OCI_NO_MUTEX: return "NO_MUTEX"; /* the environment handle will not be
+ protected by a mutex internally */
+ case OCI_SHARED_EXT: return "SHARED_EXT"; /* Used for shared forms */
+ case OCI_ALWAYS_BLOCKING:return "ALWAYS_BLOCKING"; /* all connections always blocking */
+ case OCI_USE_LDAP: return "USE_LDAP"; /* allow LDAP connections */
+ case OCI_REG_LDAPONLY: return "REG_LDAPONLY"; /* only register to LDAP */
+ case OCI_UTF16: return "UTF16"; /* mode for all UTF16 metadata */
+ case OCI_AFC_PAD_ON: return "AFC_PAD_ON"; /* turn on AFC blank padding when rlenp present */
+ case OCI_NEW_LENGTH_SEMANTICS: return "NEW_LENGTH_SEMANTICS"; /* adopt new length semantics
+ the new length semantics, always bytes, is used by OCIEnvNlsCreate */
+ case OCI_NO_MUTEX_STMT: return "NO_MUTEX_STMT"; /* Do not mutex stmt handle */
+ case OCI_MUTEX_ENV_ONLY: return "MUTEX_ENV_ONLY"; /* Mutex only the environment handle */
+/* case OCI_SUPPRESS_NLS_VALIDATION:return "SUPPRESS_NLS_VALIDATION"; suppress nls validation*/
+ /* nls validation suppression is on by default;*/
+ /* use OCI_ENABLE_NLS_VALIDATION to disable it */
+/* case OCI_MUTEX_TRY: return "MUTEX_TRY"; try and acquire mutex */
+/* case OCI_NCHAR_LITERAL_REPLACE_ON: return "NCHAR_LITERAL_REPLACE_ON"; nchar literal replace on */
+/* case OCI_NCHAR_LITERAL_REPLACE_OFF:return "NCHAR_LITERAL_REPLACE_OFF"; nchar literal replace off*/
+/* case OCI_ENABLE_NLS_VALIDATION: return "ENABLE_NLS_VALIDATION"; enable nls validation */
+ /*------------------------OCIConnectionpoolCreate Modes----------------------*/
+ case OCI_CPOOL_REINITIALIZE: return "CPOOL_REINITIALIZE";
+ /*--------------------------------- OCILogon2 Modes -------------------------*/
+/*case OCI_LOGON2_SPOOL: return "LOGON2_SPOOL"; Use session pool */
+ case OCI_LOGON2_CPOOL: return "LOGON2_CPOOL"; /* Use connection pool */
+/*case OCI_LOGON2_STMTCACHE: return "LOGON2_STMTCACHE"; Use Stmt Caching */
+ case OCI_LOGON2_PROXY: return "LOGON2_PROXY"; /* Proxy authentiaction */
+ /*------------------------- OCISessionPoolCreate Modes ----------------------*/
+/*case OCI_SPC_REINITIALIZE: return "SPC_REINITIALIZE"; Reinitialize the session pool */
+/*case OCI_SPC_HOMOGENEOUS: return "SPC_HOMOGENEOUS"; ""; Session pool is homogeneneous */
+/*case OCI_SPC_STMTCACHE: return "SPC_STMTCACHE"; Session pool has stmt cache */
+/*case OCI_SPC_NO_RLB: return "SPC_NO_RLB "; Do not enable Runtime load balancing. */
+ /*--------------------------- OCISessionGet Modes ---------------------------*/
+/*case OCI_SESSGET_SPOOL: return "SESSGET_SPOOL"; SessionGet called in SPOOL mode */
+/*case OCI_SESSGET_CPOOL: return "SESSGET_CPOOL"; SessionGet called in CPOOL mode */
+/*case OCI_SESSGET_STMTCACHE: return "SESSGET_STMTCACHE"; Use statement cache */
+/*case OCI_SESSGET_CREDPROXY: return "SESSGET_CREDPROXY"; SessionGet called in proxy mode */
+/*case OCI_SESSGET_CREDEXT: return "SESSGET_CREDEXT"; */
+ case OCI_SESSGET_SPOOL_MATCHANY:return "SESSGET_SPOOL_MATCHANY";
+/*case OCI_SESSGET_PURITY_NEW: return "SESSGET_PURITY_NEW";
+ case OCI_SESSGET_PURITY_SELF: return "SESSGET_PURITY_SELF"; */
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(UNKNOWN OCI MODE %d)", mode);
+ return SvPVX(sv);
+}
char *
oci_stmt_type_name(int stmt_type)
{
- SV *sv;
- switch (stmt_type) {
- case OCI_STMT_SELECT: return "SELECT";
- case OCI_STMT_UPDATE: return "UPDATE";
- case OCI_STMT_DELETE: return "DELETE";
- case OCI_STMT_INSERT: return "INSERT";
- case OCI_STMT_CREATE: return "CREATE";
- case OCI_STMT_DROP: return "DROP";
- case OCI_STMT_ALTER: return "ALTER";
- case OCI_STMT_BEGIN: return "BEGIN";
- case OCI_STMT_DECLARE: return "DECLARE";
- }
- sv = sv_2mortal(newSVpv("",0));
- sv_grow(sv, 50);
- sprintf(SvPVX(sv),"(STMT TYPE %d)", stmt_type);
- return SvPVX(sv);
+ dTHX;
+ SV *sv;
+ switch (stmt_type) {
+ case OCI_STMT_SELECT: return "SELECT";
+ case OCI_STMT_UPDATE: return "UPDATE";
+ case OCI_STMT_DELETE: return "DELETE";
+ case OCI_STMT_INSERT: return "INSERT";
+ case OCI_STMT_CREATE: return "CREATE";
+ case OCI_STMT_DROP: return "DROP";
+ case OCI_STMT_ALTER: return "ALTER";
+ case OCI_STMT_BEGIN: return "BEGIN";
+ case OCI_STMT_DECLARE: return "DECLARE";
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"(STMT TYPE %d)", stmt_type);
+ return SvPVX(sv);
}
+char *
+oci_col_return_codes(int rc)
+{
+ dTHX;
+ SV *sv;
+ switch (rc) {
+ case 1406: return "TRUNCATED";
+ case 0: return "OK";
+ case 1405: return "NULL";
+ case 1403: return "NO DATA";
+
+ }
+ sv = sv_2mortal(newSVpv("",0));
+ sv_grow(sv, 50);
+ sprintf(SvPVX(sv),"UNKNOWN RC=%d)", rc);
+ return SvPVX(sv);
+}
char *
oci_hdtype_name(ub4 hdtype)
{
- SV *sv;
- switch (hdtype) {
- /* Handles */
- case OCI_HTYPE_ENV: return "OCI_HTYPE_ENV";
- case OCI_HTYPE_ERROR: return "OCI_HTYPE_ERROR";
- case OCI_HTYPE_SVCCTX: return "OCI_HTYPE_SVCCTX";
- case OCI_HTYPE_STMT: return "OCI_HTYPE_STMT";
- case OCI_HTYPE_BIND: return "OCI_HTYPE_BIND";
- case OCI_HTYPE_DEFINE: return "OCI_HTYPE_DEFINE";
- case OCI_HTYPE_DESCRIBE: return "OCI_HTYPE_DESCRIBE";
- case OCI_HTYPE_SERVER: return "OCI_HTYPE_SERVER";
- case OCI_HTYPE_SESSION: return "OCI_HTYPE_SESSION";
- /* Descriptors */
- case OCI_DTYPE_LOB: return "OCI_DTYPE_LOB";
- case OCI_DTYPE_SNAP: return "OCI_DTYPE_SNAP";
- case OCI_DTYPE_RSET: return "OCI_DTYPE_RSET";
- case OCI_DTYPE_PARAM: return "OCI_DTYPE_PARAM";
- case OCI_DTYPE_ROWID: return "OCI_DTYPE_ROWID";
+ dTHX;
+ SV *sv;
+ switch (hdtype) {
+ /* Handles */
+ case OCI_HTYPE_ENV: return "OCI_HTYPE_ENV";
+ case OCI_HTYPE_ERROR: return "OCI_HTYPE_ERROR";
+ case OCI_HTYPE_SVCCTX: return "OCI_HTYPE_SVCCTX";
+ case OCI_HTYPE_STMT: return "OCI_HTYPE_STMT";
+ case OCI_HTYPE_BIND: return "OCI_HTYPE_BIND";
+ case OCI_HTYPE_DEFINE: return "OCI_HTYPE_DEFINE";
+ case OCI_HTYPE_DESCRIBE: return "OCI_HTYPE_DESCRIBE";
+ case OCI_HTYPE_SERVER: return "OCI_HTYPE_SERVER";
+ case OCI_HTYPE_SESSION: return "OCI_HTYPE_SESSION";
+ case OCI_HTYPE_CPOOL: return "OCI_HTYPE_CPOOL";
+ case OCI_HTYPE_SPOOL: return "OCI_HTYPE_SPOOL";
+ /*case OCI_HTYPE_AUTHINFO: return "OCI_HTYPE_AUTHINFO";*/
+ /* Descriptors */
+ case OCI_DTYPE_LOB: return "OCI_DTYPE_LOB";
+ case OCI_DTYPE_SNAP: return "OCI_DTYPE_SNAP";
+ case OCI_DTYPE_RSET: return "OCI_DTYPE_RSET";
+ case OCI_DTYPE_PARAM: return "OCI_DTYPE_PARAM";
+ case OCI_DTYPE_ROWID: return "OCI_DTYPE_ROWID";
#ifdef OCI_DTYPE_REF
- case OCI_DTYPE_REF: return "OCI_DTYPE_REF";
+ case OCI_DTYPE_REF: return "OCI_DTYPE_REF";
#endif
- }
- sv = sv_2mortal(newSViv((IV)hdtype));
- return SvPV(sv,na);
+ }
+ sv = sv_2mortal(newSViv((IV)hdtype));
+ return SvPV(sv,PL_na);
}
+/*used to look up the name of a csform value
+ used only for debugging */
+char *
+oci_csform_name(ub4 attr)
+{
+ dTHX;
+ SV *sv;
+ switch (attr) {
+
+/* CHAR/NCHAR/VARCHAR2/NVARCHAR2/CLOB/NCLOB char set "form" information */
+ case SQLCS_IMPLICIT: return "SQLCS_IMPLICIT";/* for CHAR, VARCHAR2, CLOB w/o a specified set */
+ case SQLCS_NCHAR: return "SQLCS_NCHAR";/* for NCHAR, NCHAR VARYING, NCLOB */
+ case SQLCS_EXPLICIT: return "SQLCS_EXPLICIT";/* for CHAR, etc, with "CHARACTER SET ..." syntax */
+ case SQLCS_FLEXIBLE: return "SQLCS_FLEXIBLE";/* for PL/SQL "flexible" parameters */
+ case SQLCS_LIT_NULL: return "SQLCS_LIT_NULL";/* for typecheck of NULL and empty_clob() lits */
+ }
-sb4
-oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug)
+ sv = sv_2mortal(newSViv((IV)attr));
+ return SvPV(sv,PL_na);
+}
+
+/*used to look up the name of a OCI_DTYPE_PARAM Attribute Types
+ used only for debugging */
+char *
+oci_dtype_attr_name(ub4 attr)
{
- text errbuf[1024];
- ub4 recno = 0;
- sb4 errcode = 0;
- sb4 eg_errcode = 0;
- sword eg_status;
-
- if (!errhp) {
- sv_catpv(errstr, oci_status_name(status));
- if (what) {
- sv_catpv(errstr, " ");
- sv_catpv(errstr, what);
+ dTHX;
+ SV *sv;
+ switch (attr) {
+/*=======================Describe Handle Parameter Attributes ===============*/
+ case OCI_ATTR_DATA_SIZE: return "OCI_ATTR_DATA_SIZE"; /* maximum size of the data */
+ case OCI_ATTR_DATA_TYPE: return "OCI_ATTR_DATA_TYPE"; /* the SQL type of the column/argument */
+ case OCI_ATTR_DISP_SIZE: return "OCI_ATTR_DISP_SIZE"; /* the display size */
+ case OCI_ATTR_NAME: return "OCI_ATTR_NAME"; /* the name of the column/argument */
+ case OCI_ATTR_PRECISION: return "OCI_ATTR_PRECISION"; /* precision if number type */
+ case OCI_ATTR_SCALE: return "OCI_ATTR_SCALE"; /* scale if number type */
+ case OCI_ATTR_IS_NULL: return "OCI_ATTR_IS_NULL"; /* is it null ? */
+ case OCI_ATTR_TYPE_NAME: return "OCI_ATTR_TYPE_NAME";
+ /* name of the named data type or a package name for package private types */
+ case OCI_ATTR_SCHEMA_NAME: return "OCI_ATTR_SCHEMA_NAME"; /* the schema name */
+ case OCI_ATTR_SUB_NAME: return "OCI_ATTR_SUB_NAME"; /* type name if package private type */
+ case OCI_ATTR_POSITION: return "OCI_ATTR_POSITION";
+ case OCI_ATTR_CHAR_USED: return "OCI_ATTR_CHAR_USED"; /* char length semantics */
+ case OCI_ATTR_CHAR_SIZE: return "OCI_ATTR_CHAR_SIZE"; /* char length */
+ case OCI_ATTR_CHARSET_ID: return "OCI_ATTR_CHARSET_ID"; /* Character Set ID */
+ case OCI_ATTR_CHARSET_FORM: return "OCI_ATTR_CHARSET_FORM"; /* Character Set Form */
}
- return status;
- }
- while( ++recno
- && OCIErrorGet_log_stat(errhp, recno, (text*)NULL, &eg_errcode, errbuf,
- (ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA
- && eg_status != OCI_INVALID_HANDLE
- && recno < 100
- ) {
- if (debug >= 4 || recno>1/*XXX temp*/)
- PerlIO_printf(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n",
- what, (long)recno,
- (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
- status, (long)eg_errcode, errbuf);
- errcode = eg_errcode;
- sv_catpv(errstr, (char*)errbuf);
- if (*(SvEND(errstr)-1) == '\n')
- --SvCUR(errstr);
- }
- if (what || status != OCI_ERROR) {
- sv_catpv(errstr, (debug<0) ? " (" : " (DBD ");
- sv_catpv(errstr, oci_status_name(status));
- if (what) {
- sv_catpv(errstr, ": ");
- sv_catpv(errstr, what);
- }
- sv_catpv(errstr, ")");
- }
- return errcode;
+ sv = sv_2mortal(newSViv((IV)attr));
+ return SvPV(sv,PL_na);
+
+}
+
+/*used to look up the name of non a OCI_DTYPE_PARAM Attribute Types
+ used only for debugging */
+char *
+oci_attr_name(ub4 attr)
+{
+ dTHX;
+ SV *sv;
+ switch (attr) {
+#ifdef ORA_OCI_102
+ case OCI_ATTR_MODULE: return "OCI_ATTR_MODULE"; /* module for tracing */
+ case OCI_ATTR_ACTION: return "OCI_ATTR_ACTION"; /* action for tracing */
+ case OCI_ATTR_CLIENT_INFO: return "OCI_ATTR_CLIENT_INFO"; /* client info */
+ case OCI_ATTR_COLLECT_CALL_TIME: return "OCI_ATTR_COLLECT_CALL_TIME"; /* collect call time */
+ case OCI_ATTR_CALL_TIME: return "OCI_ATTR_CALL_TIME"; /* extract call time */
+ case OCI_ATTR_ECONTEXT_ID: return "OCI_ATTR_ECONTEXT_ID"; /* execution-id context */
+ case OCI_ATTR_ECONTEXT_SEQ: return "OCI_ATTR_ECONTEXT_SEQ"; /*execution-id sequence num */
+
+
+ /*------------------------------ Session attributes -------------------------*/
+ case OCI_ATTR_SESSION_STATE: return "OCI_ATTR_SESSION_STATE"; /* session state */
+
+ case OCI_ATTR_SESSION_STATETYPE: return "OCI_ATTR_SESSION_STATETYPE"; /* session state type */
+ case OCI_SESSION_STATELESS_DEF: return "OCI_SESSION_STATELESS_DEF"; /* valid state types */
+
+ case OCI_ATTR_SESSION_STATE_CLEARED: return "OCI_ATTR_SESSION_STATE_CLEARED"; /* session state cleared*/
+ case OCI_ATTR_SESSION_MIGRATED: return "OCI_ATTR_SESSION_MIGRATED"; /* did session migrate*/
+ case OCI_ATTR_SESSION_PRESERVE_STATE: return "OCI_ATTR_SESSION_PRESERVE_STATE"; /* preserve session state */
+#endif
+#ifdef ORA_OCI_112
+ case OCI_ATTR_DRIVER_NAME: return "OCI_ATTR_DRIVER_NAME"; /* Driver Name */
+#endif
+ case OCI_ATTR_CLIENT_IDENTIFIER: return "OCI_ATTR_CLIENT_IDENTIFIER"; /* value of client id to set*/
+
+ /*=============================Attribute Types===============================*/
+#ifdef ORA_OCI_112
+ case OCI_ATTR_PURITY: return "OCI_ATTR_PURITY"; /* for DRCP session purity */
+ case OCI_ATTR_CONNECTION_CLASS: return "OCI_ATTR_CONNECTION_CLASS"; /* for DRCP connection class */
+#endif
+ case OCI_ATTR_FNCODE: return "OCI_ATTR_FNCODE"; /* the OCI function code */
+ case OCI_ATTR_OBJECT: return "OCI_ATTR_OBJECT"; /* is the environment initialized in object mode */
+ case OCI_ATTR_NONBLOCKING_MODE: return "OCI_ATTR_NONBLOCKING_MODE"; /* non blocking mode */
+ case OCI_ATTR_SQLCODE: return "OCI_ATTR_SQLCODE"; /* the SQL verb */
+ case OCI_ATTR_ENV: return "OCI_ATTR_ENV"; /* the environment handle */
+ case OCI_ATTR_SERVER: return "OCI_ATTR_SERVER"; /* the server handle*/
+ case OCI_ATTR_SESSION: return "OCI_ATTR_SESSION"; /* the user session handle*/
+ case OCI_ATTR_TRANS: return "OCI_ATTR_TRANS"; /* the transaction handle */
+ case OCI_ATTR_ROW_COUNT: return "OCI_ATTR_ROW_COUNT"; /* the rows processed so far */
+ case OCI_ATTR_SQLFNCODE: return "OCI_ATTR_SQLFNCODE"; /* the SQL verb of the statement */
+ case OCI_ATTR_PREFETCH_ROWS: return "OCI_ATTR_PREFETCH_ROWS"; /* sets the number of rows to prefetch */
+ case OCI_ATTR_NESTED_PREFETCH_ROWS: return "OCI_ATTR_NESTED_PREFETCH_ROWS"; /* the prefetch rows of nested table*/
+ case OCI_ATTR_PREFETCH_MEMORY: return "OCI_ATTR_PREFETCH_MEMORY"; /* memory limit for rows fetched */
+ case OCI_ATTR_NESTED_PREFETCH_MEMORY:return "OCI_ATTR_NESTED_PREFETCH_MEMORY"; /* memory limit for nested rows */
+ case OCI_ATTR_CHAR_COUNT: return "OCI_ATTR_CHAR_COUNT"; /* this specifies the bind and define size in characters */
+ case OCI_ATTR_PDSCL: return "OCI_ATTR_PDSCL"; /* packed decimal scale*/
+ /*case OCI_ATTR_FSPRECISION OCI_ATTR_PDSCL:return ""; fs prec for datetime data types */
+ case OCI_ATTR_PDPRC: return "OCI_ATTR_PDPRC"; /* packed decimal format*/
+ /*case OCI_ATTR_LFPRECISION OCI_ATTR_PDPRC: return ""; fs prec for datetime data types */
+ case OCI_ATTR_PARAM_COUNT: return "OCI_ATTR_PARAM_COUNT"; /* number of column in the select list */
+ case OCI_ATTR_ROWID: return "OCI_ATTR_ROWID"; /* the rowid */
+ case OCI_ATTR_CHARSET: return "OCI_ATTR_CHARSET"; /* the character set value */
+ case OCI_ATTR_NCHAR: return "OCI_ATTR_NCHAR"; /* NCHAR type */
+ case OCI_ATTR_USERNAME: return "OCI_ATTR_USERNAME"; /* username attribute */
+ case OCI_ATTR_PASSWORD: return "OCI_ATTR_PASSWORD"; /* password attribute */
+ case OCI_ATTR_STMT_TYPE: return "OCI_ATTR_STMT_TYPE"; /* statement type */
+ case OCI_ATTR_INTERNAL_NAME: return "OCI_ATTR_INTERNAL_NAME"; /* user friendly global name */
+ case OCI_ATTR_EXTERNAL_NAME: return "OCI_ATTR_EXTERNAL_NAME"; /* the internal name for global txn */
+ case OCI_ATTR_XID: return "OCI_ATTR_XID"; /* XOPEN defined global transaction id */
+ case OCI_ATTR_TRANS_LOCK: return "OCI_ATTR_TRANS_LOCK"; /* */
+ case OCI_ATTR_TRANS_NAME: return "OCI_ATTR_TRANS_NAME"; /* string to identify a global transaction */
+ case OCI_ATTR_HEAPALLOC: return "OCI_ATTR_HEAPALLOC"; /* memory allocated on the heap */
+ case OCI_ATTR_CHARSET_FORM: return "OCI_ATTR_CHARSET_FORM"; /* Character Set Form */
+ case OCI_ATTR_MAXDATA_SIZE: return "OCI_ATTR_MAXDATA_SIZE"; /* Maximumsize of data on the server */
+ case OCI_ATTR_CACHE_OPT_SIZE: return "OCI_ATTR_CACHE_OPT_SIZE"; /* object cache optimal size */
+ case OCI_ATTR_CACHE_MAX_SIZE: return "OCI_ATTR_CACHE_MAX_SIZE"; /* object cache maximum size percentage */
+ case OCI_ATTR_PINOPTION: return "OCI_ATTR_PINOPTION"; /* object cache default pin option */
+ case OCI_ATTR_ALLOC_DURATION: return "OCI_ATTR_ALLOC_DURATION"; /* object cache default allocation duration */
+ case OCI_ATTR_PIN_DURATION: return "OCI_ATTR_PIN_DURATION"; /* object cache default pin duration */
+ case OCI_ATTR_FDO: return "OCI_ATTR_FDO"; /* Format Descriptor object attribute */
+ case OCI_ATTR_POSTPROCESSING_CALLBACK: return "OCI_ATTR_POSTPROCESSING_CALLBACK"; /* Callback to process outbind data */
+ case OCI_ATTR_POSTPROCESSING_CONTEXT: return "OCI_ATTR_POSTPROCESSING_CONTEXT"; /* Callback context to process outbind data */
+ case OCI_ATTR_ROWS_RETURNED: return "OCI_ATTR_ROWS_RETURNED"; /* Number of rows returned in current iter - for Bind handles */
+ case OCI_ATTR_FOCBK: return "OCI_ATTR_FOCBK"; /* Failover Callback attribute */
+ case OCI_ATTR_IN_V8_MODE: return "OCI_ATTR_IN_V8_MODE"; /* is the server/service context in V8 mode */
+ case OCI_ATTR_LOBEMPTY: return "OCI_ATTR_LOBEMPTY"; /* empty lob ? */
+ case OCI_ATTR_SESSLANG: return "OCI_ATTR_SESSLANG"; /* session language handle */
+ case OCI_ATTR_VISIBILITY: return "OCI_ATTR_VISIBILITY"; /* visibility */
+ case OCI_ATTR_RELATIVE_MSGID: return "OCI_ATTR_RELATIVE_MSGID"; /* relative message id */
+ case OCI_ATTR_SEQUENCE_DEVIATION: return "OCI_ATTR_SEQUENCE_DEVIATION"; /* sequence deviation */
+
+ case OCI_ATTR_CONSUMER_NAME: return "OCI_ATTR_CONSUMER_NAME"; /* consumer name */
+ case OCI_ATTR_DEQ_MODE: return "OCI_ATTR_DEQ_MODE"; /* dequeue mode */
+ case OCI_ATTR_NAVIGATION: return "OCI_ATTR_NAVIGATION"; /* navigation */
+ case OCI_ATTR_WAIT: return "OCI_ATTR_WAIT"; /* wait */
+ case OCI_ATTR_DEQ_MSGID: return "OCI_ATTR_DEQ_MSGID"; /* dequeue message id */
+
+ case OCI_ATTR_PRIORITY: return "OCI_ATTR_PRIORITY"; /* priority */
+ case OCI_ATTR_DELAY: return "OCI_ATTR_DELAY"; /* delay */
+ case OCI_ATTR_EXPIRATION: return "OCI_ATTR_EXPIRATION"; /* expiration */
+ case OCI_ATTR_CORRELATION: return "OCI_ATTR_CORRELATION"; /* correlation id */
+ case OCI_ATTR_ATTEMPTS: return "OCI_ATTR_ATTEMPTS"; /* # of attempts */
+ case OCI_ATTR_RECIPIENT_LIST: return "OCI_ATTR_RECIPIENT_LIST"; /* recipient list */
+ case OCI_ATTR_EXCEPTION_QUEUE: return "OCI_ATTR_EXCEPTION_QUEUE"; /* exception queue name */
+ case OCI_ATTR_ENQ_TIME: return "OCI_ATTR_ENQ_TIME"; /* enqueue time (only OCIAttrGet) */
+ case OCI_ATTR_MSG_STATE: return "OCI_ATTR_MSG_STATE"; /* message state (only OCIAttrGet) */
+ /* NOTE: 64-66 used below */
+ case OCI_ATTR_AGENT_NAME: return "OCI_ATTR_AGENT_NAME"; /* agent name */
+ case OCI_ATTR_AGENT_ADDRESS: return "OCI_ATTR_AGENT_ADDRESS"; /* agent address */
+ case OCI_ATTR_AGENT_PROTOCOL: return "OCI_ATTR_AGENT_PROTOCOL"; /* agent protocol */
+
+ case OCI_ATTR_SENDER_ID: return "OCI_ATTR_SENDER_ID"; /* sender id */
+ case OCI_ATTR_ORIGINAL_MSGID: return "OCI_ATTR_ORIGINAL_MSGID"; /* original message id */
+
+ case OCI_ATTR_QUEUE_NAME: return "OCI_ATTR_QUEUE_NAME"; /* queue name */
+ case OCI_ATTR_NFY_MSGID: return "OCI_ATTR_NFY_MSGID"; /* message id */
+ case OCI_ATTR_MSG_PROP: return "OCI_ATTR_MSG_PROP"; /* message properties */
+
+ case OCI_ATTR_NUM_DML_ERRORS: return "OCI_ATTR_NUM_DML_ERRORS"; /* num of errs in array DML */
+ case OCI_ATTR_DML_ROW_OFFSET: return "OCI_ATTR_DML_ROW_OFFSET"; /* row offset in the array */
+
+ case OCI_ATTR_DATEFORMAT: return "OCI_ATTR_DATEFORMAT"; /* default date format string */
+ case OCI_ATTR_BUF_ADDR: return "OCI_ATTR_BUF_ADDR"; /* buffer address */
+ case OCI_ATTR_BUF_SIZE: return "OCI_ATTR_BUF_SIZE"; /* buffer size */
+ case OCI_ATTR_DIRPATH_MODE: return "OCI_ATTR_DIRPATH_MODE"; /* mode of direct path operation */
+ case OCI_ATTR_DIRPATH_NOLOG: return "OCI_ATTR_DIRPATH_NOLOG"; /* nologging option */
+ case OCI_ATTR_DIRPATH_PARALLEL: return "OCI_ATTR_DIRPATH_PARALLEL"; /* parallel (temp seg) option */
+ case OCI_ATTR_NUM_ROWS: return "OCI_ATTR_NUM_ROWS"; /* number of rows in column array */
+ /* NOTE that OCI_ATTR_NUM_COLS is a column*/
+ /* array attribute too.*/
+ case OCI_ATTR_COL_COUNT: return "OCI_ATTR_COL_COUNT"; /* columns of column array*/
+ /*processed so far. */
+ case OCI_ATTR_STREAM_OFFSET: return "OCI_ATTR_STREAM_OFFSET"; /* str off of last row processed*/
+/* case OCI_ATTR_SHARED_HEAPALLO: return ""; Shared Heap Allocation Size */
+
+ case OCI_ATTR_SERVER_GROUP: return "OCI_ATTR_SERVER_GROUP"; /* server group name */
+
+ case OCI_ATTR_MIGSESSION: return "OCI_ATTR_MIGSESSION"; /* migratable session attribute */
+
+ case OCI_ATTR_NOCACHE: return "OCI_ATTR_NOCACHE"; /* Temporary LOBs */
+
+ case OCI_ATTR_MEMPOOL_SIZE: return "OCI_ATTR_MEMPOOL_SIZE"; /* Pool Size */
+ case OCI_ATTR_MEMPOOL_INSTNAME: return "OCI_ATTR_MEMPOOL_INSTNAME"; /* Instance name */
+ case OCI_ATTR_MEMPOOL_APPNAME: return "OCI_ATTR_MEMPOOL_APPNAME"; /* Application name */
+ case OCI_ATTR_MEMPOOL_HOMENAME: return "OCI_ATTR_MEMPOOL_HOMENAME"; /* Home Directory name */
+ case OCI_ATTR_MEMPOOL_MODEL: return "OCI_ATTR_MEMPOOL_MODEL"; /* Pool Model (proc,thrd,both)*/
+ case OCI_ATTR_MODES: return "OCI_ATTR_MODES"; /* Modes */
+
+ case OCI_ATTR_SUBSCR_NAME: return "OCI_ATTR_SUBSCR_NAME"; /* name of subscription */
+ case OCI_ATTR_SUBSCR_CALLBACK: return "OCI_ATTR_SUBSCR_CALLBACK"; /* associated callback */
+ case OCI_ATTR_SUBSCR_CTX: return "OCI_ATTR_SUBSCR_CTX"; /* associated callback context */
+ case OCI_ATTR_SUBSCR_PAYLOAD: return "OCI_ATTR_SUBSCR_PAYLOAD"; /* associated payload */
+ case OCI_ATTR_SUBSCR_NAMESPACE: return "OCI_ATTR_SUBSCR_NAMESPACE"; /* associated namespace */
+
+ case OCI_ATTR_PROXY_CREDENTIALS: return "OCI_ATTR_PROXY_CREDENTIALS"; /* Proxy user credentials */
+ case OCI_ATTR_INITIAL_CLIENT_ROLES: return "OCI_ATTR_INITIAL_CLIENT_ROLES"; /* Initial client role list */
+
+ case OCI_ATTR_UNK: return "OCI_ATTR_UNK"; /* unknown attribute */
+ case OCI_ATTR_NUM_COLS: return "OCI_ATTR_NUM_COLS"; /* number of columns */
+ case OCI_ATTR_LIST_COLUMNS: return "OCI_ATTR_LIST_COLUMNS"; /* parameter of the column list */
+ case OCI_ATTR_RDBA: return "OCI_ATTR_RDBA"; /* DBA of the segment header */
+ case OCI_ATTR_CLUSTERED: return "OCI_ATTR_CLUSTERED"; /* whether the table is clustered */
+ case OCI_ATTR_PARTITIONED: return "OCI_ATTR_PARTITIONED"; /* whether the table is partitioned */
+ case OCI_ATTR_INDEX_ONLY: return "OCI_ATTR_INDEX_ONLY"; /* whether the table is index only */
+ case OCI_ATTR_LIST_ARGUMENTS: return "OCI_ATTR_LIST_ARGUMENTS"; /* parameter of the argument list */
+ case OCI_ATTR_LIST_SUBPROGRAMS: return "OCI_ATTR_LIST_SUBPROGRAMS"; /* parameter of the subprogram list */
+ case OCI_ATTR_REF_TDO: return "OCI_ATTR_REF_TDO"; /* REF to the type descriptor */
+ case OCI_ATTR_LINK: return "OCI_ATTR_LINK"; /* the database link name */
+ case OCI_ATTR_MIN: return "OCI_ATTR_MIN"; /* minimum value */
+ case OCI_ATTR_MAX: return "OCI_ATTR_MAX"; /* maximum value */
+ case OCI_ATTR_INCR: return "OCI_ATTR_INCR"; /* increment value */
+ case OCI_ATTR_CACHE: return "OCI_ATTR_CACHE"; /* number of sequence numbers cached */
+ case OCI_ATTR_ORDER: return "OCI_ATTR_ORDER"; /* whether the sequence is ordered */
+ case OCI_ATTR_HW_MARK: return "OCI_ATTR_HW_MARK"; /* high-water mark */
+ case OCI_ATTR_TYPE_SCHEMA: return "OCI_ATTR_TYPE_SCHEMA"; /* type's schema name */
+ case OCI_ATTR_TIMESTAMP: return "OCI_ATTR_TIMESTAMP"; /* timestamp of the object */
+ case OCI_ATTR_NUM_ATTRS: return "OCI_ATTR_NUM_ATTRS"; /* number of sttributes */
+ case OCI_ATTR_NUM_PARAMS: return "OCI_ATTR_NUM_PARAMS"; /* number of parameters */
+ case OCI_ATTR_OBJID: return "OCI_ATTR_OBJID"; /* object id for a table or view */
+ case OCI_ATTR_PTYPE: return "OCI_ATTR_PTYPE"; /* type of info described by */
+ case OCI_ATTR_PARAM: return "OCI_ATTR_PARAM"; /* parameter descriptor */
+ case OCI_ATTR_OVERLOAD_ID: return "OCI_ATTR_OVERLOAD_ID"; /* overload ID for funcs and procs */
+ case OCI_ATTR_TABLESPACE: return "OCI_ATTR_TABLESPACE"; /* table name space */
+ case OCI_ATTR_TDO: return "OCI_ATTR_TDO"; /* TDO of a type */
+ case OCI_ATTR_LTYPE: return "OCI_ATTR_LTYPE"; /* list type */
+ case OCI_ATTR_PARSE_ERROR_OFFSET: return "OCI_ATTR_PARSE_ERROR_OFFSET";/* Parse Error offset */
+ case OCI_ATTR_IS_TEMPORARY: return "OCI_ATTR_IS_TEMPORARY"; /* whether table is temporary */
+ case OCI_ATTR_IS_TYPED: return "OCI_ATTR_IS_TYPED"; /* whether table is typed */
+ case OCI_ATTR_DURATION: return "OCI_ATTR_DURATION"; /* duration of temporary table */
+ case OCI_ATTR_IS_INVOKER_RIGHTS: return "OCI_ATTR_IS_INVOKER_RIGHTS";/* is invoker rights */
+ case OCI_ATTR_OBJ_NAME: return "OCI_ATTR_OBJ_NAME"; /* top level schema obj name */
+ case OCI_ATTR_OBJ_SCHEMA: return "OCI_ATTR_OBJ_SCHEMA"; /* schema name */
+ case OCI_ATTR_OBJ_ID: return "OCI_ATTR_OBJ_ID"; /* top level schema object id */
+
+ case OCI_ATTR_DIRPATH_SORTED_INDEX: return "OCI_ATTR_DIRPATH_SORTED_INDEX";/* index that data is sorted on */
+ /* direct path index maint method (see oci8dp.h) */
+ case OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD: return "OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD";/* parallel load: db file, initial and next extent sizes */
+
+ case OCI_ATTR_DIRPATH_FILE: return "OCI_ATTR_DIRPATH_FILE"; /* DB file to load into */
+ case OCI_ATTR_DIRPATH_STORAGE_INITIAL: return "OCI_ATTR_DIRPATH_STORAGE_INITIAL"; /* initial extent size */
+ case OCI_ATTR_DIRPATH_STORAGE_NEXT: return "OCI_ATTR_DIRPATH_STORAGE_NEXT"; /* next extent size */
+
+
+ case OCI_ATTR_TRANS_TIMEOUT: return "OCI_ATTR_TRANS_TIMEOUT"; /* transaction timeout */
+ case OCI_ATTR_SERVER_STATUS: return "OCI_ATTR_SERVER_STATUS"; /* state of the server handle */
+ case OCI_ATTR_STATEMENT: return "OCI_ATTR_STATEMENT"; /* statement txt in stmt hdl */
+ /* statement should not be executed in cache*/
+ /*case OCI_ATTR_NO_CACHE: return "";*/
+ case OCI_ATTR_DEQCOND: return "OCI_ATTR_DEQCOND"; /* dequeue condition */
+ case OCI_ATTR_RESERVED_2: return "OCI_ATTR_RESERVED_2"; /* reserved */
+
+
+ case OCI_ATTR_SUBSCR_RECPT: return "OCI_ATTR_SUBSCR_RECPT"; /* recepient of subscription */
+ case OCI_ATTR_SUBSCR_RECPTPROTO: return "OCI_ATTR_SUBSCR_RECPTPROTO";/* protocol for recepient */
+
+ /* 8.2 dpapi support of ADTs */
+ case OCI_ATTR_DIRPATH_EXPR_TYPE: return "OCI_ATTR_DIRPATH_EXPR_TYPE"; /* expr type of OCI_ATTR_NAME */
+
+ case OCI_ATTR_DIRPATH_INPUT: return "OCI_ATTR_DIRPATH_INPUT"; /* input in text or stream format*/
+/* case OCI_DIRPATH_INPUT_TEXT: return "";
+ case OCI_DIRPATH_INPUT_STREAM: return "";
+ case OCI_DIRPATH_INPUT_UNKNOWN: return ""; */
+ case OCI_ATTR_LDAP_HOST: return "OCI_ATTR_LDAP_HOST"; /* LDAP host to connect to */
+ case OCI_ATTR_LDAP_PORT: return "OCI_ATTR_LDAP_PORT"; /* LDAP port to connect to */
+ case OCI_ATTR_BIND_DN: return "OCI_ATTR_BIND_DN"; /* bind DN */
+ case OCI_ATTR_LDAP_CRED: return "OCI_ATTR_LDAP_CRED"; /* credentials to connect to LDAP */
+ case OCI_ATTR_WALL_LOC: return "OCI_ATTR_WALL_LOC"; /* client wallet location */
+ case OCI_ATTR_LDAP_AUTH: return "OCI_ATTR_LDAP_AUTH"; /* LDAP authentication method */
+ case OCI_ATTR_LDAP_CTX: return "OCI_ATTR_LDAP_CTX"; /* LDAP adminstration context DN */
+ case OCI_ATTR_SERVER_DNS: return "OCI_ATTR_SERVER_DNS"; /* list of registration server DNs */
+
+ case OCI_ATTR_DN_COUNT: return "OCI_ATTR_DN_COUNT"; /* the number of server DNs */
+ case OCI_ATTR_SERVER_DN: return "OCI_ATTR_SERVER_DN"; /* server DN attribute */
+
+ case OCI_ATTR_MAXCHAR_SIZE: return "OCI_ATTR_MAXCHAR_SIZE"; /* max char size of data */
+
+ case OCI_ATTR_CURRENT_POSITION: return "OCI_ATTR_CURRENT_POSITION"; /* for scrollable result sets*/
+
+ /* Added to get attributes for ref cursor to statement handle */
+ case OCI_ATTR_RESERVED_3: return "OCI_ATTR_RESERVED_3"; /* reserved */
+ case OCI_ATTR_RESERVED_4: return "OCI_ATTR_RESERVED_4"; /* reserved */
+ case OCI_ATTR_DIRPATH_FN_CTX: return ""; /* fn ctx ADT attrs or args */
+ case OCI_ATTR_DIGEST_ALGO: return "OCI_ATTR_DIRPATH_FN_CTX"; /* digest algorithm */
+ case OCI_ATTR_CERTIFICATE: return "OCI_ATTR_CERTIFICATE"; /* certificate */
+ case OCI_ATTR_SIGNATURE_ALGO: return "OCI_ATTR_SIGNATURE_ALGO"; /* signature algorithm */
+ case OCI_ATTR_CANONICAL_ALGO: return "OCI_ATTR_CANONICAL_ALGO"; /* canonicalization algo. */
+ case OCI_ATTR_PRIVATE_KEY: return "OCI_ATTR_PRIVATE_KEY"; /* private key */
+ case OCI_ATTR_DIGEST_VALUE: return "OCI_ATTR_DIGEST_VALUE"; /* digest value */
+ case OCI_ATTR_SIGNATURE_VAL: return "OCI_ATTR_SIGNATURE_VAL"; /* signature value */
+ case OCI_ATTR_SIGNATURE: return "OCI_ATTR_SIGNATURE"; /* signature */
+
+ /* attributes for setting OCI stmt caching specifics in svchp */
+ case OCI_ATTR_STMTCACHESIZE : return "OCI_ATTR_STMTCACHESIZE"; /* size of the stm cache */
+
+ /* --------------------------- Connection Pool Attributes ------------------ */
+ case OCI_ATTR_CONN_NOWAIT: return "OCI_ATTR_CONN_NOWAIT";
+ case OCI_ATTR_CONN_BUSY_COUNT: return "OCI_ATTR_CONN_BUSY_COUNT";
+ case OCI_ATTR_CONN_OPEN_COUNT: return "OCI_ATTR_CONN_OPEN_COUNT";
+ case OCI_ATTR_CONN_TIMEOUT: return "OCI_ATTR_CONN_TIMEOUT";
+ case OCI_ATTR_STMT_STATE: return "OCI_ATTR_STMT_STATE";
+ case OCI_ATTR_CONN_MIN: return "OCI_ATTR_CONN_MIN";
+ case OCI_ATTR_CONN_MAX: return "OCI_ATTR_CONN_MAX";
+ case OCI_ATTR_CONN_INCR: return "OCI_ATTR_CONN_INCR";
+
+ case OCI_ATTR_DIRPATH_OID: return "OCI_ATTR_DIRPATH_OID"; /* loading into an OID col */
+
+ case OCI_ATTR_NUM_OPEN_STMTS: return "OCI_ATTR_NUM_OPEN_STMTS"; /* open stmts in session */
+ case OCI_ATTR_DESCRIBE_NATIVE: return "OCI_ATTR_DESCRIBE_NATIVE"; /* get native info via desc */
+
+ case OCI_ATTR_BIND_COUNT: return "OCI_ATTR_BIND_COUNT"; /* number of bind postions */
+ case OCI_ATTR_HANDLE_POSITION: return "OCI_ATTR_HANDLE_POSITION"; /* pos of bind/define handle */
+ case OCI_ATTR_RESERVED_5: return "OCI_ATTR_RESERVED_5"; /* reserverd */
+ case OCI_ATTR_SERVER_BUSY: return "OCI_ATTR_SERVER_BUSY"; /* call in progress on server*/
+
+ case OCI_ATTR_DIRPATH_SID: return "OCI_ATTR_DIRPATH_SID"; /* loading into an SID col */
+ /* notification presentation for recipient */
+ case OCI_ATTR_SUBSCR_RECPTPRES: return "OCI_ATTR_SUBSCR_RECPTPRES";
+ case OCI_ATTR_TRANSFORMATION: return "OCI_ATTR_TRANSFORMATION"; /* AQ message transformation */
+
+ case OCI_ATTR_ROWS_FETCHED: return "OCI_ATTR_ROWS_FETCHED"; /* rows fetched in last call */
+
+ /* --------------------------- Snapshot attributes ------------------------- */
+ case OCI_ATTR_SCN_BASE: return "OCI_ATTR_SCN_BASE"; /* snapshot base */
+ case OCI_ATTR_SCN_WRAP: return "OCI_ATTR_SCN_WRAP"; /* snapshot wrap */
+
+ /* --------------------------- Miscellanous attributes --------------------- */
+ case OCI_ATTR_RESERVED_6: return "OCI_ATTR_RESERVED_6"; /* reserved */
+ case OCI_ATTR_READONLY_TXN: return "OCI_ATTR_READONLY_TXN"; /* txn is readonly */
+ case OCI_ATTR_RESERVED_7: return "OCI_ATTR_RESERVED_7"; /* reserved */
+ case OCI_ATTR_ERRONEOUS_COLUMN: return "OCI_ATTR_ERRONEOUS_COLUMN"; /* position of erroneous col */
+ case OCI_ATTR_RESERVED_8: return "OCI_ATTR_RESERVED_8"; /* reserved */
+
+ /* -------------------- 8.2 dpapi support of ADTs continued ---------------- */
+ case OCI_ATTR_DIRPATH_OBJ_CONSTR: return "OCI_ATTR_DIRPATH_OBJ_CONSTR"; /* obj type of subst obj tbl */
+
+ /************************FREE attribute 207 *************************/
+ /************************FREE attribute 208 *************************/
+ case OCI_ATTR_ENV_UTF16: return "OCI_ATTR_ENV_UTF16"; /* is env in utf16 mode? */
+ case OCI_ATTR_RESERVED_9: return "OCI_ATTR_RESERVED_9"; /* reserved for TMZ */
+ case OCI_ATTR_RESERVED_10: return "OCI_ATTR_RESERVED_10"; /* reserved */
+
+ /* Attr to allow setting of the stream version PRIOR to calling Prepare */
+ case OCI_ATTR_DIRPATH_STREAM_VERSION: return "OCI_ATTR_DIRPATH_STREAM_VERSION"; /* version of the stream*/
+/* case OCI_ATTR_RESERVED_11: return "OCI_ATTR_RESERVED_11"; reserved */
+
+ case OCI_ATTR_RESERVED_12: return "OCI_ATTR_RESERVED_12"; /* reserved */
+ case OCI_ATTR_RESERVED_13: return "OCI_ATTR_RESERVED_13"; /* reserved */
+
+ /* OCI_ATTR_RESERVED_14 */
+#ifdef OCI_ATTR_RESERVED_15
+ case OCI_ATTR_RESERVED_15: return "OCI_ATTR_RESERVED_15"; /* reserved */
+#endif
+#ifdef OCI_ATTR_RESERVED_16
+ case OCI_ATTR_RESERVED_16: return "OCI_ATTR_RESERVED_16"; /* reserved */
+#endif
+
+ }
+ sv = sv_2mortal(newSViv((IV)attr));
+ return SvPV(sv,PL_na);
+}
+
+/*used to look up the name of a fetchtype constant
+ used only for debugging */
+char *
+oci_fetch_options(ub4 fetchtype)
+{
+ dTHX;
+ SV *sv;
+ switch (fetchtype) {
+ /* fetch options */
+ case OCI_FETCH_CURRENT: return "OCI_FETCH_CURRENT";
+ case OCI_FETCH_NEXT: return "OCI_FETCH_NEXT";
+ case OCI_FETCH_FIRST: return "OCI_FETCH_FIRST";
+ case OCI_FETCH_LAST: return "OCI_FETCH_LAST";
+ case OCI_FETCH_PRIOR: return "OCI_FETCH_PRIOR";
+ case OCI_FETCH_ABSOLUTE: return "OCI_FETCH_ABSOLUTE";
+ case OCI_FETCH_RELATIVE: return "OCI_FETCH_RELATIVE";
+ }
+ sv = sv_2mortal(newSViv((IV)fetchtype));
+ return SvPV(sv,PL_na);
+}
+
+
+
+
+static sb4
+oci_error_get(imp_xxh_t *imp_xxh,
+ OCIError *errhp, sword status, char *what, SV *errstr, int debug)
+{
+ dTHX;
+ text errbuf[1024];
+ ub4 recno = 0;
+ sb4 errcode = 0;
+ sb4 eg_errcode = 0;
+ sword eg_status;
+
+ if (!SvOK(errstr))
+ sv_setpv(errstr,"");
+
+ if (!errhp) {
+ sv_catpv(errstr, oci_status_name(status));
+ if (what) {
+ sv_catpv(errstr, " ");
+ sv_catpv(errstr, what);
+ }
+ return status;
+ }
+
+ while( ++recno
+ && OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf,
+ (ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA
+ && eg_status != OCI_INVALID_HANDLE
+ && recno < 100) {
+ if (debug >= 4 || recno>1/*XXX temp*/)
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh),
+ " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n",
+ what ? what : "<NULL>", (long)recno,
+ (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
+ status, (long)eg_errcode, errbuf);
+
+ errcode = eg_errcode;
+ sv_catpv(errstr, (char*)errbuf);
+
+ if (*(SvEND(errstr)-1) == '\n')
+ --SvCUR(errstr);
+ }
+
+ if (what || status != OCI_ERROR) {
+ sv_catpv(errstr, (debug<0) ? " (" : " (DBD ");
+ sv_catpv(errstr, oci_status_name(status));
+ if (what) {
+ sv_catpv(errstr, ": ");
+ sv_catpv(errstr, what);
+ }
+ sv_catpv(errstr, ")");
+ }
+ return errcode;
}
int
-oci_error(SV *h, OCIError *errhp, sword status, char *what)
+oci_error_err(SV *h, OCIError *errhp, sword status, char *what, sb4 force_err)
{
- D_imp_xxh(h);
- sb4 errcode = 0;
- SV *errstr = DBIc_ERRSTR(imp_xxh);
- sv_setpv(errstr, "");
- errcode = oci_error_get(errhp, status, what, errstr, DBIS->debug);
+ dTHX;
+ D_imp_xxh(h);
+ sb4 errcode;
+ SV *errstr_sv = sv_newmortal();
+ SV *errcode_sv = sv_newmortal();
+ errcode = oci_error_get(imp_xxh, errhp, status, what, errstr_sv,
+ DBIc_DBISTATE(imp_xxh)->debug);
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) {
+#ifdef sv_utf8_decode
+ sv_utf8_decode(errstr_sv);
+#else
+ SvUTF8_on(errstr_sv);
+#endif
+ }
+
+ /* DBIc_ERR *must* be SvTRUE (for RaiseError etc), some */
+ /* errors, like OCI_INVALID_HANDLE, don't set errcode. */
+ if (force_err)
+ errcode = force_err;
+ if (status == OCI_SUCCESS_WITH_INFO)
+ errcode = 0; /* record as a "warning" for DBI>=1.43 */
+ else if (errcode == 0)
+ errcode = (status != 0) ? status : -10000;
+
+ sv_setiv(errcode_sv, errcode);
+ DBIh_SET_ERR_SV(h, imp_xxh, errcode_sv, errstr_sv, &PL_sv_undef, &PL_sv_undef);
+ return 0; /* always returns 0 */
- /* DBIc_ERR *must* be SvTRUE (for RaiseError etc), some */
- /* errors, like OCI_INVALID_HANDLE, don't set errcode. */
- if (errcode == 0)
- errcode = (status != 0) ? status : -10000;
- sv_setiv(DBIc_ERR(imp_xxh), (IV)errcode);
- DBIh_EVENT2(h,
- (status == OCI_SUCCESS_WITH_INFO) ? WARN_event : ERROR_event,
- DBIc_ERR(imp_xxh), errstr);
- return 0; /* always returns 0 */
}
char *
ora_sql_error(imp_sth_t *imp_sth, char *msg)
{
-#ifdef OCI_ATTR_PARSE_ERROR_OFFSET_xxx
- imp_sth->cda->peo = 0;
- if (oparse(imp_sth->cda, (text*)imp_sth->statement, (sb4)-1,
- (sword)0/*oparse_defer*/, (ub4)oparse_lng)
- ) {
- char buf[99];
- char *hint = "";
- if (1) { /* XXX could make optional one day */
- SV *msgsv, *sqlsv;
- sprintf(buf,"error possibly near <*> indicator at char %d in '",
- imp_sth->cda->peo+1);
- msgsv = sv_2mortal(newSVpv(buf,0));
- sqlsv = sv_2mortal(newSVpv(imp_sth->statement,0));
- sv_insert(sqlsv, imp_sth->cda->peo, 0, "<*>",3);
- sv_catsv(msgsv, sqlsv);
- sv_catpv(msgsv, "'");
- hint = SvPV(msgsv,na);
- }
- ora_error(sth, imp_sth->cda, imp_sth->cda->rc, hint);
- oclose(imp_sth->cda); /* close the cursor */
- imp_sth->cda = NULL;
- return 0;
- }
+ dTHX;
+#ifdef OCI_ATTR_PARSE_ERROR_OFFSET
+ D_imp_dbh_from_sth;
+ SV *msgsv, *sqlsv;
+ char buf[99];
+ sword status = 0;
+ ub2 parse_error_offset = 0;
+ OCIAttrGet_stmhp_stat(imp_sth, &parse_error_offset, 0,
+ OCI_ATTR_PARSE_ERROR_OFFSET, status);
+ imp_dbh->parse_error_offset = parse_error_offset;
+ if (!parse_error_offset)
+ return msg;
+ sprintf(buf,"error possibly near <*> indicator at char %d in '",
+ parse_error_offset);
+ msgsv = sv_2mortal(newSVpv(buf,0));
+ sqlsv = sv_2mortal(newSVpv(imp_sth->statement,0));
+ sv_insert(sqlsv, parse_error_offset, 0, "<*>", 3);
+ sv_catsv(msgsv, sqlsv);
+ sv_catpv(msgsv, "'");
+ return SvPV(msgsv,PL_na);
#else
- imp_sth = imp_sth; /* not unused */
- return msg;
+ imp_sth = imp_sth; /* not unused */
+ return msg;
#endif
}
@@ -218,174 +937,223 @@ ora_sql_error(imp_sth_t *imp_sth, char *msg)
void *
oci_db_handle(imp_dbh_t *imp_dbh, int handle_type, int flags)
{
- switch(handle_type) {
- case OCI_HTYPE_ENV: return imp_dbh->envhp;
- case OCI_HTYPE_ERROR: return imp_dbh->errhp;
- case OCI_HTYPE_SERVER: return imp_dbh->srvhp;
- case OCI_HTYPE_SVCCTX: return imp_dbh->svchp;
- case OCI_HTYPE_SESSION: return imp_dbh->authp;
- }
- croak("Can't get OCI handle type %d from DBI database handle", handle_type);
- /* satisfy compiler warning, even though croak will never return */
- return 0;
+ dTHX;
+ switch(handle_type) {
+ case OCI_HTYPE_ENV: return imp_dbh->envhp;
+ case OCI_HTYPE_ERROR: return imp_dbh->errhp;
+ case OCI_HTYPE_SERVER: return imp_dbh->srvhp;
+ case OCI_HTYPE_SVCCTX: return imp_dbh->svchp;
+ case OCI_HTYPE_SESSION: return imp_dbh->seshp;
+ /*case OCI_HTYPE_AUTHINFO:return imp_dbh->authp;*/
+ }
+ croak("Can't get OCI handle type %d from DBI database handle", handle_type);
+ if( flags ) {/* For GCC not to warn on unused parameter */}
+ /* satisfy compiler warning, even though croak will never return */
+ return 0;
}
void *
oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags)
{
- switch(handle_type) {
- case OCI_HTYPE_ENV: return imp_sth->envhp;
- case OCI_HTYPE_ERROR: return imp_sth->errhp;
- case OCI_HTYPE_SERVER: return imp_sth->srvhp;
- case OCI_HTYPE_SVCCTX: return imp_sth->svchp;
- case OCI_HTYPE_STMT: return imp_sth->stmhp;
- }
- croak("Can't get OCI handle type %d from DBI statement handle", handle_type);
- /* satisfy compiler warning, even though croak will never return */
- return 0;
+ dTHX;
+ switch(handle_type) {
+ case OCI_HTYPE_ENV: return imp_sth->envhp;
+ case OCI_HTYPE_ERROR: return imp_sth->errhp;
+ case OCI_HTYPE_SERVER: return imp_sth->srvhp;
+ case OCI_HTYPE_SVCCTX: return imp_sth->svchp;
+ case OCI_HTYPE_STMT: return imp_sth->stmhp;
+ }
+ croak("Can't get OCI handle type %d from DBI statement handle", handle_type);
+ if( flags ) {/* For GCC not to warn on unused parameter */}
+ /* satisfy compiler warning, even though croak will never return */
+ return 0;
}
int
-dbd_st_prepare(sth, imp_sth, statement, attribs)
- SV *sth;
- imp_sth_t *imp_sth;
- char *statement;
- SV *attribs;
+dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs)
{
- D_imp_dbh_from_sth;
- sword status = 0;
- ub4 oparse_lng = 1; /* auto v6 or v7 as suits db connected to */
- int ora_check_sql = 1; /* to force a describe to check SQL */
+ dTHX;
+ D_imp_dbh_from_sth;
+ sword status = 0;
+ IV ora_piece_size = 0;
+ IV ora_pers_lob = 0;
+ IV ora_piece_lob = 0;
+ IV ora_clbk_lob = 0;
+ int ora_check_sql = 1; /* to force a describe to check SQL */
+ IV ora_placeholders = 1; /* find and handle placeholders */
/* XXX we set ora_check_sql on for now to force setup of the */
/* row cache. Change later to set up row cache using just a */
/* a memory size, perhaps also default $RowCacheSize to a */
/* negative value. OCI_ATTR_PREFETCH_MEMORY */
- if (!DBIc_ACTIVE(imp_dbh)) {
- oci_error(sth, NULL, OCI_ERROR, "Database disconnected");
- return 0;
- }
- imp_sth->done_desc = 0;
- imp_sth->get_oci_handle = oci_st_handle;
+ if (!DBIc_ACTIVE(imp_dbh)) {
+ oci_error(sth, NULL, OCI_ERROR, "Database disconnected");
+ return 0;
+ }
+
+ imp_dbh->parse_error_offset = 0;
- if (DBIc_COMPAT(imp_sth)) {
- static SV *ora_pad_empty;
- if (!ora_pad_empty) {
- ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty", GV_ADDMULTI);
- if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY"))
- sv_setiv(ora_pad_empty, atoi(getenv("ORAPERL_PAD_EMPTY")));
+ imp_sth->done_desc = 0;
+ imp_sth->get_oci_handle = oci_st_handle;
+
+ if (DBIc_COMPAT(imp_sth)) {
+ static SV *ora_pad_empty;
+ if (!ora_pad_empty) {
+ ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty", GV_ADDMULTI);
+ if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY"))
+ sv_setiv(ora_pad_empty, atoi(getenv("ORAPERL_PAD_EMPTY")));
+ }
+ imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ? SvIV(ora_pad_empty) : 0;
}
- imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ? SvIV(ora_pad_empty) : 0;
- }
- imp_sth->auto_lob = 1;
- if (attribs) {
- SV **svp;
- long tmp;
- DBD_ATTRIB_GET_IV( attribs, "ora_parse_lang", 14, svp, oparse_lng);
- /* JLU avoid warning */
- DBD_ATTRIB_GET_IV( attribs, "ora_auto_lob", 12, svp, tmp);
- imp_sth->auto_lob = (U16)tmp;
- /* ora_check_sql only works for selects owing to Oracle behaviour */
- DBD_ATTRIB_GET_IV( attribs, "ora_check_sql", 13, svp, ora_check_sql);
- }
+ imp_sth->auto_lob = 1;
+ imp_sth->exe_mode = OCI_DEFAULT;
+
+ if (attribs) {
+ SV **svp;
+ IV ora_auto_lob = 1;
+ DBD_ATTRIB_GET_IV( attribs, "ora_placeholders", 16, svp, ora_placeholders);
+ DBD_ATTRIB_GET_IV( attribs, "ora_auto_lob", 12, svp, ora_auto_lob);
+ DBD_ATTRIB_GET_IV( attribs, "ora_pers_lob", 12, svp, ora_pers_lob);
+ DBD_ATTRIB_GET_IV( attribs, "ora_clbk_lob", 12, svp, ora_clbk_lob);
+ DBD_ATTRIB_GET_IV( attribs, "ora_piece_lob", 13, svp, ora_piece_lob);
+ DBD_ATTRIB_GET_IV( attribs, "ora_piece_size", 14, svp, ora_piece_size);
+
+ imp_sth->auto_lob = (ora_auto_lob) ? 1 : 0;
+ imp_sth->pers_lob = (ora_pers_lob) ? 1 : 0;
+ imp_sth->clbk_lob = (ora_clbk_lob) ? 1 : 0;
+ imp_sth->piece_lob = (ora_piece_lob) ? 1 : 0;
+ imp_sth->piece_size = (ora_piece_size) ? ora_piece_size : 0;
+ imp_sth->prefetch_rows = 0;
+ imp_sth->prefetch_memory= 0;
+ /* ora_check_sql only works for selects owing to Oracle behaviour */
+ DBD_ATTRIB_GET_IV( attribs, "ora_check_sql", 13, svp, ora_check_sql);
+ DBD_ATTRIB_GET_IV( attribs, "ora_exe_mode", 12, svp, imp_sth->exe_mode);
+ DBD_ATTRIB_GET_IV( attribs, "ora_prefetch_memory", 19, svp, imp_sth->prefetch_memory);
+ DBD_ATTRIB_GET_IV( attribs, "ora_prefetch_rows", 17, svp, imp_sth->prefetch_rows);
+ DBD_ATTRIB_GET_IV( attribs, "ora_row_cache_off", 17, svp, imp_sth->row_cache_off);
+ DBD_ATTRIB_GET_IV( attribs, "ora_verbose", 11, svp, dbd_verbose);
+ DBD_ATTRIB_GET_IV( attribs, "ora_oci_success_warn", 20, svp, oci_warn);
+ DBD_ATTRIB_GET_IV( attribs, "ora_objects", 11, svp, ora_objects);
+ DBD_ATTRIB_GET_IV( attribs, "ora_ncs_buff_mtpl", 17, svp,ora_ncs_buff_mtpl);
+ DBD_ATTRIB_GET_IV( attribs, "RowCacheSize",12,svp, imp_sth->RowCacheSize);
+
+ if (!dbd_verbose)
+ DBD_ATTRIB_GET_IV( attribs, "dbd_verbose", 11, svp, dbd_verbose);
+ }
- /* scan statement for '?', ':1' and/or ':foo' style placeholders */
- dbd_preparse(imp_sth, statement);
- imp_sth->envhp = imp_dbh->envhp;
- imp_sth->errhp = imp_dbh->errhp;
- imp_sth->srvhp = imp_dbh->srvhp;
- imp_sth->svchp = imp_dbh->svchp;
+ /* scan statement for '?', ':1' and/or ':foo' style placeholders */
+ if (ora_placeholders)
+ dbd_preparse(imp_sth, statement);
+ else imp_sth->statement = savepv(statement);
- switch(oparse_lng) {
- case 0: /* old: calls for V6 syntax - give them V7 */
- case 2: /* old: calls for V7 syntax */
- case 7: oparse_lng = OCI_V7_SYNTAX; break;
- case 8: oparse_lng = OCI_V8_SYNTAX; break;
- default: oparse_lng = OCI_NTV_SYNTAX; break;
- }
+ imp_sth->envhp = imp_dbh->envhp;
+ imp_sth->errhp = imp_dbh->errhp;
+ imp_sth->srvhp = imp_dbh->srvhp;
+ imp_sth->svchp = imp_dbh->svchp;
- OCIHandleAlloc_ok(imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status);
- OCIStmtPrepare_log_stat(imp_sth->stmhp, imp_sth->errhp,
- (text*)imp_sth->statement, (ub4)strlen(imp_sth->statement),
- oparse_lng, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare");
- OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
- return 0;
- }
- OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s\n",
- oci_stmt_type_name(imp_sth->stmt_type));
- DBIc_IMPSET_on(imp_sth);
+ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status);
+ OCIStmtPrepare_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,
+ (text*)imp_sth->statement, (ub4)strlen(imp_sth->statement),
+ OCI_NTV_SYNTAX, OCI_DEFAULT, status);
- if (ora_check_sql) {
- if (!dbd_describe(sth, imp_sth))
- return 0;
- }
- else {
- /* set initial cache size by memory */
- ub4 cache_mem;
- D_imp_dbh_from_sth ;
- D_imp_drh_from_dbh ;
-
- if (SvOK(imp_drh -> ora_cache_o)) cache_mem = -SvIV(imp_drh -> ora_cache_o);
- else if (SvOK(imp_drh -> ora_cache)) cache_mem = -SvIV(imp_drh -> ora_cache);
- else cache_mem = -imp_dbh->RowCacheSize;
- if (cache_mem <= 0)
- cache_mem = 10 * 1460;
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_mem, sizeof(cache_mem), OCI_ATTR_PREFETCH_MEMORY,
- imp_sth->errhp, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status,
- "OCIAttrSet OCI_ATTR_PREFETCH_MEMORY");
- return 0;
- }
- }
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare");
+ OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status);
+
+ return 0;
+ }
+
+
+ OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_prepare'd sql %s ( auto_lob%d, check_sql%d)\n",
+ oci_stmt_type_name(imp_sth->stmt_type),
+ imp_sth->auto_lob, ora_check_sql);
+
+ DBIc_IMPSET_on(imp_sth);
+
+ if (ora_check_sql) {
+ if (!dbd_describe(sth, imp_sth))
+ return 0;
+ }
- return 1;
+ return 1;
}
sb4
dbd_phs_in(dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index,
- dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp)
+ dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp)
{
- phs_t *phs = octxp;
- STRLEN phs_len;
- if (phs->desc_h) {
- *bufpp = phs->desc_h;
- phs->alen = 0;
- phs->indp = 0;
- }
- else
- if (SvOK(phs->sv)) {
- *bufpp = SvPV(phs->sv, phs_len);
- phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;;
- phs->indp = 0;
- }
- else {
- *bufpp = SvPVX(phs->sv); /* not actually used? */
- phs->alen = 0;
- phs->indp = -1;
- }
- *alenp = phs->alen;
- *indpp = &phs->indp;
- *piecep = OCI_ONE_PIECE;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " in '%s' [%ld,%ld]: len %2ld, ind %d%s\n",
- phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp,
- (phs->desc_h) ? " via descriptor" : "");
- if (index > 0 || iter > 0)
- croak("Arrays and multiple iterations not currently supported by DBD::Oracle (in %d/%d)", index,iter);
- return OCI_CONTINUE;
+ dTHX;
+ phs_t *phs = (phs_t*)octxp;
+ STRLEN phs_len;
+ AV *tuples_av;
+ SV *sv;
+ AV *av;
+ SV **sv_p;
+ if( bindp ){ /* For GCC not to warn on unused parameter*/ }
+
+ tuples_av = phs->imp_sth->bind_tuples;
+ if(tuples_av) {
+ /* NOTE: we already checked the validity in ora_st_bind_for_array_exec(). */
+ sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ? (int)iter : phs->idx, 0);
+ av = (AV*)SvRV(*sv_p);
+ sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : (int)iter, 0);
+ sv = *sv_p;
+ if(SvOK(sv)) {
+ *bufpp = SvPV(sv, phs_len);
+ phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
+ phs->indp = 0;
+ }
+ else {
+ *bufpp = SvPVX(sv);
+ phs->alen = 0;
+ phs->indp = -1;
+ }
+ }
+ else
+ if (phs->desc_h) {
+ *bufpp = phs->desc_h;
+ phs->alen = 0;
+ phs->indp = 0;
+ }
+ else
+ if (SvOK(phs->sv)) {
+ *bufpp = SvPV(phs->sv, phs_len);
+ phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;;
+ phs->indp = 0;
+ }
+ else {
+ *bufpp = SvPVX(phs->sv); /* not actually used? */
+ phs->alen = 0;
+ phs->indp = -1;
+ }
+ *alenp = phs->alen;
+ *indpp = &phs->indp;
+ *piecep = OCI_ONE_PIECE;
+ /* MJE commented out as we are avoiding DBIS now but as this is
+ an Oracle callback there is no way to pass something non
+ OCI into this func.
+
+ if (DBIS->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP, " in '%s' [%lu,%lu]: len %2lu, ind %d%s, value=%s\n",
+ phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp,
+ (phs->desc_h) ? " via descriptor" : "",neatsvpv(phs->sv,10));
+ */
+ if (!tuples_av && (index > 0 || iter > 0))
+ croak(" Arrays and multiple iterations not currently supported by DBD::Oracle (in %d/%d)", index,iter);
+
+ return OCI_CONTINUE;
}
/*
@@ -394,37 +1162,37 @@ dbd_phs_in(dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index,
Binding RETURNING...INTO variables
As mentioned in the previous section, an OCI application implements the placeholders in the RETURNING clause as
-pure OUT bind variables. An application must adhere to the following rules when working with these bind variables:
+pure OUT bind variables. An application must adhere to the following rules when working with these bind variables:
1.Bind RETURNING clause placeholders in OCI_DATA_AT_EXEC mode using OCIBindByName() or
- OCIBindByPos(), followed by a call to OCIBindDynamic() for each placeholder.
+ OCIBindByPos(), followed by a call to OCIBindDynamic() for each placeholder.
- Note: The OCI only supports the callback mechanism for RETURNING clause binds. The polling mechanism is
- not supported.
+ Note: The OCI only supports the callback mechanism for RETURNING clause binds. The polling mechanism is
+ not supported.
2.When binding RETURNING clause placeholders, you must supply a valid out bind function as the ocbfp
- parameter of the OCIBindDynamic() call. This function must provide storage to hold the returned data.
+ parameter of the OCIBindDynamic() call. This function must provide storage to hold the returned data.
3.The icbfp parameter of OCIBindDynamic() call should provide a "dummy" function which returns NULL values
- when called.
- 4.The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE.
+ when called.
+ 4.The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE.
5.No duplicate binds are allowed in a DML statement with a RETURNING clause (i.e., no duplication between bind
- variables in the DML section and the RETURNING section of the statement).
+ variables in the DML section and the RETURNING section of the statement).
When a callback function is called, the OCI_ATTR_ROWS_RETURNED attribute of the bind handle tells the
application the number of rows being returned in that particular iteration. Thus, when the callback is called the first
time in a particular iteration (i.e., index=0), the user can allocate space for all the rows which will be returned for that
bind variable. When the callback is called subsequently (with index>0) within the same iteration, the user can merely
-increment the buffer pointer to the correct memory within the allocated space to retrieve the data.
+increment the buffer pointer to the correct memory within the allocated space to retrieve the data.
Every bind handle has a OCI_ATTR_MAXDATA_SIZE attribute. This attribute specifies the number of bytes to be
-allocated on the server to accommodate the client-side bind data after any necessary character set conversions.
+allocated on the server to accommodate the client-side bind data after any necessary character set conversions.
- Note: Character set conversions performed when data is sent to the server may result in the data expanding or
- contracting, so its size on the client may not be the same as its size on the server.
+ Note: Character set conversions performed when data is sent to the server may result in the data expanding or
+ contracting, so its size on the client may not be the same as its size on the server.
An application will typically set OCI_ATTR_MAXDATA_SIZE to the maximum size of the column or the size of the
PL/SQL variable, depending on how it is used. Oracle issues an error if OCI_ATTR_MAXDATA_SIZE is not a large
-enough value to accommodate the data after conversion, and the operation will fail.
+enough value to accommodate the data after conversion, and the operation will fail.
*/
sb4
@@ -439,51 +1207,196 @@ dbd_phs_out(dvoid *octxp, OCIBind *bindp,
/* value or a pointer to an indicator structure for named data types. */
ub2 **rcodepp) /* Returns a pointer to contains the return code. */
{
- phs_t *phs = octxp; /* context */
- /*imp_sth_t *imp_sth = phs->imp_sth;*/
+ dTHX;
+ phs_t *phs = (phs_t*)octxp; /* context */
+ /*imp_sth_t *imp_sth = phs->imp_sth;*/
+ if( bindp ) { /* For GCC not to warn on unused parameter */ }
- if (phs->desc_h) {
- *bufpp = phs->desc_h;
- phs->alen = 0;
- }
- else {
- SV *sv = phs->sv;
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- if (index > 0) /* finish-up handling previous element */
- dbd_phs_avsv_complete(phs, (I32)index-1, DBIS->debug);
- sv = *av_fetch((AV*)SvRV(sv), (IV)index, 1);
- if (!SvOK(sv))
- sv_setpv(sv,"");
- }
- *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 : phs->maxlen)+1)/*for null*/);
- phs->alen = SvLEN(sv); /* max buffer size now, actual data len later */
- }
- *alenpp = &phs->alen;
- *indpp = &phs->indp;
- *rcodepp= &phs->arcode;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld, piece %d%s\n",
- phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), *piecep,
- (phs->desc_h) ? " via descriptor" : "");
- if (iter > 0)
- warn("Multiple iterations not currently supported by DBD::Oracle (out %d/%d)", index,iter);
- *piecep = OCI_ONE_PIECE;
- return OCI_CONTINUE;
+ if (phs->desc_h) { /* a descriptor if present (LOBs etc)*/
+ *bufpp = phs->desc_h;
+ phs->alen = 0;
+
+ }
+ else {
+ SV *sv = phs->sv;
+
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ sv = *av_fetch((AV*)SvRV(sv), (IV)iter, 1);
+ if (!SvOK(sv))
+ sv_setpv(sv,"");
+ }
+
+ *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 : phs->maxlen)));
+ phs->alen = SvLEN(sv); /* max buffer size now, actual data len later */
+
+ }
+ *alenpp = &phs->alen;
+ *indpp = &phs->indp;
+ *rcodepp= &phs->arcode;
+ /* MJE commented out as we are avoiding DBIS now but as this is
+ an Oracle callback there is no way to pass something non
+ OCI into this func.
+
+ if (DBIS->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld, piece %d%s\n",
+ phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), *piecep,
+ (phs->desc_h) ? " via descriptor" : "");
+ */
+ *piecep = OCI_ONE_PIECE;
+ return OCI_CONTINUE;
+}
+
+/* --------------------------------------------------------------
+ Fetch callback fill buffers.
+ Finaly figured out how this fucntion works
+ Seems it is like this. The function inits and then fills the
+ buffer (fb_ary->abuf) with the data from the select until it
+ either runs out of data or its piece size is reached
+ (fb_ary->bufl). If its piece size is reached it then goes and gets
+ the the next piece and sets *piecep ==OCI_NEXT_PIECE at this point
+ I take the data in the buffer and memcpy it onto my buffer
+ (fb_ary->cb_abuf). This will go on until it runs out of full pieces
+ so when it returns to back to the fetch I add what remains in
+ (fb_ary->bufl) (the last piece) and memcpy onto my buffer (fb_ary->cb_abuf)
+ to get it all. I also take set fb_ary->cb_abuf back to empty just
+ to keep things clean
+ -------------------------------------------------------------- */
+sb4
+presist_lob_fetch_cbk(dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp,
+ ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcpp)
+{
+ dTHX;
+ imp_fbh_t *fbh =(imp_fbh_t*)octxp;
+ fb_ary_t *fb_ary;
+ fb_ary = fbh->fb_ary;
+ *bufpp = (dvoid *) fb_ary->abuf;
+ *alenpp = &fb_ary->bufl;
+ *indpp = (dvoid *) fb_ary->aindp;
+ *rcpp = fb_ary->arcode;
+
+
+ if (dbd_verbose >= 5 ) {
+ PerlIO_printf(DBILOGFP, " In presist_lob_fetch_cbk\n");
+ }
+
+ if ( *piecep ==OCI_NEXT_PIECE ){/*more than one piece*/
+
+ memcpy(fb_ary->cb_abuf+fb_ary->piece_count*fb_ary->bufl,fb_ary->abuf,fb_ary->bufl );
+ /*as we will be using both blobs and clobs we have to use
+ pointer arithmetic to get the values right. in this case we simply
+ copy all of the memory of the buff into the cb buffer starting
+ at the piece count * the buffer length
+ */
+
+ fb_ary->piece_count++;/*used to tell me how many pieces I have, Might be able to use aindp for this?*/
+
+ }
+
+
+ return OCI_CONTINUE;
+
+}
+
+/* TAF or Transparent Application Failoever callback
+ Works like this. The fuction below is registered on the server,
+ when the server is set up to use it, when an exe is called (not sure about other server round trips)
+ and the server fails tt should get into this cbk error below.
+ It will wait X seconds and then try to reconnect (up to n times if that is the users choice)
+ That is how I see it working */
+
+sb4
+taf_cbk(dvoid *svchp, dvoid *envhp, dvoid *fo_ctx,ub4 fo_type, ub4 fo_event )
+{
+ dTHX;
+ int return_count;
+ int ret;
+ taf_callback_t *cb =(taf_callback_t*)fo_ctx;
+
+ dSP;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSViv(fo_event)));
+ XPUSHs(sv_2mortal(newSViv(fo_type)));
+ XPUSHs(SvRV(cb->dbh_ref));
+
+ PUTBACK;
+ return_count = call_sv(cb->function, G_SCALAR);
+
+ SPAGAIN;
+
+ if (return_count != 1)
+ croak("Expected one scalar back from taf handler");
+
+ ret = POPi;
+
+ switch (fo_event){
+
+ case OCI_FO_BEGIN:
+ case OCI_FO_ABORT:
+ case OCI_FO_END:
+ case OCI_FO_REAUTH:
+ {
+ break;
+ }
+ case OCI_FO_ERROR:
+ {
+ if (ret == OCI_FO_RETRY) {
+ return OCI_FO_RETRY;
+ }
+ break;
+ }
+
+ default:
+ {
+ break;
+ }
+ }
+ PUTBACK;
+
+ return 0;
}
+sb4
+reg_taf_callback(SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ OCIFocbkStruct tafailover;
+ sword status;
+
+ imp_dbh->taf_ctx.function = imp_dbh->taf_function;
+ imp_dbh->taf_ctx.dbh_ref = newRV_inc(dbh);
+
+ if (dbd_verbose >= 5 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_dbh), " In reg_taf_callback\n");
+ }
+
+/* set the context up as a pointer to the taf callback struct*/
+ tafailover.fo_ctx = &imp_dbh->taf_ctx;
+ tafailover.callback_function = &taf_cbk;
+
+/* register the callback */
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER,
+ (dvoid *) &tafailover, (ub4) 0,
+ (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
+
+ return status;
+}
+
#ifdef UTF8_SUPPORT
/* How many bytes are n utf8 chars in buffer */
static ub4
ora_utf8_to_bytes (ub1 *buffer, ub4 chars_wanted, ub4 max_bytes)
{
- ub4 i = 0;
- while (i < max_bytes && (chars_wanted-- > 0)) {
- i += UTF8SKIP(&buffer[i]);
- }
- return (i < max_bytes)? i : max_bytes;
+ dTHX;
+ ub4 i = 0;
+ while (i < max_bytes && (chars_wanted-- > 0)) {
+ i += UTF8SKIP(&buffer[i]);
+ }
+ return (i < max_bytes)? i : max_bytes;
}
+
+#if 0 /* save this for later just in case... */
/* Given the 5.6.0 implementation of utf8 handling in perl,
* avoid setting the UTF8 flag as much as possible. Almost
* every binary operator in Perl will do conversions when
@@ -491,1012 +1404,2903 @@ ora_utf8_to_bytes (ub1 *buffer, ub4 chars_wanted, ub4 max_bytes)
* Maybe setting the flag should be default in Japan or
* Europe? Deduce that from NLS_LANG? Possibly...
*/
-#define DBD_SET_UTF8(sv) (cs_is_utf8? set_utf8(sv): 0)
-static int
+
+int
set_utf8(SV *sv) {
- ub1 *c;
- for (c = (ub1*)SvPVX(sv); c < (ub1*)SvEND(sv); c++) {
- if (*c & 0x80) {
- SvUTF8_on(sv);
- return 1;
+ ub1 *c;
+ for (c = (ub1*)SvPVX(sv); c < (ub1*)SvEND(sv); c++) {
+ if (*c & 0x80) {
+ SvUTF8_on(sv);
+ return 1;
+ }
}
- }
- return 0;
+ return 0;
}
#endif
+#endif
+/* PerlIO_printf(DBILOGFP, "lab datalen=%d long_readlen=%d bytelen=%d\n" ,datalen ,imp_sth->long_readlen, bytelen ); */
static int /* LONG and LONG RAW */
fetch_func_varfield(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
- D_imp_sth(sth);
- D_imp_dbh_from_sth ;
- D_imp_drh_from_dbh ;
- fb_ary_t *fb_ary = fbh->fb_ary;
- char *p = (char*)&fb_ary->abuf[0];
- ub4 datalen = *(ub4*)p; /* XXX alignment ? */
- p += 4;
+ dTHX;
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth ;
+ D_imp_drh_from_dbh ;
+ fb_ary_t *fb_ary = fbh->fb_ary;
+ char *p = (char*)&fb_ary->abuf[0];
+ ub4 datalen = *(ub4*)p; /* XXX alignment ? */
+ p += 4;
#ifdef UTF8_SUPPORT
- if (cs_is_utf8 && fbh->ftype == 94) {
- if (datalen > imp_sth->long_readlen) {
- ub4 bytelen = ora_utf8_to_bytes((ub1*)p, (ub4)imp_sth->long_readlen, datalen);
-
- if (bytelen < datalen) { /* will be truncated */
- int oraperl = DBIc_COMPAT(imp_sth);
- if (DBIc_has(imp_sth,DBIcf_LongTruncOk)
- || (oraperl && SvIV(imp_drh->ora_trunc))) {
- /* user says truncation is ok */
- /* Oraperl recorded the truncation in ora_errno so we */
- /* so also but only for Oraperl mode handles. */
- if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406);
- } else {
- char buf[300];
- sprintf(buf,"fetching field %d of %d. LONG value truncated from %ld to %ld. %s",
- fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), datalen, bytelen,
- "DBI attribute LongReadLen too small and/or LongTruncOk not set");
- oci_error(sth, NULL, OCI_ERROR, buf);
- sv_setiv(DBIc_ERR(imp_sth), (IV)24345); /* appropriate ORA error number */
- (void)SvOK_off(dest_sv);
- return 0;
- }
-
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " fetching field %d of %d. LONG value truncated from %ld to %ld.\n",
- fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), datalen, bytelen);
- datalen = bytelen;
- }
+ if (fbh->ftype == 94) {
+ if (datalen > imp_sth->long_readlen) {
+ ub4 bytelen = ora_utf8_to_bytes((ub1*)p, (ub4)imp_sth->long_readlen, datalen);
+
+ if (bytelen < datalen ) { /* will be truncated */
+ int oraperl = DBIc_COMPAT(imp_sth);
+ if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh->ora_trunc))) {
+ /* user says truncation is ok */
+ /* Oraperl recorded the truncation in ora_errno so we */
+ /* so also but only for Oraperl mode handles. */
+ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406);
+ } else {
+ char buf[300];
+ sprintf(buf,"fetching field %d of %d. LONG value truncated from %lu to %lu. %s",
+ fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(datalen), ul_t(bytelen),
+ "DBI attribute LongReadLen too small and/or LongTruncOk not set");
+ oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */
+ sv_set_undef(dest_sv);
+ return 0;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " fetching field %d of %d. LONG value truncated from "
+ "%lu to %lu.\n",
+ fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth),
+ ul_t(datalen), ul_t(bytelen));
+ datalen = bytelen;
+ }
}
sv_setpvn(dest_sv, p, (STRLEN)datalen);
- DBD_SET_UTF8(dest_sv);
- } else {
+ if (CSFORM_IMPLIES_UTF8(fbh->csform))
+ SvUTF8_on(dest_sv);
+ } else {
#else
- {
+ {
#endif
sv_setpvn(dest_sv, p, (STRLEN)datalen);
- }
+ }
- return 1;
+ return 1;
}
-static int
-fetch_func_nty(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+static void
+fetch_cleanup_rset(SV *sth, imp_fbh_t *fbh)
{
- fb_ary_t *fb_ary = fbh->fb_ary;
- char *p = (char*)&fb_ary->abuf[0];
- ub4 datalen = *(ub4*)p; /* XXX alignment ? */
- warn("fetch_func_nty unimplemented (datalen %d)", datalen);
- SvOK_off(dest_sv);
- return 1;
-}
-
+ dTHX;
+ D_imp_sth(sth);
+ SV *sth_nested = (SV *)fbh->special;
+ fbh->special = NULL;
-/* ------ */
+ if( sth ) { /* For GCC not to warn on unused parameter */ }
+ if (sth_nested) {
+ dTHR;
+ D_impdata(imp_sth_nested, imp_sth_t, sth_nested);
+ int fields = DBIc_NUM_FIELDS(imp_sth_nested);
+ int i;
+ for(i=0; i < fields; ++i) {
+ imp_fbh_t *fbh_nested = &imp_sth_nested->fbh[i];
+ if (fbh_nested->fetch_cleanup)
+ fbh_nested->fetch_cleanup(sth_nested, fbh_nested);
+ }
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " fetch_cleanup_rset - deactivating handle %s (defunct nested cursor)\n",
+ neatsvpv(sth_nested, 0));
+ DBIc_ACTIVE_off(imp_sth_nested);
+ SvREFCNT_dec(sth_nested);
+ }
+}
-#ifdef moved_to_dbdimp
-int
-pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
+static int
+fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
- if (pre_exec) { /* pre-execute - allocate a statement handle */
- dSP;
+ dTHX;
+ OCIStmt *stmhp_nested = ((OCIStmt **)fbh->fb_ary->abuf)[0];
+ dTHR;
+ D_imp_sth(sth);
D_imp_dbh_from_sth;
- SV *sth_i;
- HV *init_attr = newHV();
+ dSP;
+ HV *init_attr = newHV();
int count;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name);
- ENTER;
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newRV(DBIc_MY_H(imp_dbh))));
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " fetch_func_rset - allocating handle for cursor nested within %s ...\n",
+ neatsvpv(sth, 0));
+
+ ENTER; SAVETMPS; PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh))));
XPUSHs(sv_2mortal(newRV((SV*)init_attr)));
PUTBACK;
count = perl_call_pv("DBI::_new_sth", G_ARRAY);
SPAGAIN;
if (count != 2)
- croak("panic: DBI::_new_sth returned %d values instead of 2", count);
- sth_i = SvREFCNT_inc(POPs);
- sv_setsv(phs->sv, SvREFCNT_inc(POPs)); /* outer handle */
- PUTBACK;
- LEAVE;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - allocated %s...\n",
- phs->name, neatsvpv(phs->sv, 0));
+ croak("panic: DBI::_new_sth returned %d values instead of 2", count);
- }
- else { /* post-execute - setup the statement handle */
- dTHR;
- SV * sth_csr = phs->sv;
- D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
-
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " bind %s - initialising new %s...\n",
- phs->name, neatsvpv(sth_csr,0));
-
-#ifdef OCI_V8_SYNTAX
- /* copy appropriate handles from parent statement */
- imp_sth_csr->envhp = imp_sth->envhp;
- imp_sth_csr->errhp = imp_sth->errhp;
- imp_sth_csr->srvhp = imp_sth->srvhp;
- imp_sth_csr->svchp = imp_sth->svchp;
-
- /* assign statement handle from placeholder descriptor */
- imp_sth_csr->stmhp = phs->desc_h;
- imp_sth_csr->disable_finish = 1; /* else finish core dumps in kpuccan()! */
-
- /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */
- imp_sth_csr->stmt_type = OCI_STMT_SELECT;
-#else
+ if(POPs){} /* For GCC not to warn on unused result */
-#endif
+ sv_setsv(dest_sv, POPs);
+ SvREFCNT_dec(init_attr);
+ PUTBACK; FREETMPS; LEAVE;
- DBIc_IMPSET_on(imp_sth);
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " fetch_func_rset - ... allocated %s for nested cursor\n",
+ neatsvpv(dest_sv, 0));
- /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */
- DBIc_ACTIVE_on(imp_sth_csr);
- if (!dbd_describe(sth_csr, imp_sth_csr)) {
- return 0;
- }
- }
- return 1;
-}
-#endif
+ fbh->special = (void *)newSVsv(dest_sv);
+ {
+ D_impdata(imp_sth_nested, imp_sth_t, dest_sv);
+ imp_sth_nested->envhp = imp_sth->envhp;
+ imp_sth_nested->errhp = imp_sth->errhp;
+ imp_sth_nested->srvhp = imp_sth->srvhp;
+ imp_sth_nested->svchp = imp_sth->svchp;
-int
-dbd_rebind_ph_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
-{
- /* Only do this part for inout cursor refs because pp_exec_rset only gets called for all the output params */
- if (phs->is_inout) {
- phs->out_prepost_exec = pp_exec_rset;
- return 2; /* OCI bind done */
- }
- else {
- /* Call a special rebinder for cursor ref "in" params */
- return(pp_rebind_ph_rset_in(sth, imp_sth, phs));
- }
-}
+ imp_sth_nested->stmhp = stmhp_nested;
+ imp_sth_nested->nested_cursor = 1;
+ imp_sth_nested->stmt_type = OCI_STMT_SELECT;
+
+ DBIc_IMPSET_on(imp_sth_nested);
+ DBIc_ACTIVE_on(imp_sth_nested); /* So describe won't do an execute */
+
+ if (!dbd_describe(dest_sv, imp_sth_nested))
+ return 0;
+ }
+
+ return 1;
+}
+/* ------ */
+
+
+int
+dbd_rebind_ph_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+{
+ dTHX;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_rebind_ph_rset phs->is_inout=%d\n",
+ phs->is_inout);
+
+/* Only do this part for inout cursor refs because pp_exec_rset only gets called for all the output params */
+ if (phs->is_inout) {
+ phs->out_prepost_exec = pp_exec_rset;
+ return 2; /* OCI bind done */
+ }
+ else {
+ /* Call a special rebinder for cursor ref "in" params */
+ return(pp_rebind_ph_rset_in(sth, imp_sth, phs));
+ }
+}
/* ------ */
+static int
+fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name);
-int
-dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+static int
+lob_phs_post_execute(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
{
- sword status;
- ub4 lobEmpty = 0;
+ dTHX;
+ if (pre_exec)
+ return 1;
+ /* fetch PL/SQL LOB data */
+ if (imp_sth->auto_lob && (
+ imp_sth->stmt_type == OCI_STMT_BEGIN ||
+ imp_sth->stmt_type == OCI_STMT_DECLARE )) {
+ return fetch_lob(sth, imp_sth, (OCILobLocator*) phs->desc_h, phs->ftype, phs->sv, phs->name);
+ }
+
+ sv_setref_pv(phs->sv, "OCILobLocatorPtr", (void*)phs->desc_h);
+
+ return 1;
+}
- if (!SvPOK(phs->sv)) { /* normalizations for special cases */
- if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
- if (!(SvROK(phs->sv) && phs->is_inout))
- sv_2pv(phs->sv, &na);
+int
+dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+{
+ dTHX;
+ D_imp_dbh_from_sth ;
+ sword status;
+ ub4 lobEmpty = 0;
+ if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB)
+ ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h);
+
+ if (!phs->desc_h) {
+ ++imp_sth->has_lobs;
+ phs->desc_t = OCI_DTYPE_LOB;
+ OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp,
+ &phs->desc_h, phs->desc_t);
}
- else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */
- SvUPGRADE(phs->sv, SVt_PV);
- phs->indp = -1;
- return 1;
+
+ OCIAttrSet_log_stat(imp_sth, phs->desc_h, phs->desc_t,
+ &lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);
+
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_LOBEMPTY");
+
+ if (!SvPOK(phs->sv)) { /* normalizations for special cases */
+ if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
+ if (!(SvROK(phs->sv) && phs->is_inout))
+ sv_2pv(phs->sv, &PL_na);
+ }
+ else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */
+ (void)SvUPGRADE(phs->sv, SVt_PV);
+ }
}
- }
- if (!phs->desc_h) {
- ++imp_sth->has_lobs;
- phs->desc_t = OCI_DTYPE_LOB;
- OCIDescriptorAlloc_ok(imp_sth->envhp,
- &phs->desc_h, phs->desc_t);
- }
- OCIAttrSet_log_stat(phs->desc_h, phs->desc_t,
- &lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);
- if (status != OCI_SUCCESS)
- return oci_error(sth, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_LOBEMPTY");
- phs->indp = 0;
- phs->progv = (void*)&phs->desc_h;
- phs->maxlen = sizeof(OCILobLocator*);
+ phs->indp = (SvOK(phs->sv)) ? 0 : -1;
+ phs->progv = (char*)&phs->desc_h;
+ phs->maxlen = sizeof(OCILobLocator*);
- return 1;
+ if (phs->is_inout)
+ phs->out_prepost_exec = lob_phs_post_execute;
+ /* accept input LOBs */
+
+ if (sv_isobject(phs->sv) && sv_derived_from(phs->sv, "OCILobLocatorPtr")) {
+
+ OCILobLocator *src;
+ OCILobLocator **dest;
+ src = INT2PTR(OCILobLocator *, SvIV(SvRV(phs->sv)));
+ dest = (OCILobLocator **) phs->progv;
+
+ OCILobLocatorAssign_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp, src, dest, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobLocatorAssign");
+ return 0;
+ }
+ }
+
+ /* create temporary LOB for PL/SQL placeholder */
+ else if (imp_sth->stmt_type == OCI_STMT_BEGIN ||
+ imp_sth->stmt_type == OCI_STMT_DECLARE) {
+ ub4 amtp;
+
+ (void)SvUPGRADE(phs->sv, SVt_PV);
+
+ amtp = SvCUR(phs->sv); /* XXX UTF8? */
+
+ /* Create a temp lob for non-empty string */
+
+ if (amtp > 0) {
+ ub1 lobtype = (phs->ftype == 112 ? OCI_TEMP_CLOB : OCI_TEMP_BLOB);
+ OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp,
+ (OCILobLocator *) phs->desc_h, (ub2) OCI_DEFAULT,
+ (ub1) OCI_DEFAULT, lobtype, TRUE, OCI_DURATION_SESSION, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary");
+ return 0;
+ }
+
+ if( ! phs->csid ) {
+ ub1 csform = SQLCS_IMPLICIT;
+ ub2 csid = 0;
+ OCILobCharSetForm_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ (OCILobLocator*)phs->desc_h,
+ &csform,
+ status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
+#ifdef OCI_ATTR_CHARSET_ID
+ /* Effectively only used so AL32UTF8 works properly */
+ OCILobCharSetId_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ (OCILobLocator*)phs->desc_h,
+ &csid,
+ status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetId");
+#endif /* OCI_ATTR_CHARSET_ID */
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
+ phs->csid = csid;
+ phs->csform = csform;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " calling OCILobWrite phs->csid=%d phs->csform=%d amtp=%d\n",
+ phs->csid, phs->csform, amtp );
+
+ /* write lob data */
+
+ OCILobWrite_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
+ (OCILobLocator*)phs->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
+ 0,0, phs->csid, phs->csform, status);
+ if (status != OCI_SUCCESS) {
+ return oci_error(sth, imp_sth->errhp, status, "OCILobWrite in dbd_rebind_ph_lob");
+ }
+ }
+ }
+ return 1;
}
#ifdef UTF8_SUPPORT
ub4
-ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh,
- SV *dest_sv, long offset, long len, long destoffset)
+ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh,
+ SV *dest_sv, long offset, ub4 len, long destoffset)
{
- ub4 loblen = 0;
- ub4 buflen;
- ub4 amtp = 0;
- ub4 byte_destoffset = 0;
- OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h;
- sword ftype = fbh->ftype;
- sword status;
-
- /*
- * We assume our caller has already done the
- * equivalent of the following:
- * (void)SvUPGRADE(dest_sv, SVt_PV);
- */
-
- if (ftype != 112) {
- oci_error(sth, imp_sth->errhp, OCI_ERROR,
- "blob_read not currently supported for non-CLOB types with OCI 8 "
- "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
- "so you don't need to call blob_read at all)");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
- }
+ dTHX;
+ ub4 loblen = 0;
+ ub4 buflen;
+ ub4 amtp = 0;
+ ub4 byte_destoffset = 0;
+ OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h;
+ sword ftype = fbh->ftype;
+ sword status;
+
+ /*
+ * We assume our caller has already done the
+ * equivalent of the following:
+ * (void)SvUPGRADE(dest_sv, SVt_PV);
+ */
+ ub1 csform = SQLCS_IMPLICIT;
+
+ OCILobCharSetForm_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ lobl,
+ &csform,
+ status );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
+ if (ftype != ORA_CLOB) {
+ oci_error(sth, imp_sth->errhp, OCI_ERROR,
+ "blob_read not currently supported for non-CLOB types with OCI 8 "
+ "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
+ "so you don't need to call blob_read at all)");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
- OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp,
- lobl, &loblen, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobGetLength");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
- }
+ OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
+ lobl, &loblen, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_mb_piece");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
- loblen -= offset; /* only count from offset onwards */
- amtp = (loblen > len) ? len : loblen;
- buflen = 4 * amtp;
-
- byte_destoffset = ora_utf8_to_bytes((ub1 *)(SvPVX(dest_sv)),
- (ub4)destoffset, SvCUR(dest_sv));
-
- if (loblen > 0) {
- ub1 *dest_bufp;
- ub1 *buffer;
-
- New(42, buffer, buflen, ub1);
-
- OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobl,
- &amtp, (ub4)1 + offset, buffer, buflen,
- 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status);
- if (dbis->debug >= 3)
- PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, oci_status_name(status), loblen,
- imp_sth->long_readlen, buflen, amtp);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobRead");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
- }
-
- amtp = ora_utf8_to_bytes(buffer, len, amtp);
- SvGROW(dest_sv, byte_destoffset + amtp + 1);
- dest_bufp = (ub1 *)(SvPVX(dest_sv));
- dest_bufp += byte_destoffset;
- memcpy(dest_bufp, buffer, amtp);
- Safefree(buffer);
- }
- else {
- assert(amtp == 0);
- SvGROW(dest_sv, byte_destoffset + 1);
- if (dbis->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, "SKIPPED", loblen, imp_sth->long_readlen, buflen, amtp);
- }
+ loblen -= offset; /* only count from offset onwards */
+ amtp = (loblen > len) ? len : loblen;
+ buflen = 4 * amtp;
+
+ byte_destoffset = ora_utf8_to_bytes((ub1 *)(SvPVX(dest_sv)),
+ (ub4)destoffset, SvCUR(dest_sv));
+
+ if (loblen > 0) {
+ ub1 *dest_bufp;
+ ub1 *buffer;
+
+ New(42, buffer, buflen, ub1);
+
+ OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl,
+ &amtp, (ub4)1 + offset, buffer, buflen,
+ 0, 0, (ub2)0 ,csform ,status );
+ /* lab 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status); */
+
+ if (dbis->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, "
+ "BufLen %lu, Got %lu\n",
+ fbh->field_num+1, oci_status_name(status), ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobRead");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
+
+ amtp = ora_utf8_to_bytes(buffer, len, amtp);
+ SvGROW(dest_sv, byte_destoffset + amtp + 1);
+ dest_bufp = (ub1 *)(SvPVX(dest_sv));
+ dest_bufp += byte_destoffset;
+ memcpy(dest_bufp, buffer, amtp);
+ Safefree(buffer);
+ }
+ else {
+ assert(amtp == 0);
+ SvGROW(dest_sv, byte_destoffset + 1);
+ if (dbis->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, "
+ "BufLen %lu, Got %lu\n",
+ fbh->field_num+1, "SKIPPED", (unsigned long)loblen,
+ (unsigned long)imp_sth->long_readlen, (unsigned long)buflen,
+ (unsigned long)amtp);
+ }
+
+ if (dbis->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " blob_read field %d, ftype %d, offset %ld, len %lu, "
+ "destoffset %ld, retlen %lu\n",
+ fbh->field_num+1, ftype, offset, len, destoffset, ul_t(amtp));
- if (dbis->debug >= 3)
- PerlIO_printf(DBILOGFP, " blob_read field %d, ftype %d, offset %ld, len %ld, destoffset %ld, retlen %ld\n",
- fbh->field_num+1, ftype, offset, len, destoffset, amtp);
-
- SvCUR_set(dest_sv, byte_destoffset+amtp);
- *SvEND(dest_sv) = '\0'; /* consistent with perl sv_setpvn etc */
- SvPOK_on(dest_sv);
- DBD_SET_UTF8(dest_sv);
+ SvCUR_set(dest_sv, byte_destoffset+amtp);
+ *SvEND(dest_sv) = '\0'; /* consistent with perl sv_setpvn etc */
+ SvPOK_on(dest_sv);
+ if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform))
+ SvUTF8_on(dest_sv);
- return 1;
+ return 1;
}
#endif /* ifdef UTF8_SUPPORT */
ub4
ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv,
- long offset, long len, long destoffset)
+ long offset, UV len, long destoffset)
{
- ub4 loblen = 0;
- ub4 buflen;
- ub4 amtp = 0;
- OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h;
- sword ftype = fbh->ftype;
- sword status;
-
- if (ftype != 112 && ftype != 113) {
- oci_error(sth, imp_sth->errhp, OCI_ERROR,
- "blob_read not currently supported for non-LOB types with OCI 8 "
- "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
- "so you don't need to call blob_read at all)");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
- }
+ dTHX;
+ ub4 loblen = 0;
+ ub4 buflen;
+ ub4 amtp = 0;
+ ub1 csform = 0;
+ OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h;
+ sword ftype = fbh->ftype;
+ sword status;
+ char *type_name;
+
+ if (ftype == ORA_CLOB)
+ type_name = "CLOB";
+ else if (ftype == ORA_BLOB)
+ type_name = "BLOB";
+ else if (ftype == ORA_BFILE)
+ type_name = "BFILE";
+ else {
+ oci_error(sth, imp_sth->errhp, OCI_ERROR,
+ "blob_read not currently supported for non-LOB types with OCI 8 "
+ "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
+ "so you don't need to call blob_read at all)");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
- OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobGetLength");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
- }
+ OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_piece");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
- amtp = (loblen > len) ? len : loblen;
- buflen = amtp; /* set right semantics for OCILobRead */
-
- /*
- * We assume our caller has already done the
- * equivalent of the following:
- * (void)SvUPGRADE(dest_sv, SVt_PV);
- * SvGROW(dest_sv, buflen+destoffset+1);
- */
-
- if (loblen > 0) {
- ub1 * bufp = (ub1 *)(SvPVX(dest_sv));
- bufp += destoffset;
-
- OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobl,
- &amtp, (ub4)1 + offset, bufp, buflen,
- 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, oci_status_name(status), ul_t(loblen),
- imp_sth->long_readlen, ul_t(buflen), ul_t(amtp));
+ OCILobCharSetForm_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ lobl,
+ &csform,
+ status );
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobRead");
- (void)SvOK_off(dest_sv); /* signal error */
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
+ if (ftype == ORA_CLOB && csform == SQLCS_NCHAR)
+ type_name = "NCLOB";
+
+ /*
+ * We assume our caller has already done the
+ * equivalent of the following:
+ * (void)SvUPGRADE(dest_sv, SVt_PV);
+ * SvGROW(dest_sv, buflen+destoffset+1);
+ */
+
+ /* amtp is: LOB/BFILE CLOB/NCLOB
+ Input bytes characters
+ Output FW bytes characters (FW=Fixed Width charset, VW=Variable)
+ Output VW bytes characters(in), bytes returned (afterwards)
+ */
+
+ amtp = (loblen > len) ? len : loblen;
+
+ /* buflen: length of buffer in bytes */
+ /* so for CLOBs that'll be returned as UTF8 we need more bytes that chars */
+ /* XXX the x4 here isn't perfect - really the code should be changed to loop */
+
+ if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) {
+ buflen = amtp * 4;
+ /* XXX destoffset would be counting chars here as well */
+ SvGROW(dest_sv, (destoffset*4) + buflen + 1);
+ if (destoffset) {
+ oci_error(sth, imp_sth->errhp, OCI_ERROR,
+ "blob_read with non-zero destoffset not currently supported for UTF8 values");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
+ }
+ else {
+ buflen = amtp;
}
- }
- else {
- assert(amtp == 0);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, "SKIPPED", ul_t(loblen),
- imp_sth->long_readlen, ul_t(buflen), ul_t(amtp));
- }
- /*
- * We assume our caller will perform
- * the equivalent of the following:
- * SvCUR(dest_sv) = amtp;
- * *SvEND(dest_sv) = '\0';
- * SvPOK_on(dest_sv);
- */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " blob_read field %d: ftype %d %s, offset %ld, len %lu."
+ "LOB csform %d, len %lu, amtp %lu, (destoffset=%ld)\n",
+ fbh->field_num+1, ftype, type_name, offset, ul_t(len),
+ csform,(unsigned long) (loblen), ul_t(amtp), destoffset);
+
+ if (loblen > 0) {
+ ub1 * bufp = (ub1 *)(SvPVX(dest_sv));
+ bufp += destoffset;
+
+ OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl,
+ &amtp, (ub4)1 + offset, bufp, buflen,
+ 0, 0, (ub2)0 , csform, status);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu,"
+ "BufLen %lu, amtp %lu\n",
+ fbh->field_num+1, oci_status_name(status), ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobRead");
+ sv_set_undef(dest_sv); /* signal error */
+ return 0;
+ }
+ if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform))
+ SvUTF8_on(dest_sv);
+ }
+ else {
+ assert(amtp == 0);
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, "
+ "BufLen %lu, Got %lu\n",
+ fbh->field_num+1, "SKIPPED", ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
+ }
- return(amtp);
+ /*
+ * We assume our caller will perform
+ * the equivalent of the following:
+ * SvCUR(dest_sv) = amtp;
+ * *SvEND(dest_sv) = '\0';
+ * SvPOK_on(dest_sv);
+ */
+
+ return(amtp);
}
static int
-fetch_func_autolob(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name)
{
- ub4 loblen = 0;
- ub4 buflen;
- ub4 amtp = 0;
- imp_sth_t *imp_sth = fbh->imp_sth;
- OCILobLocator *lobloc = (OCILobLocator*)fbh->desc_h;
- sword status;
-
- /* this function is not called for NULL lobs */
-
- /* The length is expressed in terms of bytes for BLOBs and BFILEs, */
- /* and in terms of characters for CLOBs */
- OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobGetLength");
- return 0;
- }
+ dTHX;
+ ub4 loblen = 0;
+ ub4 buflen = 0;
+ ub4 amtp = 0;
+ sword status;
- amtp = (loblen > imp_sth->long_readlen) ? imp_sth->long_readlen : loblen;
- if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */
- int oraperl = DBIc_COMPAT(imp_sth);
- D_imp_dbh_from_sth ;
- D_imp_drh_from_dbh ;
+ if (!name)
+ name = "an unknown field";
+
+ /* this function is not called for NULL lobs */
- if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) {
- /* user says truncation is ok */
- /* Oraperl recorded the truncation in ora_errno so we */
- /* so also but only for Oraperl mode handles. */
- if (oraperl)
- sv_setiv(DBIc_ERR(imp_sth), 1406);
+ /* The length is expressed in terms of bytes for BLOBs and BFILEs, */
+ /* and in terms of characters for CLOBs and NCLOBS */
+ OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_lob");
+ return 0;
}
- else {
- char buf[300];
- sprintf(buf,"fetching field %d of %d. LOB value truncated from %ld to %ld. %s",
- fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(loblen), ul_t(amtp),
- "DBI attribute LongReadLen too small and/or LongTruncOk not set");
- oci_error(sth, NULL, OCI_ERROR, buf);
- sv_setiv(DBIc_ERR(imp_sth), (IV)24345); /* appropriate ORA error number */
- (void)SvOK_off(dest_sv);
- return 0;
- }
- }
- /* set char vs bytes and get right semantics for OCILobRead */
- if (fbh->dbtype==112) {
- buflen = amtp * 4; /* XXX bit of a hack, efective but wasteful */
- }
- else buflen = amtp;
+ if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */
+ int oraperl = DBIc_COMPAT(imp_sth);
+ D_imp_dbh_from_sth ;
+ D_imp_drh_from_dbh ;
+
+ /* move setting amtp up to ensure error message OK */
+ amtp = imp_sth->long_readlen;
+ if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) {
+ /* user says truncation is ok */
+ /* Oraperl recorded the truncation in ora_errno so we */
+ /* so also but only for Oraperl mode handles. */
+ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406);
+ }
+ else {
+ char buf[300];
+ sprintf(buf,"fetching %s. LOB value truncated from %ld to %ld. %s",
+ name, ul_t(loblen), ul_t(amtp),
+ "DBI attribute LongReadLen too small and/or LongTruncOk not set");
+ oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */
+ sv_set_undef(dest_sv);
+ return 0;
+ }
+ }
+ else
+ amtp = loblen;
- (void)SvUPGRADE(dest_sv, SVt_PV);
+ (void)SvUPGRADE(dest_sv, SVt_PV);
- SvGROW(dest_sv, buflen+1);
+ /* XXXX I've hacked on this and left it probably broken
+ because I didn't have time to research which args to OCI funcs need
+ to be in char or byte units. That still needs to be done.
+ better variable names may help.
+ (The old version (1.15) duplicated too much code here because
+ I applied a contributed patch that wasn't ideal, I had too little time
+ to sort it out.)
+ Whatever is done here, similar changes are probably needed for the
+ ora_lob_*() methods when handling CLOBs.
+ */
- if (loblen > 0) {
-#ifdef UTF8_SUPPORT
- if (cs_is_utf8 && fbh->ftype == 112) {
- ub4 alloclen = buflen << 2;
- char *buffer;
- New(42, buffer, alloclen, char);
- OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc,
- &amtp, (ub4)1, buffer, alloclen,
- 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status);
-
- if (DBIS->debug >= 3) {
- PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, oci_status_name(status), loblen,
- imp_sth->long_readlen, alloclen, amtp);
- }
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobRead");
- (void)SvOK_off(dest_sv);
- return 0;
- }
-
- SvGROW(dest_sv, amtp+1);
- memcpy(SvPVX(dest_sv), buffer, amtp);
- Safefree(buffer);
-
- /* tell perl what we've put in its dest_sv */
- SvCUR(dest_sv) = amtp;
- *SvEND(dest_sv) = '\0';
- DBD_SET_UTF8(dest_sv);
- }
- else
-#endif /* ifdef UTF8_SUPPORT */
- {
- SvGROW(dest_sv, buflen+1);
- if (fbh->dbtype == 114) {
- OCILobFileOpen_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc,
- (ub1)OCI_FILE_READONLY, status);
- if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobFileOpen");
- (void)SvOK_off(dest_sv);
+ /* Yep you did bust it good and bad. Seem that when the charset of
+ the client and the DB are comptiable the buflen and amtp are both in chars
+ no matter how many bytes make up the chars. If it is the case were the Client's
+ NLS_LANG or NLS_NCHAR is not a subset of the Server's the server will try to traslate
+ the data to the Client's wishes and that is wen it uses will send the ampt value will be in bytes*/
+
+ buflen = amtp;
+ if (ftype == ORA_CLOB)
+ buflen = buflen*ora_ncs_buff_mtpl;
+
+
+ SvGROW(dest_sv, buflen+1);
+
+ if (loblen > 0) {
+ ub1 csform = 0;
+ OCILobCharSetForm_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ lobloc,
+ &csform,
+ status );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
+ sv_set_undef(dest_sv);
+ return 0;
+ }
+
+ if (ftype == ORA_BFILE) {
+ OCILobFileOpen_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc,
+ (ub1)OCI_FILE_READONLY, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobFileOpen");
+ sv_set_undef(dest_sv);
+ return 0;
+ }
+ }
+
+ OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc,
+ &amtp, (ub4)1, SvPVX(dest_sv), buflen,
+ 0, 0, (ub2)0, csform, status);
+
+ if (status != OCI_SUCCESS ) {
+
+ if (status == OCI_NEED_DATA ){
+ char buf[300];
+ sprintf(buf,"fetching %s. LOB and the read bufer is only %lubytes, and the ora_ncs_buff_mtpl is %d, which is too small. Try setting ora_ncs_buff_mtpl to %d",
+ name, (unsigned long)buflen, ora_ncs_buff_mtpl,ora_ncs_buff_mtpl+1);
+
+ oci_error_err(sth, NULL, OCI_ERROR, buf, OCI_NEED_DATA); /* appropriate ORA error number */
+ /*croak("DBD::Oracle has returned a %s status when doing a LobRead!! \n",oci_status_name(status));*/
+
+ /*why a croak here well if it goes on it will result in a
+ ORA-03127: no new operations allowed until the active operation ends
+ This will result in a crash if there are any other fetchst*/
+ }
+ else {
+ oci_error(sth, imp_sth->errhp, status, "OCILobRead");
+ sv_set_undef(dest_sv);
+
+ }
return 0;
- }
- }
-
- OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc,
- &amtp, (ub4)1, SvPVX(dest_sv), buflen,
- 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " OCILobRead field %d %s: LOBlen %ldc, LongReadLen %ldc, BufLen %ldb, Got %ldc\n",
- fbh->field_num+1, oci_status_name(status), ul_t(loblen),
- imp_sth->long_readlen, ul_t(buflen), ul_t(amtp));
- if (fbh->dbtype == 114) {
- OCILobFileClose_log_stat(imp_sth->svchp, imp_sth->errhp,
+ }
+
+
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn){
+ char buf[11];
+ strcpy(buf,"bytes");
+ if (ftype == ORA_CLOB)
+ strcpy(buf,"characters");
+
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead %s %s: csform %d (%s), LOBlen %lu(%s), "
+ "LongReadLen %lu(%s), BufLen %lu(%s), Got %lu(%s)\n",
+ name, oci_status_name(status), csform, oci_csform_name(csform),
+ ul_t(loblen),buf ,
+ ul_t(imp_sth->long_readlen),buf, ul_t(buflen),buf, ul_t(amtp),buf);
+
+ }
+ if (ftype == ORA_BFILE) {
+ OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
lobloc, status);
}
+
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobRead");
- (void)SvOK_off(dest_sv);
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCILobFileClose");
+ sv_set_undef(dest_sv);
+ return 0;
}
-
+
/* tell perl what we've put in its dest_sv */
SvCUR(dest_sv) = amtp;
*SvEND(dest_sv) = '\0';
+ if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) /* Don't set UTF8 on BLOBs */
+ SvUTF8_on(dest_sv);
+ ora_free_templob(sth, imp_sth, lobloc);
+ }
+ else { /* LOB length is 0 */
+ assert(amtp == 0);
+ /* tell perl what we've put in its dest_sv */
+ SvCUR(dest_sv) = amtp;
+ *SvEND(dest_sv) = '\0';
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, "
+ "BufLen %lu, Got %lu\n",
+ name, "SKIPPED", ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
}
-
- }
- else {
- assert(amtp == 0);
- /* tell perl what we've put in its dest_sv */
- SvGROW(dest_sv, buflen+1);
- SvCUR(dest_sv) = amtp;
- *SvEND(dest_sv) = '\0';
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n",
- fbh->field_num+1, "SKIPPED", ul_t(loblen),
- imp_sth->long_readlen, ul_t(buflen), ul_t(amtp));
- }
- SvPOK_on(dest_sv);
+ SvPOK_on(dest_sv);
- return 1;
+ return 1;
+}
+
+static int
+fetch_func_autolob(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+{
+ dTHX;
+ char name[64];
+ sprintf(name, "field %d of %d", fbh->field_num, DBIc_NUM_FIELDS(fbh->imp_sth));
+ return fetch_lob(sth, fbh->imp_sth, (OCILobLocator*)fbh->desc_h, fbh->ftype, dest_sv, name);
}
static int
fetch_func_getrefpv(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
- /* See the Oracle::OCI module for how to actually use this! */
- sv_setref_pv(dest_sv, fbh->bless, (void*)fbh->desc_h);
- return 1;
+ dTHX;
+ if( sth ) { /* For GCC not to warn on unused parameter */ }
+ /* See the Oracle::OCI module for how to actually use this! */
+ sv_setref_pv(dest_sv, fbh->bless, (void*)fbh->desc_h);
+ return 1;
+}
+
+#ifdef OCI_DTYPE_REF
+static void
+fbh_setup_getrefpv(imp_sth_t *imp_sth, imp_fbh_t *fbh, int desc_t, char *bless)
+{
+ dTHX;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " col %d: otype %d, desctype %d, %s", fbh->field_num, fbh->dbtype, desc_t, bless);
+ fbh->ftype = fbh->dbtype;
+ fbh->disize = fbh->dbsize;
+ fbh->fetch_func = fetch_func_getrefpv;
+ fbh->bless = bless;
+ fbh->desc_t = desc_t;
+ OCIDescriptorAlloc_ok(imp_sth, fbh->imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
+}
+#endif
+
+
+static int
+calc_cache_rows(int cache_rows, int num_fields, int est_width, int has_longs,ub4 prefetch_memory)
+{
+ dTHX;
+ /* Use guessed average on-the-wire row width calculated above & */
+ /* add in overhead of 5 bytes per field plus 8 bytes per row. */
+ /* The n*5+8 was determined by studying SQL*Net v2 packets. */
+ /* It could probably benefit from a more detailed analysis. */
+
+ est_width += num_fields*5 + 8;
+
+ if (has_longs) { /* override/disable caching */
+ cache_rows = 1; /* else read_blob can't work */
+ }
+ else if (prefetch_memory) { /*set rows by memory*/
+
+ cache_rows=prefetch_memory/est_width;
+ }
+ else{
+ if (cache_rows == 0) { /* automatically size the cache */
+ /* automatically size the cache */
+
+ /* Oracle packets on ethernet have max size of around 1460. */
+ /* We'll aim to fill our row cache with around 10 per go. */
+ /* Using 10 means any 'runt' packets will have less impact. */
+ /* orginally set up as above but playing around with newer versions*/
+ /* I found that 500 was much faster*/
+ int txfr_size = 10 * 1460; /* desired transfer/cache size */
+
+ cache_rows = txfr_size / est_width; /* (maybe 1 or 0) */
+
+ /* To ensure good performance with large rows (near or larger */
+ /* than our target transfer size) we set a minimum cache size. */
+ /* I made them all at least 10* what they were before this */
+ /* main reasoning this old value reprewneted a norm in the oralce 7~8 */
+ /* 9 to 11 can handel much much more */
+ if (cache_rows < 60) /* is cache a 'useful' size? */
+ cache_rows = (cache_rows > 0) ? 60 : 40;
+ }
+ }
+ if (cache_rows > 10000000) /* keep within Oracle's limits */
+ cache_rows = 10000000; /* seems it was ub2 at one time now ub4 this number is arbitary on my part*/
+
+
+ return cache_rows;
+}
+
+/* called by get_object to return the actual value in the property */
+
+static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeCode typecode, dvoid *attr_value )
+{
+ dTHX;
+ D_imp_sth(sth);
+ text str_buf[200];
+ double dnum;
+ size_t str_len;
+ ub4 ub4_str_len;
+ OCIRaw *raw = (OCIRaw *) 0;
+ OCIString *vs = (OCIString *) 0;
+ ub1 *temp = (ub1 *)0;
+ ub4 rawsize = 0;
+ ub4 i = 0;
+ sword status;
+ SV *raw_sv;
+
+ /* get the data based on the type code*/
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " getting value of object attribute named %s with typecode=%s\n",
+ name,oci_typecode_name(typecode));
+ }
+
+ switch (typecode)
+ {
+
+ case OCI_TYPECODE_INTERVAL_YM :
+ case OCI_TYPECODE_INTERVAL_DS :
+
+ OCIIntervalToText_log_stat(fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ attr_value,
+ str_buf,
+ (size_t) 200,
+ &str_len,
+ status);
+ str_buf[str_len+1] = '\0';
+ av_push(list, newSVpv( (char *) str_buf,0));
+ break;
+
+ case OCI_TYPECODE_TIMESTAMP_TZ :
+ case OCI_TYPECODE_TIMESTAMP_LTZ :
+ case OCI_TYPECODE_TIMESTAMP :
+
+
+ ub4_str_len = 200;
+ OCIDateTimeToText_log_stat(fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ attr_value,
+ &ub4_str_len,
+ str_buf,
+ status);
+
+ if (typecode == OCI_TYPECODE_TIMESTAMP_TZ || typecode == OCI_TYPECODE_TIMESTAMP_LTZ){
+ char s_tz_hour[3]="000";
+ char s_tz_min[3]="000";
+ sb1 tz_hour;
+ sb1 tz_minute;
+ status = OCIDateTimeGetTimeZoneOffset (fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ *(OCIDateTime**)attr_value,
+ &tz_hour,
+ &tz_minute );
+
+ if ( (tz_hour<0) && (tz_hour>-10) ){
+ sprintf(s_tz_hour," %03d",tz_hour);
+ } else {
+ sprintf(s_tz_hour," %02d",tz_hour);
+ }
+
+ sprintf(s_tz_min,":%02d", tz_minute);
+ strcat((signed char*)str_buf, s_tz_hour);
+ strcat((signed char*)str_buf, s_tz_min);
+ str_buf[ub4_str_len+7] = '\0';
+
+ } else {
+ str_buf[ub4_str_len+1] = '\0';
+ }
+
+ av_push(list, newSVpv( (char *) str_buf,0));
+ break;
+
+ case OCI_TYPECODE_DATE : /* fixed length string*/
+ ub4_str_len = 200;
+ OCIDateToText_log_stat(fbh->imp_sth,
+ fbh->imp_sth->errhp,
+ (CONST OCIDate *) attr_value,
+ &ub4_str_len,
+ str_buf,
+ status);
+ str_buf[ub4_str_len+1] = '\0';
+ av_push(list, newSVpv( (char *) str_buf,0));
+ break;
+
+
+ case OCI_TYPECODE_CLOB:
+ case OCI_TYPECODE_BLOB:
+ case OCI_TYPECODE_BFILE:
+ raw_sv = newSV(0);
+ fetch_lob(sth, fbh->imp_sth,*(OCILobLocator**)attr_value, typecode, raw_sv, (signed char*)name);
+
+
+ av_push(list, raw_sv);
+ break;
+
+ case OCI_TYPECODE_RAW :/* RAW*/
+
+ raw_sv = newSV(0);
+ raw = *(OCIRaw **) attr_value;
+ temp = OCIRawPtr(fbh->imp_sth->envhp, raw);
+ rawsize = OCIRawSize (fbh->imp_sth->envhp, raw);
+ for (i=0; i < rawsize; i++) {
+ sv_catpvf(raw_sv,"0x%x ", temp[i]);
+ }
+ sv_catpv(raw_sv,"\n");
+
+ av_push(list, raw_sv);
+
+ break;
+ case OCI_TYPECODE_CHAR : /* fixed length string */
+ case OCI_TYPECODE_VARCHAR : /* varchar */
+ case OCI_TYPECODE_VARCHAR2 : /* varchar2 */
+ vs = *(OCIString **) attr_value;
+ av_push(list, newSVpv((char *) OCIStringPtr(fbh->imp_sth->envhp, vs),0));
+ break;
+ case OCI_TYPECODE_SIGNED8 : /* BYTE - sb1 */
+ av_push(list, newSVuv(*(sb1 *)attr_value));
+ break;
+ case OCI_TYPECODE_UNSIGNED8 : /* UNSIGNED BYTE - ub1 */
+ av_push(list, newSViv(*(ub1 *)attr_value));
+ break;
+ case OCI_TYPECODE_OCTET : /* OCT*/
+ av_push(list, newSViv(*(ub1 *)attr_value));
+ break;
+ case OCI_TYPECODE_UNSIGNED16 : /* UNSIGNED SHORT */
+ case OCI_TYPECODE_UNSIGNED32 : /* UNSIGNED LONG */
+ case OCI_TYPECODE_REAL : /* REAL */
+ case OCI_TYPECODE_DOUBLE : /* DOUBLE */
+ case OCI_TYPECODE_INTEGER : /* INT */
+ case OCI_TYPECODE_SIGNED16 : /* SHORT */
+ case OCI_TYPECODE_SIGNED32 : /* LONG */
+ case OCI_TYPECODE_DECIMAL : /* DECIMAL */
+ case OCI_TYPECODE_FLOAT : /* FLOAT */
+ case OCI_TYPECODE_NUMBER : /* NUMBER */
+ case OCI_TYPECODE_SMALLINT : /* SMALLINT */
+ (void) OCINumberToReal(fbh->imp_sth->errhp, (CONST OCINumber *) attr_value,
+ (uword) sizeof(dnum), (dvoid *) &dnum);
+
+ av_push(list, newSVnv(dnum));
+ break;
+ default:
+ break;
+ }
+}
+
+
+SV* new_ora_object (AV* list, OCITypeCode typecode) {
+ dTHX;
+ SV* objref = newRV_noinc((SV*) list);
+
+ if (ora_objects && typecode == OCI_TYPECODE_OBJECT) {
+ HV* self = newHV();
+ (void)hv_store(self, "type_name", 9, av_shift(list), 0);
+ (void)hv_store(self, "attributes", 10, objref, 0);
+ objref = newRV_noinc((SV*) self);
+ objref = sv_bless(objref, gv_stashpv("DBD::Oracle::Object", 0));
+
+ }
+ return objref;
+}
+
+/*gets the properties of an object from a fetch by using the attributes saved in the describe */
+
+int
+get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObject *value, OCIType *instance_tdo, dvoid *obj_ind){
+
+ dTHX;
+ D_imp_sth(sth);
+ sword status;
+ dvoid *element ;
+ dvoid *attr_value;
+ boolean eoc;
+ ub2 pos;
+ dvoid *attr_null_struct;
+ OCIInd attr_null_status;
+ OCIInd *element_null;
+ OCIType *attr_tdo;
+ OCIIter *itr;
+ fbh_obj_t *fld;
+ fbh_obj_t *obj = base_obj;
+
+ OCIType *tdo = instance_tdo ? instance_tdo : obj->tdo;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " getting attributes of object named %s with typecode=%s\n",
+ obj->type_name,oci_typecode_name(obj->typecode));
+ }
+
+ switch (obj->typecode) {
+
+ case OCI_TYPECODE_OBJECT: /* embedded ADT */
+ case OCI_TYPECODE_OPAQUE: /*doesn't do anything though*/
+ if (ora_objects){
+
+
+ sword status;
+ if (!instance_tdo && !obj->is_final_type) {
+ OCIRef *type_ref=0;
+ status = OCIObjectNew(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->imp_sth->svchp,
+ OCI_TYPECODE_REF, (OCIType *)0,
+ (dvoid *)0, OCI_DURATION_DEFAULT, TRUE,
+ (dvoid **) &type_ref);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectNew");
+ return 0;
+ }
+
+ status=OCIObjectGetTypeRef(fbh->imp_sth->envhp,fbh->imp_sth->errhp, (dvoid*)value, type_ref);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetTypeRef");
+ return 0;
+ }
+
+ OCITypeByRef_log_stat(fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ type_ref,
+ &tdo,status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCITypeByRef");
+ return 0;
+ }
+
+ status = OCIObjectFree(fbh->imp_sth->envhp, fbh->imp_sth->errhp, type_ref, (ub2)0);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectFree");
+ return 0;
+ }
+
+ }
+
+
+ if (tdo != obj->tdo) {
+ /* this is subtype -> search for subtype obj */
+ while (obj->next_subtype && tdo != obj->tdo) {
+ obj = obj->next_subtype;
+ }
+ if (tdo != obj->tdo) {
+ /* new subtyped -> get obj description */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " describe subtype (tdo=%p) of object type %s (tdo=%p)\n",(void*)tdo,base_obj->type_name,(void*)base_obj->tdo);
+ }
+
+ Newz(1, obj->next_subtype, 1, fbh_obj_t);
+ obj->next_subtype->tdo = tdo;
+ if ( describe_obj_by_tdo(sth, fbh->imp_sth, obj->next_subtype, 0 /*unknown level there*/) ) {
+ obj = obj->next_subtype;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
+ dump_struct(fbh->imp_sth,obj,0);
+ }
+ }
+ else {
+ obj->next_subtype = 0;
+ }
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " getting attributes of object subtype %s\n",obj->type_name);
+ }
+ }
+
+ av_push(list, newSVpv((char*)obj->type_name, obj->type_namel));
+ }
+
+
+
+ for (pos = 0; pos < obj->field_count; pos++){
+
+ fld = &obj->fields[pos]; /*get the field */
+
+ if (ora_objects) {
+ /* add field name */
+ av_push(list, newSVpv((char*)fld->type_name, fld->type_namel));
+ }
+
+/*
+the little bastard above took me ages to find out
+seems Oracle does not like people to know that it can do this
+the concept is simple really
+ 1. pin the object
+ 2. bind with dty = SQLT_NTY
+ 3. OCIDefineObject using the TDO
+ 4. one gets the null indicator of the objcet with OCIObjectGetInd
+ The the obj_ind is for the entier object not the properties so you call it once it
+ gets all of the indicators for the objects so you pass it into OCIObjectGetAttr and that
+ function will set attr_null_status as in the get below.
+ 5. interate over the atributes of the object
+
+The thing to remember is that OCI and C have no way of representing a DB NULLs so we use the OCIInd find out
+if the object or any of its properties are NULL, This is one little line in a 20 chapter book and even then
+id only shows you examples with the C struct built in and only a single record. Nowhere does it say you can do it this way.
+*/
+
+ OCIObjectGetAttr_log_stat(
+ fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ value, /* instance */
+ obj_ind, /* null_struct */
+ tdo, /* tdo */
+ (CONST oratext**)&fld->type_name, /* names */
+ &fld->type_namel, /* lengths */
+ 1, /* name_count */
+ (ub4 *)0, /* indexes */
+ 0, /* index_count */
+ &attr_null_status, /* attr_null_status */
+ &attr_null_struct, /* attr_null_struct */
+ &attr_value, /* attr_value */
+ &attr_tdo, /* attr_tdo */
+ status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetAttr");
+ return 0;
+ }
+
+ if (attr_null_status==OCI_IND_NULL){
+ av_push(list, &PL_sv_undef);
+ } else {
+ if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){
+
+ fld->fields[0].value = newAV();
+ if (fld->typecode != OCI_TYPECODE_OBJECT)
+ attr_value = *(dvoid **)attr_value;
+
+ if (!get_object (sth,fld->fields[0].value, fbh, &fld->fields[0],attr_value, attr_tdo, attr_null_struct))
+ return 0;
+ av_push(list, new_ora_object(fld->fields[0].value, fld->typecode));
+
+ } else{ /* else, display the scaler type attribute */
+
+ get_attr_val(sth,list, fbh, fld->type_name, fld->typecode, attr_value);
+
+ }
+ }
+ }
+ break;
+
+ case OCI_TYPECODE_REF : /* embedded ADT */
+ croak("panic: OCI_TYPECODE_REF objets () are not supported ");
+ break;
+
+ case OCI_TYPECODE_NAMEDCOLLECTION : /*this works for both as I am using CONST OCIColl */
+
+ switch (obj->col_typecode) { /*there may be more thatn two I havn't found them yet mmight be XML??*/
+ case OCI_TYPECODE_TABLE : /* nested table */
+ case OCI_TYPECODE_VARRAY : /* variable array */
+ fld = &obj->fields[0]; /*get the field */
+ OCIIterCreate_log_stat(fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ (OCIColl*) value,
+ &itr,
+ status);
+ if (status != OCI_SUCCESS) {
+ /*not really an error just no data
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterCreate");*/
+ status = OCI_SUCCESS;
+ av_push(list, &PL_sv_undef);
+ return 0;
+ }
+ for(eoc = FALSE;!OCIIterNext(fbh->imp_sth->envhp, fbh->imp_sth->errhp, itr,
+ (dvoid **) &element,
+ (dvoid **) &element_null, &eoc) && !eoc;)
+ {
+
+ if (*element_null==OCI_IND_NULL){
+ av_push(list, &PL_sv_undef);
+ } else {
+ if (obj->element_typecode == OCI_TYPECODE_OBJECT || obj->element_typecode == OCI_TYPECODE_VARRAY || obj->element_typecode== OCI_TYPECODE_TABLE || obj->element_typecode== OCI_TYPECODE_NAMEDCOLLECTION){
+ fld->value = newAV();
+ if(!get_object (sth,fld->value, fbh, fld,element,0,element_null))
+ return 0;
+ av_push(list, new_ora_object(fld->value, obj->element_typecode));
+ } else{ /* else, display the scaler type attribute */
+ get_attr_val(sth,list, fbh, obj->type_name, obj->element_typecode, element);
+ }
+ }
+ }
+ /*nasty surprise here. one has to get rid of the iterator or you will leak memory
+ not documented in oci or in demos */
+ OCIIterDelete_log_stat(fbh->imp_sth,
+ fbh->imp_sth->envhp,
+ fbh->imp_sth->errhp,
+ &itr,
+ status );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterDelete");
+ return 0;
+ }
+ break;
+ default:
+ break;
+ }
+ break;
+ default:
+ if (value) {
+ get_attr_val(sth,list, fbh, obj->type_name, obj->typecode, value);
+ }
+ else
+ return 1;
+ break;
+ }
+ return 1;
+ }
+
+
+
+/*cutsom fetch for embedded objects */
+
+static int
+fetch_func_oci_object(SV *sth, imp_fbh_t *fbh,SV *dest_sv)
+{
+ dTHX;
+ D_imp_sth(sth);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth),
+ " getting an embedded object named %s with typecode=%s\n",
+ fbh->obj->type_name,oci_typecode_name(fbh->obj->typecode));
+ }
+
+ if (fbh->obj->obj_ind && fbh->obj->obj_ind[0] == OCI_IND_NULL) {
+ sv_set_undef(dest_sv);
+ return 1;
+ }
+
+ fbh->obj->value=newAV();
+
+ /*will return referance to an array of scalars*/
+ if (!get_object(sth,fbh->obj->value,fbh,fbh->obj,fbh->obj->obj_value,0,fbh->obj->obj_ind)){
+ return 0;
+ } else {
+ sv_setsv(dest_sv, sv_2mortal(new_ora_object(fbh->obj->value, fbh->obj->typecode)));
+ return 1;
+ }
+
+}
+
+
+
+static int
+fetch_clbk_lob(SV *sth, imp_fbh_t *fbh,SV *dest_sv){
+
+ dTHX;
+ D_imp_sth(sth);
+ fb_ary_t *fb_ary = fbh->fb_ary;
+
+ ub4 actual_bufl=imp_sth->piece_size*(fb_ary->piece_count)+fb_ary->bufl;
+
+ if (fb_ary->piece_count==0){
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Fetch persistent lob of %d (char/bytes) with callback in 1 "
+ "piece of %d (Char/Bytes)\n",
+ actual_bufl,fb_ary->bufl);
+
+ memcpy(fb_ary->cb_abuf,fb_ary->abuf,fb_ary->bufl );
+
+ } else {
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Fetch persistent lob of %d (Char/Bytes) with callback in %d "
+ "piece(s) of %d (Char/Bytes) and one piece of %d (Char/Bytes)\n",
+ actual_bufl,fb_ary->piece_count,fbh->piece_size,fb_ary->bufl);
+
+ memcpy(fb_ary->cb_abuf+imp_sth->piece_size*(fb_ary->piece_count),fb_ary->abuf,fb_ary->bufl );
+ }
+
+ if (fbh->ftype == SQLT_BIN){
+ *(fb_ary->cb_abuf+(actual_bufl))='\0'; /* add a null teminator*/
+ sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl);
+ } else {
+ sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl);
+ if (CSFORM_IMPLIES_UTF8(fbh->csform) ){
+ SvUTF8_on(dest_sv);
+ }
+ }
+ return 1;
+}
+/* This is another way to get lobs as a alternate to callback */
+
+static int
+fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv)
+{
+ dTHX;
+ D_imp_sth(sth);
+ fb_ary_t *fb_ary = fbh->fb_ary;
+ ub4 buflen = fb_ary->bufl;
+ ub4 actual_bufl = 0;
+ ub1 piece = OCI_FIRST_PIECE;
+ void *hdlptr = (dvoid *) 0;
+ ub4 hdltype = OCI_HTYPE_DEFINE, iter = 0, idx = 0;
+ ub1 in_out = 0;
+ sb2 indptr = 0;
+ ub2 rcode = 0;
+ sword status = OCI_NEED_DATA;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) {
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), "in fetch_get_piece \n");
+ }
+
+ while (status == OCI_NEED_DATA){
+
+ OCIStmtGetPieceInfo_log_stat(fbh->imp_sth,
+ fbh->imp_sth->stmhp,
+ fbh->imp_sth->errhp,
+ &hdlptr,
+ &hdltype,
+ &in_out,
+ &iter,
+ &idx,
+ &piece,
+ status);
+
+ /* This is how this works
+ First we get the piece Info above
+ the bugger thing is that this will get the piece info in sequential order so on each call to the above
+ you have to check to ensure you have the right define handle from the OCIDefineByPos
+ I do it in the next if statement. So this will loop untill the handle changes at that point it exits the loop
+ during the loop I add the abuf to the cb_abuf using the buflen that is set above.
+ I get the actual buffer length by adding up all the pieces (buflen) as I go along
+ Another really anoying thing is once can only find out if there is data left over at the very end of the fetching of the colums
+ so I make it warn if the LongTruncOk. I could also do this before but that would not result in any of the good data getting
+ in
+ */
+ if ( hdlptr==fbh->defnp){
+
+ OCIStmtSetPieceInfo_log_stat(fbh->imp_sth,
+ fbh->defnp,
+ fbh->imp_sth->errhp,
+ fb_ary->abuf,
+ &buflen,
+ piece,
+ (dvoid *)&indptr,
+ &rcode,status);
+
+
+ OCIStmtFetch_log_stat(fbh->imp_sth, fbh->imp_sth->stmhp,fbh->imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status);
+
+
+ if (status==OCI_SUCCESS_WITH_INFO && !DBIc_has(fbh->imp_sth,DBIcf_LongTruncOk)){
+ dTHR; /* for DBIc_ACTIVE_off */
+ DBIc_ACTIVE_off(fbh->imp_sth); /* eg finish */
+ oci_error(sth, fbh->imp_sth->errhp, status, "OCIStmtFetch, LongReadLen too small and/or LongTruncOk not set");
+ }
+ memcpy(fb_ary->cb_abuf+fb_ary->piece_count*imp_sth->piece_size,fb_ary->abuf,buflen );
+ fb_ary->piece_count++;/*used to tell me how many pieces I have, for debuffing in this case */
+ actual_bufl=actual_bufl+buflen;
+
+ }else {
+ status=OCI_LAST_PIECE;
+ }
+ }
+
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ){
+ if (fb_ary->piece_count==1){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Fetch persistent lob of %d (Char/Bytes) with Polling "
+ "in 1 piece\n",
+ actual_bufl);
+
+ } else {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Fetch persistent lob of %d (Char/Bytes) with Polling "
+ "in %d piece(s) of %d (Char/Bytes) and one piece of %d (Char/Bytes)\n",
+ actual_bufl,fb_ary->piece_count,fbh->piece_size,buflen);
+ }
+ }
+ sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl);
+
+ if (fbh->ftype != SQLT_BIN){
+
+ if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ /* do the UTF 8 magic*/
+ SvUTF8_on(dest_sv);
+ }
+ }
+
+ return 1;
+}
+
+
+int
+empty_oci_object(fbh_obj_t *obj){
+ dTHX;
+ int pos =0;
+ fbh_obj_t *fld=NULL;
+
+
+
+ switch (obj->element_typecode) {
+
+ case OCI_TYPECODE_OBJECT : /* embedded ADT */
+ case OCI_TYPECODE_OPAQUE : /*usually an XML object*/
+ if (obj->next_subtype) {
+ empty_oci_object(obj->next_subtype);
+ }
+
+ for (pos = 0; pos < obj->field_count; pos++){
+ fld = &obj->fields[pos]; /*get the field */
+ if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){
+ empty_oci_object(fld);
+ if (fld->value && SvTYPE(fld->value) == SVt_PVAV){
+ av_clear(fld->value);
+ av_undef(fld->value);
+ }
+ }
+ else {
+ return 1;
+ }
+ }
+ break;
+
+ case OCI_TYPECODE_NAMEDCOLLECTION :
+ fld = &obj->fields[0]; /*get the field */
+ if (obj->element_typecode == OCI_TYPECODE_OBJECT){
+ empty_oci_object(fld);
+ }
+ if (fld->value && SvTYPE(fld->value)){
+ if (SvTYPE(fld->value) == SVt_PVAV){
+ av_clear(fld->value);
+ av_undef(fld->value);
+ }
+ }
+ break;
+
+ default:
+ break;
+ }
+ if ( fld && fld->value && (SvTYPE(fld->value) == SVt_PVAV) ){
+ av_clear(obj->value);
+ av_undef(obj->value);
+ }
+
+ return 1;
+
+}
+
+static void
+fetch_cleanup_pres_lobs(SV *sth,imp_fbh_t *fbh){
+ dTHX;
+ D_imp_sth(sth);
+
+ fb_ary_t *fb_ary = fbh->fb_ary;
+
+ if( sth ) { /* For GCC not to warn on unused parameter*/ }
+ fb_ary->piece_count=0;/*reset the peice counter*/
+ memset( fb_ary->abuf, '\0', fb_ary->bufl); /*clean out the piece fetch buffer*/
+ fb_ary->bufl=fbh->piece_size; /*reset this back to the piece length */
+ fb_ary->cb_bufl=fbh->disize; /*reset this back to the max size for the fetch*/
+ memset( fb_ary->cb_abuf, '\0', fbh->disize ); /*clean out the call back buffer*/
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_pres_lobs \n");
+
+ return;
+}
+
+static void
+fetch_cleanup_oci_object(SV *sth, imp_fbh_t *fbh){
+ dTHX;
+ D_imp_sth(sth);
+
+ if( sth ) { /* For GCC not to warn on unused parameter*/ }
+
+ if (fbh->obj){
+ if(fbh->obj->obj_value || fbh->obj->obj_ind){
+ empty_oci_object(fbh->obj);
+ }
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_oci_object \n");
+ return;
+}
+
+void rs_array_init(imp_sth_t *imp_sth)
+{
+ dTHX;
+
+ imp_sth->rs_array_num_rows =0;
+ imp_sth->rs_array_idx =0;
+ imp_sth->rs_fetch_count =0;
+ imp_sth->rs_array_status =OCI_SUCCESS;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " rs_array_init:imp_sth->rs_array_size=%d, rs_array_idx=%d, "
+ "prefetch_rows=%d, rs_array_status=%s\n",
+ imp_sth->rs_array_size, imp_sth->rs_array_idx, imp_sth->prefetch_rows,
+ oci_status_name(imp_sth->rs_array_status));
}
-static void
-fbh_setup_getrefpv(imp_fbh_t *fbh, int desc_t, char *bless)
-{
- if (DBIS->debug >= 2)
- PerlIO_printf(DBILOGFP,
- " col %d: otype %d, desctype %d, %s", fbh->field_num, fbh->dbtype, desc_t, bless);
- fbh->ftype = fbh->dbtype;
- fbh->disize = fbh->dbsize;
- fbh->fetch_func = fetch_func_getrefpv;
- fbh->bless = bless;
- fbh->desc_t = desc_t;
- OCIDescriptorAlloc_ok(fbh->imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
-}
+static int /* --- Setup the row cache for this sth --- */
+sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int num_fields, int has_longs)
+{
+ dTHX;
+ D_imp_dbh_from_sth;
+ D_imp_drh_from_dbh;
+ int num_errors = 0;
+ ub4 prefetch_mem = 0; /*Oracle prefetch memory buffer*/
+ sb4 prefetch_rows = 0; /*Oracle prefetch Row Buffer*/
+ sb4 cache_rows = 0;/* set high so memory is the limit */
+ sword status;
+
+
+
+ if (imp_sth->RowCacheSize ) { /*Statment value will crump the handle value */
+ cache_rows=imp_sth->RowCacheSize;
+ }
+ else if (imp_dbh->RowCacheSize){
+ cache_rows=imp_dbh->RowCacheSize;
+
+ }
+
+ /* seems that RowCacheSize was incorrectly used in the past
+ in the DBI Spect RowCacheSize is to be used for a local row cache
+ and can be set on both the handle and the statement and the statement will take
+ precideace
+
+ From DBI POD
+ A hint to the driver indicating the size of the local
+ row cache that the application would like the driver to
+ use for future SELECT statements.
+
+ so RowCacheSize is for a local cache to cut down on round trips
+
+ The OCI doc state that both OCI_ATTR_PREFETCH_ROWS OCI_ATTR_PREFETCH_MEMORY
+ sets up a cleint side cache but in earlier version than 1.24 we only selected
+ one record at a time from the fetch this means a round trip (at least to the local cache)
+ at each fetch.
+
+ With the new array fetch we truly have a local cache so I will use it
+ RowCacheSize to set the value of that cache or the array fetch*/
+
+
+
+ /* number of rows to cache if using oraperl will leave this in for now*/
+
+
+ if (SvOK(imp_drh->ora_cache_o)){
+ imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o);
+ }
+ else if (SvOK(imp_drh->ora_cache)){
+ imp_sth->cache_rows = SvIV(imp_drh->ora_cache);
+ }
+
+
+ prefetch_rows =imp_sth->prefetch_rows;
+ prefetch_mem =imp_sth->prefetch_memory;
+
+
+ if (!cache_rows) { /*start with this value if not set then set default cache */
+
+ cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,0);
+
+ if(!prefetch_rows && !prefetch_mem){ /*if there are not prefetch rows make sure I set it here to the default*/
+ prefetch_rows=cache_rows;
+ }
+ }
+ else if (imp_dbh->RowCacheSize < 0) {/* for compaibility with DBI doc negitive value here means use the value as memory*/
+ prefetch_mem =-imp_dbh->RowCacheSize; /* cache_mem always +ve here */
+ prefetch_rows =0;
+ cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,prefetch_mem);
+ /*The above fucntion will set the cache_rows using memory as the limit*/
+ }
+ else {
+
+ if (!prefetch_mem){
+ prefetch_rows = cache_rows; /*use the RowCacheSize*/
+ }
+ }
+
+ if (cache_rows <= prefetch_rows){
+ cache_rows=prefetch_rows;
+ /* is prefetch_rows are greater than the RowCahceSize then use prefetch_rows*/
+ }
+
+ OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT,
+ &prefetch_mem, sizeof(prefetch_mem), OCI_ATTR_PREFETCH_MEMORY,
+ imp_sth->errhp, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status,
+ "OCIAttrSet OCI_ATTR_PREFETCH_MEMORY");
+ ++num_errors;
+ }
+
+ OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT,
+ &prefetch_rows, sizeof(prefetch_rows), OCI_ATTR_PREFETCH_ROWS,
+ imp_sth->errhp, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_PREFETCH_ROWS");
+ ++num_errors;
+ }
+
+
+ imp_sth->rs_array_size=cache_rows;
+
+ if (max_cache_rows){/* limited to 1 by a cursor or something else*/
+ imp_sth->rs_array_size=1;
+ }
+
+
+ if (imp_sth->row_cache_off){/*set the size of the Rows in Cache value*/
+ imp_dbh->RowsInCache =1;
+ imp_sth->RowsInCache =1;
+ }
+ else {
+ imp_dbh->RowsInCache=imp_sth->rs_array_size;
+ imp_sth->RowsInCache=imp_sth->rs_array_size;
+ }
+
+
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn) /*will also display if oci_warn is on*/
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " cache settings DB Handle RowCacheSize=%d,Statement Handle "
+ "RowCacheSize=%d, OCI_ATTR_PREFETCH_ROWS=%lu, "
+ "OCI_ATTR_PREFETCH_MEMORY=%lu, Rows per Fetch=%d, Multiple Row Fetch=%s\n",
+ imp_dbh->RowCacheSize, imp_sth->RowCacheSize,
+ (unsigned long) (prefetch_rows), (unsigned long) (prefetch_mem),
+ cache_rows,(imp_sth->row_cache_off)?"Off":"On");
+
+ return num_errors;
+}
+
+
+
+/*recurses down the field's TDOs and saves the little bits it need for later use on a fetch fbh->obj */
+int
+describe_obj(SV *sth,imp_sth_t *imp_sth,OCIParam *parm,fbh_obj_t *obj,int level )
+{
+ dTHX;
+ sword status;
+ OCIRef *type_ref;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "At level=%d in description an embedded object \n",level);
+ }
+ /*Describe the field (OCIParm) we know it is a object or a collection */
+
+ /* Get the Actual TDO */
+ OCIAttrGet_parmdp(imp_sth,parm, &type_ref, 0, OCI_ATTR_REF_TDO, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ OCITypeByRef_log_stat(imp_sth,
+ imp_sth->envhp,
+ imp_sth->errhp,
+ type_ref,
+ &obj->tdo,
+ status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCITypeByRef");
+ return 0;
+ }
+
+ return describe_obj_by_tdo(sth, imp_sth, obj, level);
+ }
+
+int
+describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) {
+ dTHX;
+ sword status;
+ text *type_name, *schema_name;
+ ub4 type_namel, schema_namel;
+
+
+ OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp,imp_sth->errhp,obj->tdo,(ub4)0,OCI_OTYPE_PTR,(ub1)1,OCI_PTYPE_TYPE,imp_sth->dschp,status);
+ /*we have the Actual TDO so lets see what it is made up of by a describe*/
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIDescribeAny");
+ return 0;
+ }
+
+ OCIAttrGet_parmap(imp_sth, imp_sth->dschp,OCI_HTYPE_DESCRIBE, &obj->parmdp, 0, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ /*and we store it in the object's paramdp for now*/
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, &schema_name, &schema_namel, OCI_ATTR_SCHEMA_NAME, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, &type_name, &type_namel, OCI_ATTR_NAME, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ /* make full type_name: schema_name + "." + type_name */
+ obj->full_type_name = newSVpv((char*)schema_name, schema_namel);
+ sv_catpvn(obj->full_type_name, ".", 1);
+ sv_catpvn(obj->full_type_name, (char*)type_name, type_namel);
+ obj->type_name = (text*)SvPV(obj->full_type_name,PL_na);
+
+ /*we need to know its type code*/
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->typecode, 0, OCI_ATTR_TYPECODE, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Getting the properties of object named =%s at level %d typecode=%d\n",
+ obj->type_name,level,obj->typecode);
+ }
+
+ if (obj->typecode == OCI_TYPECODE_OBJECT || obj->typecode == OCI_TYPECODE_OPAQUE){
+ OCIParam *list_attr= (OCIParam *) 0;
+ ub2 pos;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Object named =%s at level %d is an Object\n",
+ obj->type_name,level);
+ }
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->obj_ref, 0, OCI_ATTR_REF_TDO, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+ /*we will need a reff to the TDO for the pin operation*/
+
+ OCIObjectPin_log_stat(imp_sth, imp_sth->envhp,imp_sth->errhp, obj->obj_ref,(dvoid **)&obj->obj_type,status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIObjectPin");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->is_final_type,(ub4 *) 0, OCI_ATTR_IS_FINAL_TYPE, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->field_count,(ub4 *) 0, OCI_ATTR_NUM_TYPE_ATTRS, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ /*now get the differnt fields of this object add one field object for property*/
+ Newz(1, obj->fields, (unsigned) obj->field_count, fbh_obj_t);
+
+ /*a field is just another instance of an obj not a new struct*/
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&list_attr,(ub4 *) 0, OCI_ATTR_LIST_TYPE_ATTRS, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+
+ for (pos = 1; pos <= obj->field_count; pos++){
+ OCIParam *parmdf= (OCIParam *) 0;
+ fbh_obj_t *fld = &obj->fields[pos-1]; /*get the field holder*/
+
+ OCIParamGet_log_stat(imp_sth, (dvoid *) list_attr,(ub4) OCI_DTYPE_PARAM, imp_sth->errhp,(dvoid *)&parmdf, (ub4) pos ,status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIParamGet");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, (dvoid*)parmdf, (dvoid *)&fld->type_name,(ub4 *) &fld->type_namel, OCI_ATTR_NAME, status);
+
+ /* get the name of the attribute */
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, (dvoid*)parmdf, (void *)&fld->typecode,(ub4 *) 0, OCI_ATTR_TYPECODE, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Getting property #%d, named=%s and its typecode is %d \n",
+ pos, fld->type_name, fld->typecode);
+ }
+
+ if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){
+ /*this is some sort of object or collection so lets drill down some more*/
+ Newz(1, fld->fields, 1, fbh_obj_t);
+ fld->field_count=1;/*not really needed but used internally*/
+ status=describe_obj(sth,imp_sth,parmdf,fld->fields,level+1);
+ }
+ }
+ } else {
+ /*well this is an embedded table or varray of some form so find out what is in it*/
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Object named =%s at level %d is an Varray or Table\n",
+ obj->type_name,level);
+ }
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->col_typecode, 0, OCI_ATTR_COLLECTION_TYPECODE, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+ /* first get what sort of collection it is by coll typecode*/
+ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->parmap, 0, OCI_ATTR_COLLECTION_ELEMENT, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, obj->parmap, (dvoid *)&obj->element_typecode, 0, OCI_ATTR_TYPECODE, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
+ return 0;
+ }
+
+ if (obj->element_typecode == OCI_TYPECODE_OBJECT || obj->element_typecode == OCI_TYPECODE_VARRAY || obj->element_typecode == OCI_TYPECODE_TABLE || obj->element_typecode == OCI_TYPECODE_NAMEDCOLLECTION){
+ /*this is some sort of object or collection so lets drill down some more*/
+ fbh_obj_t *fld;
+ Newz(1, obj->fields, 1, fbh_obj_t);
+ fld = &obj->fields[0]; /*get the field holder*/
+ obj->field_count=1; /*not really needed but used internally*/
+ status=describe_obj(sth,imp_sth,obj->parmap,fld,level+1);
+ }
+
+ }
+ return 1;
+
+}
+
+
+int
+dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level){
+ dTHX;
+ int i;
+/*dumps the contents of the current fbh->obj*/
+
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " level=%d type_name = %s\n",level,obj->type_name);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " type_namel = %u\n",obj->type_namel);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " parmdp = %p\n",obj->parmdp);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " parmap = %p\n",obj->parmap);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " tdo = %p\n",obj->tdo);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " typecode = %s\n",oci_typecode_name(obj->typecode));
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " col_typecode = %d\n",obj->col_typecode);
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " element_typecode = %s\n",oci_typecode_name(obj->element_typecode));
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth), " obj_ref = %p\n",obj->obj_ref);
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_value = %p\n",obj->obj_value);
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_type = %p\n",obj->obj_type);
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " is_final_type = %u\n",obj->is_final_type);
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " field_count = %d\n",obj->field_count);
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " fields = %p\n",obj->fields);
+
+ for (i = 0; i < obj->field_count;i++){
+ fbh_obj_t *fld = &obj->fields[i];
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " \n--->sub objects\n ");
+ dump_struct(imp_sth,fld,level+1);
+ }
+
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), " \n--->done %s\n ",obj->type_name);
+
+ return 1;
+}
+
+
+
+
+
+int
+dbd_describe(SV *h, imp_sth_t *imp_sth)
+{
+ dTHX;
+ D_imp_dbh_from_sth;
+ D_imp_drh_from_dbh;
+ UV long_readlen;
+ ub4 num_fields;
+ int num_errors = 0;
+ int has_longs = 0;
+ int est_width = 0; /* estimated avg row width (for cache) */
+ int nested_cursors = 0;
+ ub4 i = 0;
+ sword status;
+
+
+ if (imp_sth->done_desc)
+ return 1; /* success, already done it */
+
+ imp_sth->done_desc = 1;
+
+ /* ora_trunc is checked at fetch time */
+ /* long_readlen: length for long/longraw (if >0), else 80 (ora app dflt) */
+ /* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */
+ long_readlen = (SvOK(imp_drh -> ora_long) && SvUV(imp_drh->ora_long)>0)
+ ? SvUV(imp_drh->ora_long) : DBIc_LongReadLen(imp_sth);
+
+ /* set long_readlen for SELECT or PL/SQL with output placeholders */
+ imp_sth->long_readlen = long_readlen;
+
+
+ if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_fields test below */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_describe skipped for %s\n",
+ oci_stmt_type_name(imp_sth->stmt_type));
+ /* imp_sth memory was cleared when created so no setup required here */
+ return 1;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_describe %s (%s, lb %lu)...\n",
+ oci_stmt_type_name(imp_sth->stmt_type),
+ DBIc_ACTIVE(imp_sth) ? "implicit" : "EXPLICIT", (unsigned long)long_readlen);
+
+ /* We know it's a select and we've not got the description yet, so if the */
+ /* sth is not 'active' (executing) then we need an explicit describe. */
+ if ( !DBIc_ACTIVE(imp_sth) ) {
+
+ OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ 0, 0, 0, 0, OCI_DESCRIBE_ONLY, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status,
+ ora_sql_error(imp_sth, "OCIStmtExecute/Describe"));
+ if (status != OCI_SUCCESS_WITH_INFO)
+ return 0;
+ }
+ }
+ OCIAttrGet_stmhp_stat(imp_sth, &num_fields, 0, OCI_ATTR_PARAM_COUNT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_PARAM_COUNT");
+ return 0;
+ }
+ if (num_fields == 0) {
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_describe skipped for %s (no fields returned)\n",
+ oci_stmt_type_name(imp_sth->stmt_type));
+ /* imp_sth memory was cleared when created so no setup required here */
+ return 1;
+ }
+
+ DBIc_NUM_FIELDS(imp_sth) = num_fields;
+ Newz(42, imp_sth->fbh, num_fields, imp_fbh_t);
+
+ /* Get number of fields and space needed for field names */
+ /* loop though the fields and get all the fileds and thier types to get back*/
+
+ for(i = 1; i <= num_fields; ++i) { /*start define of filed struct[i] fbh */
+ char *p;
+ ub4 atrlen;
+ int avg_width = 0;
+ imp_fbh_t *fbh = &imp_sth->fbh[i-1];
+ fbh->imp_sth = imp_sth;
+ fbh->field_num = i;
+ fbh->define_mode = OCI_DEFAULT;
+
+ OCIParamGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, imp_sth->errhp,
+ (dvoid**)&fbh->parmdp, (ub4)i, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIParamGet");
+ return 0;
+ }
+
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbtype, 0, OCI_ATTR_DATA_TYPE, status);
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbsize, 0, OCI_ATTR_DATA_SIZE, status);
+ /*may be a bug in 11 where the OCI_ATTR_DATA_SIZE my return 0 which should never happen*/
+ /*to fix or kludge for this I added a little code for ORA_VARCHAR2 below */
+
+#ifdef OCI_ATTR_CHAR_USED
+ /* 0 means byte-length semantics, 1 means character-length semantics */
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->len_char_used, 0, OCI_ATTR_CHAR_USED, status);
+ /* OCI_ATTR_CHAR_SIZE: like OCI_ATTR_DATA_SIZE but measured in chars */
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->len_char_size, 0, OCI_ATTR_CHAR_SIZE, status);
+#endif
+ fbh->csid = 0; fbh->csform = 0; /* just to be sure */
+#ifdef OCI_ATTR_CHARSET_ID
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->csid, 0, OCI_ATTR_CHARSET_ID, status);
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->csform, 0, OCI_ATTR_CHARSET_FORM, status);
+#endif
+ /* OCI_ATTR_PRECISION returns 0 for most types including some numbers */
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->prec, 0, OCI_ATTR_PRECISION, status);
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->scale, 0, OCI_ATTR_SCALE, status);
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->nullok, 0, OCI_ATTR_IS_NULL, status);
+ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->name, &atrlen, OCI_ATTR_NAME,status);
+ if (atrlen == 0) { /* long names can cause oracle to return 0 for atrlen */
+ char buf[99];
+ sprintf(buf,"field_%d_name_too_long", i);
+ fbh->name = &buf[0];
+ atrlen = strlen(fbh->name);
+ }
+ fbh->name_sv = newSVpv(fbh->name,atrlen);
+ fbh->name = SvPVX(fbh->name_sv);
+ fbh->ftype = 5; /* default: return as null terminated string */
+
+ /* TO_DO there is something wrong with the tracing below as sql_typecode_name
+ returns NVARCHAR2 for type 2 and ORA_NUMBER is 2 */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Describe col #%d type=%d(%s)\n",
+ i,fbh->dbtype,sql_typecode_name(fbh->dbtype));
+
+ switch (fbh->dbtype) {
+ /* the simple types */
+ case ORA_VARCHAR2: /* VARCHAR2 */
+
+ if (fbh->dbsize == 0){
+ fbh->dbsize=4000;
+ }
+ avg_width = fbh->dbsize / 2;
+ /* FALLTHRU */
+ case ORA_CHAR: /* CHAR */
+ if ( CSFORM_IMPLIES_UTF8(fbh->csform) && !CS_IS_UTF8(fbh->csid) )
+ fbh->disize = fbh->dbsize * 4;
+ else
+ fbh->disize = fbh->dbsize;
+
+ fbh->prec = fbh->disize;
+ break;
+ case ORA_RAW: /* RAW */
+ fbh->disize = fbh->dbsize * 2;
+ fbh->prec = fbh->disize;
+ break;
+ case ORA_NUMBER: /* NUMBER */
+ case 21: /* BINARY FLOAT os-endian */
+ case 22: /* BINARY DOUBLE os-endian */
+ case 100: /* BINARY FLOAT oracle-endian */
+ case 101: /* BINARY DOUBLE oracle-endian */
+ fbh->disize = 130+38+3; /* worst case */
+ avg_width = 4; /* NUMBER approx +/- 1_000_000 */
+ break;
+
+ case ORA_DATE: /* DATE */
+ /* actually dependent on NLS default date format*/
+ fbh->disize = 75; /* a generous default */
+ fbh->prec = fbh->disize;
+ avg_width = 8; /* size in SQL*Net packet */
+ break;
+
+ case ORA_LONG: /* LONG */
+ imp_sth->row_cache_off = 1;
+ has_longs++;
+ if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/
+
+ fbh->clbk_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+
+ fbh->ftype = SQLT_CHR;
+ fbh->fetch_func = fetch_clbk_lob;
+
+ }
+ else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/
+
+ fbh->piece_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+ fbh->ftype = SQLT_CHR;
+ fbh->fetch_func = fetch_get_piece;
+ }
+ else {
+
+ if ( CSFORM_IMPLIES_UTF8(fbh->csform) && !CS_IS_UTF8(fbh->csid) )
+ fbh->disize = long_readlen * 4;
+ else
+ fbh->disize = long_readlen;
+
+ /* not governed by else: */
+ fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize;
+ fbh->ftype = 94; /* VAR form */
+ fbh->fetch_func = fetch_func_varfield;
+
+ }
+ break;
+ case ORA_LONGRAW: /* LONG RAW */
+ has_longs++;
+ if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/
+
+ fbh->clbk_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+
+ fbh->ftype = SQLT_BIN;
+ fbh->fetch_func = fetch_clbk_lob;
+
+ }
+ else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/
+
+ fbh->piece_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+ fbh->ftype = SQLT_BIN;
+ fbh->fetch_func = fetch_get_piece;
+ }
+ else {
+ fbh->disize = long_readlen * 2;
+ fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize;
+ fbh->ftype = 95; /* VAR form */
+ fbh->fetch_func = fetch_func_varfield;
+ }
+ break;
+
+ case ORA_ROWID: /* ROWID */
+ case 104: /* ROWID Desc */
+ fbh->disize = 20;
+ fbh->prec = fbh->disize;
+ break;
+ case 108: /* some sort of embedded object */
+ imp_sth->row_cache_off = 1;/* cant fetch more thatn one at a time */
+ fbh->ftype = fbh->dbtype; /*varray or alike */
+ fbh->fetch_func = fetch_func_oci_object; /* need a new fetch function for it */
+ fbh->fetch_cleanup = fetch_cleanup_oci_object; /* clean up any AV from the fetch*/
+ fbh->desc_t = SQLT_NTY;
+ if (!imp_sth->dschp){
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(h,imp_sth->errhp, status, "OCIHandleAlloc");
+ ++num_errors;
+ }
+ }
+ break;
+ case ORA_CLOB: /* CLOB & NCLOB */
+ case ORA_BLOB: /* BLOB */
+ case ORA_BFILE: /* BFILE */
+ has_longs++;
+ fbh->ftype = fbh->dbtype;
+ imp_sth->ret_lobs = 1;
+ imp_sth->row_cache_off = 1; /* Cannot use mulit fetch for a lob*/
+ /* Unless they are just getting the locator */
+
+ if (imp_sth->pers_lob){ /*get as one peice fasted but limited to 64k big you can get.*/
+
+ fbh->pers_lob = 1;
+
+ if (long_readlen){
+ fbh->disize =long_readlen;/*user set max value for the fetch*/
+ }
+ else {
+ fbh->disize = fbh->dbsize*10; /*default size*/
+ }
+
+
+ if (fbh->dbtype == ORA_CLOB){
+ fbh->ftype = SQLT_CHR;/*SQLT_LNG*/
+ }
+ else {
+ fbh->ftype = SQLT_LVB; /*Binary form seems this is the only value where we can get the length correctly*/
+ }
+ }
+ else if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/
+ fbh->clbk_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+ if (fbh->dbtype == ORA_CLOB){
+ fbh->ftype = SQLT_CHR;
+ } else {
+ fbh->ftype = SQLT_BIN; /*other Binary*/
+ }
+ fbh->fetch_func = fetch_clbk_lob;
+
+ }
+ else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/
+ fbh->piece_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
+ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+ if (!imp_sth->piece_size){ /*if not set use max value*/
+ imp_sth->piece_size=imp_sth->long_readlen;
+ }
+ if (fbh->dbtype == ORA_CLOB){
+ fbh->ftype = SQLT_CHR;
+ }
+ else {
+ fbh->ftype = SQLT_BIN; /*other Binary */
+ }
+ fbh->fetch_func = fetch_get_piece;
+
+ }
+ else { /*auto lob fetch with locator by far the fastest*/
+ fbh->disize = sizeof(OCILobLocator*);/* Size of the lob locator ar we do not really get the lob! */
+ if (imp_sth->auto_lob) {
+ fbh->fetch_func = fetch_func_autolob;
+ }
+ else {
+ fbh->fetch_func = fetch_func_getrefpv;
+ }
+
+ fbh->bless = "OCILobLocatorPtr";
+ fbh->desc_t = OCI_DTYPE_LOB;
+ OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
+
+
+ }
+
+ break;
+
+#ifdef OCI_DTYPE_REF
+ case 111: /* REF */
+ fbh_setup_getrefpv(imp_sth, fbh, OCI_DTYPE_REF, "OCIRefPtr");
+ break;
+#endif
+
+ case ORA_RSET: /* RSET */
+ fbh->ftype = fbh->dbtype;
+ fbh->disize = sizeof(OCIStmt *);
+ fbh->fetch_func = fetch_func_rset;
+ fbh->fetch_cleanup = fetch_cleanup_rset;
+ nested_cursors++;
+ break;
+
+ case 182: /* INTERVAL YEAR TO MONTH */
+ case 183: /* INTERVAL DAY TO SECOND */
+ case 185: /* TIME (ocidfn.h) */
+ case 186: /* TIME WITH TIME ZONE (ocidfn.h) */
+ case 187: /* TIMESTAMP */
+ case 188: /* TIMESTAMP WITH TIME ZONE */
+ case 189: /* INTERVAL YEAR TO MONTH (ocidfn.h) */
+ case 190: /* INTERVAL DAY TO SECOND */
+ case 232: /* TIMESTAMP WITH LOCAL TIME ZONE */
+ /* actually dependent on NLS default date format*/
+ fbh->disize = 75; /* XXX */
+ break;
+
+ default:
+ /* XXX unhandled type may lead to errors or worse */
+ fbh->ftype = fbh->dbtype;
+ fbh->disize = fbh->dbsize;
+ p = "Field %d has an Oracle type (%d) which is not explicitly supported%s";
+ if (DBIc_DBISTATE(imp_sth)->debug >= 1 || dbd_verbose >= 3 )
+ PerlIO_printf(DBIc_LOGPIO(imp_sth), p, i, fbh->dbtype, "\n");
+ if (PL_dowarn)
+ warn(p, i, fbh->dbtype, "");
+ break;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Described col %2d: dbtype %d(%s), scale %d, prec %d, nullok %d, "
+ "name %s\n : dbsize %d, char_used %d, char_size %d, "
+ "csid %d, csform %d(%s), disize %d\n",
+ i, fbh->dbtype, sql_typecode_name(fbh->dbtype), fbh->scale,
+ fbh->prec, fbh->nullok, fbh->name, fbh->dbsize,
+ fbh->len_char_used, fbh->len_char_size,
+ fbh->csid,fbh->csform,oci_csform_name(fbh->csform), fbh->disize);
+
+ if (fbh->ftype == 5) /* XXX need to handle wide chars somehow */
+ fbh->disize += 1; /* allow for null terminator */
+
+ /* dbsize can be zero for 'select NULL ...' */
+
+ imp_sth->t_dbsize += fbh->dbsize;
+
+ if (!avg_width)
+ avg_width = fbh->dbsize;
+
+ est_width += avg_width;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 )
+ dbd_fbh_dump(imp_sth, fbh, (int)i, 0);
+
+ }/* end define of filed struct[i] fbh*/
+
+ imp_sth->est_width = est_width;
+ sth_set_row_cache(h, imp_sth,
+ (imp_dbh->max_nested_cursors) ? 0 :nested_cursors ,
+ (int)num_fields, has_longs );
+ /* Initialise cache counters */
+ imp_sth->in_cache = 0;
+ imp_sth->eod_errno = 0;
+ /*rs_array_init(imp_sth);*/
-int
-dbd_describe(SV *h, imp_sth_t *imp_sth)
-{
- D_imp_dbh_from_sth;
- D_imp_drh_from_dbh ;
- I32 long_readlen;
- ub4 num_fields;
- int has_longs = 0;
- int est_width = 0; /* estimated avg row width (for cache) */
- int i = 0;
- sword status;
-
- if (imp_sth->done_desc)
- return 1; /* success, already done it */
- imp_sth->done_desc = 1;
-
- /* ora_trunc is checked at fetch time */
- /* long_readlen: length for long/longraw (if >0), else 80 (ora app dflt) */
- /* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */
- long_readlen = (SvOK(imp_drh -> ora_long) && SvIV(imp_drh -> ora_long)>0)
- ? SvIV(imp_drh -> ora_long) : DBIc_LongReadLen(imp_sth);
- if (long_readlen < 0) /* trap any sillyness */
- long_readlen = 80; /* typical oracle app default */
-
- if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_fields test below */
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s\n",
- oci_stmt_type_name(imp_sth->stmt_type));
- /* imp_sth memory was cleared when created so no setup required here */
- return 1;
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_describe %s (%s, lb %ld)...\n",
- oci_stmt_type_name(imp_sth->stmt_type),
- DBIc_ACTIVE(imp_sth) ? "implicit" : "EXPLICIT", (long)long_readlen);
- /* We know it's a select and we've not got the description yet, so if the */
- /* sth is not 'active' (executing) then we need an explicit describe. */
- if ( !DBIc_ACTIVE(imp_sth) ) {
- OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
- 0, 0, 0, 0, OCI_DESCRIBE_ONLY, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status,
- ora_sql_error(imp_sth, "OCIStmtExecute/Describe"));
- return 0;
- }
- }
+ /* now set up the oci call with define by pos*/
+ for(i=1; i <= num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i-1];
+ int ftype = fbh->ftype;
+ /* add space for STRING null term, or VAR len prefix */
+ sb4 define_len = (ftype==94||ftype==95) ? fbh->disize+4 : fbh->disize;
+ fb_ary_t *fb_ary;
- OCIAttrGet_stmhp_stat(imp_sth, &num_fields, 0, OCI_ATTR_PARAM_COUNT, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_PARAM_COUNT");
- return 0;
- }
- if (num_fields == 0) {
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s (no fields returned)\n",
- oci_stmt_type_name(imp_sth->stmt_type));
- /* imp_sth memory was cleared when created so no setup required here */
- return 1;
- }
+ if (fbh->clbk_lob || fbh->piece_lob ){/*init the cb_abuf with this call*/
+ fbh->fb_ary = fb_ary_cb_alloc(imp_sth->piece_size,define_len, imp_sth->rs_array_size);
- DBIc_NUM_FIELDS(imp_sth) = num_fields;
- Newz(42, imp_sth->fbh, num_fields, imp_fbh_t);
+ } else {
+ fbh->fb_ary = fb_ary_alloc(define_len, imp_sth->rs_array_size);
+ }
+ fb_ary = fbh->fb_ary;
- /* Get number of fields and space needed for field names */
- for(i = 1; i <= num_fields; ++i) {
- char *p;
- ub4 atrlen;
- int avg_width = 0;
- imp_fbh_t *fbh = &imp_sth->fbh[i-1];
- fbh->imp_sth = imp_sth;
- fbh->field_num = i;
-
- OCIParamGet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, imp_sth->errhp,
- (dvoid*)&fbh->parmdp, (ub4)i, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIParamGet");
- return 0;
- }
-
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbtype, 0, OCI_ATTR_DATA_TYPE, status);
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbsize, 0, OCI_ATTR_DATA_SIZE, status);
- /* OCI_ATTR_PRECISION returns 0 for most types including some numbers */
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->prec, 0, OCI_ATTR_PRECISION, status);
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->scale, 0, OCI_ATTR_SCALE, status);
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->nullok, 0, OCI_ATTR_IS_NULL, status);
- OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->name, &atrlen, OCI_ATTR_NAME,status);
- if (atrlen == 0) { /* long names can cause oracle to return 0 for atrlen */
- char buf[99];
- sprintf(buf,"field_%d_name_too_long", i);
- fbh->name = &buf[0];
- atrlen = strlen(fbh->name);
- }
- fbh->name_sv = newSVpv(fbh->name,atrlen);
- fbh->name = SvPVX(fbh->name_sv);
-
- fbh->ftype = 5; /* default: return as null terminated string */
- switch (fbh->dbtype) {
- /* the simple types */
- case 1: /* VARCHAR2 */
- avg_width = fbh->dbsize / 2;
- /* FALLTHRU */
- case 96: /* CHAR */
- fbh->disize = fbh->dbsize;
- fbh->prec = fbh->disize;
- break;
- case 23: /* RAW */
- fbh->disize = fbh->dbsize * 2;
- fbh->prec = fbh->disize;
- break;
+ if (fbh->ftype == SQLT_BIN) {
+ define_len++;
+ /*add one extra byte incase the size of the lob is equal to the define_len*/
+ }
- case 2: /* NUMBER */
- fbh->disize = 130+3; /* worst case! 1**-130 */
- avg_width = 4; /* > approx +/- 1_000_000 ? */
- break;
+ if (fbh->ftype == ORA_RSET) { /* RSET */
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp,
+ (dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
+ OCI_HTYPE_STMT, status);
+ }
- case 12: /* DATE */
- /* actually dependent on NLS default date format*/
- fbh->disize = 75; /* a generous default */
- fbh->prec = fbh->disize;
- avg_width = 8; /* size in SQL*Net packet */
- break;
+ OCIDefineByPos_log_stat(imp_sth, imp_sth->stmhp,
+ &fbh->defnp,
+ imp_sth->errhp,
+ (ub4) i,
+ (fbh->desc_h) ? (dvoid*)&fbh->desc_h : fbh->clbk_lob ? (dvoid *) 0: fbh->piece_lob ? (dvoid *) 0:(dvoid*)fb_ary->abuf,
+ (fbh->desc_h) ? 0 : define_len,
+ (ub2)fbh->ftype,
+ fb_ary->aindp,
+ (ftype==94||ftype==95) ? NULL : fb_ary->arlen,
+ fb_ary->arcode,
+ fbh->define_mode,
+ status);
+
+
+ if (fbh->clbk_lob){
+ /* use a dynamic callback for persistent binary and char lobs*/
+ OCIDefineDynamic_log_stat(imp_sth, fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status);
+ }
- case 8: /* LONG */
-#ifdef UTF8_SUPPORT
- if (cs_is_utf8)
- fbh->disize = long_readlen * 4;
- else
-#endif
- fbh->disize = long_readlen;
- fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize;
- fbh->ftype = 94; /* VAR form */
- fbh->fetch_func = fetch_func_varfield;
- ++has_longs;
- break;
- case 24: /* LONG RAW */
- fbh->disize = long_readlen * 2;
- fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize;
- fbh->ftype = 95; /* VAR form */
- fbh->fetch_func = fetch_func_varfield;
- ++has_longs;
- break;
+ if (fbh->ftype == 108) { /* Embedded object bind it differently*/
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "Field #%d is a object or colection of some sort. "
+ "Using OCIDefineObject and or OCIObjectPin \n",i);
+ }
+ Newz(1, fbh->obj, 1, fbh_obj_t);
+ fbh->obj->typecode=fbh->dbtype;
+ if (!describe_obj(h,imp_sth,fbh->parmdp,fbh->obj,0)){
+ ++num_errors;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
+ dump_struct(imp_sth,fbh->obj,0);
+ }
+ OCIDefineObject_log_stat(imp_sth,fbh->defnp,imp_sth->errhp,fbh->obj->tdo,(dvoid**)&fbh->obj->obj_value,(dvoid**)&fbh->obj->obj_ind,status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h,imp_sth->errhp, status, "OCIDefineObject");
+ ++num_errors;
+ }
- case 11: /* ROWID */
- case 104: /* ROWID Desc */
- fbh->disize = 20;
- fbh->prec = fbh->disize;
- break;
+ }
- case 112: /* CLOB */
- case 113: /* BLOB */
- case 114: /* BFILE */
- fbh->ftype = fbh->dbtype;
- fbh->disize = fbh->dbsize;
- fbh->fetch_func = (imp_sth->auto_lob)
- ? fetch_func_autolob : fetch_func_getrefpv;
- fbh->bless = "OCILobLocatorPtr";
- fbh->desc_t = OCI_DTYPE_LOB;
- OCIDescriptorAlloc_ok(imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
- break;
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIDefineByPos");
+ ++num_errors;
+ }
-#ifdef OCI_DTYPE_REF
- case 111: /* REF */
- fbh_setup_getrefpv(fbh, OCI_DTYPE_REF, "OCIRefPtr");
- break;
-#endif
- case 188: /* TIMESTAMP WITH TIME ZONE */
- /* actually dependent on NLS default date format*/
- fbh->disize = 75; /* a generous default */
- break;
+#ifdef OCI_ATTR_CHARSET_FORM
+ if ( (fbh->dbtype == 1) && fbh->csform ) {
+ /* csform may be 0 when talking to Oracle 8.0 database*/
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " calling OCIAttrSet OCI_ATTR_CHARSET_FORM with csform=%d (%s)\n",
+ fbh->csform,oci_csform_name(fbh->csform) );
+ OCIAttrSet_log_stat(imp_sth, fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform,
+ (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status );
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_CHARSET_FORM");
+ ++num_errors;
+ }
+ }
+#endif /* OCI_ATTR_CHARSET_FORM */
- default:
- /* XXX unhandled type may lead to errors or worse */
- fbh->ftype = fbh->dbtype;
- fbh->disize = fbh->dbsize;
- p = "Field %d has an Oracle type (%d) which is not explicitly supported%s";
- if (DBIS->debug >= 1)
- PerlIO_printf(DBILOGFP, p, i, fbh->dbtype, "\n");
- if (dowarn)
- warn(p, i, fbh->dbtype, "");
- break;
}
- if (fbh->ftype == 5) /* XXX need to handle wide chars somehow */
- fbh->disize += 1; /* allow for null terminator */
- /* dbsize can be zero for 'select NULL ...' */
- imp_sth->t_dbsize += fbh->dbsize;
- if (!avg_width)
- avg_width = fbh->dbsize;
- est_width += avg_width;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_describe'd %d columns (row bytes: %d max, %d est avg, cache: %d)\n",
+ (int)num_fields, imp_sth->t_dbsize, imp_sth->est_width,
+ imp_sth->prefetch_rows);
- if (DBIS->debug >= 2)
- dbd_fbh_dump(fbh, i, 0);
- }
- imp_sth->est_width = est_width;
-
- /* --- Setup the row cache for this query --- */
-
- /* number of rows to cache */
- if (SvOK(imp_drh->ora_cache_o)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o);
- else if (SvOK(imp_drh->ora_cache)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache);
- else imp_sth->cache_rows = imp_dbh->RowCacheSize;
- if (imp_sth->cache_rows >= 0) { /* set cache size by row count */
- ub4 cache_rows = calc_cache_rows((int)num_fields,
- est_width, imp_sth->cache_rows, has_longs);
- imp_sth->cache_rows = cache_rows; /* record updated value */
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_rows, sizeof(cache_rows), OCI_ATTR_PREFETCH_ROWS,
- imp_sth->errhp, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_PREFETCH_ROWS");
- return 0;
- }
- }
- else { /* set cache size by memory */
- ub4 cache_mem = -imp_sth->cache_rows;
- ub4 cache_rows = 100000; /* set high so memory is the limit */
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_rows, sizeof(cache_rows), OCI_ATTR_PREFETCH_ROWS,
- imp_sth->errhp, status);
- if (! status) {
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_mem, sizeof(cache_mem), OCI_ATTR_PREFETCH_MEMORY,
- imp_sth->errhp, status);
- }
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status,
- "OCIAttrSet OCI_ATTR_PREFETCH_ROWS/OCI_ATTR_PREFETCH_MEMORY");
- return 0;
+ return (num_errors>0) ? 0 : 1;
+}
+
+
+AV *
+dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){
+ dTHX;
+ D_imp_xxh(sth);
+ sword status;
+ D_imp_dbh_from_sth;
+ int num_fields = DBIc_NUM_FIELDS(imp_sth);
+ int ChopBlanks;
+ int err;
+ int i;
+ AV *av;
+
+
+ /* Check that execute() was executed sucessfully. This also implies */
+ /* that dbd_describe() executed sucessfuly so the memory buffers */
+ /* are allocated and bound. */
+ if ( !DBIc_ACTIVE(imp_sth) ) {
+ oci_error(sth, NULL, OCI_ERROR, imp_sth->nested_cursor ?
+ "nested cursor is defunct (parent row is no longer current)" :
+ "no statement executing (perhaps you need to call execute first)");
+ return Nullav;
}
- }
- imp_sth->long_readlen = long_readlen;
- /* Initialise cache counters */
- imp_sth->in_cache = 0;
- imp_sth->eod_errno = 0;
-
- for(i=1; i <= num_fields; ++i) {
- imp_fbh_t *fbh = &imp_sth->fbh[i-1];
- int ftype = fbh->ftype;
- /* add space for STRING null term, or VAR len prefix */
- sb4 define_len = (ftype==94||ftype==95) ? fbh->disize+4 : fbh->disize;
- fb_ary_t *fb_ary;
-
- fbh->fb_ary = fb_ary_alloc(define_len, 1);
- fb_ary = fbh->fb_ary;
-
- OCIDefineByPos_log_stat(imp_sth->stmhp, &fbh->defnp,
- imp_sth->errhp, (ub4) i,
- (fbh->desc_h) ? (dvoid*)&fbh->desc_h : (dvoid*)fb_ary->abuf,
- (fbh->desc_h) ? -1 : define_len,
- (ub2)fbh->ftype,
- fb_ary->aindp,
- (ftype==94||ftype==95) ? NULL : fb_ary->arlen,
- fb_ary->arcode, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIDefineByPos");
- return 0;
+ for(i=0; i < num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ if (fbh->fetch_cleanup)
+ fbh->fetch_cleanup(sth, fbh);
}
- if (fbh->ftype == 108) {
- oci_error(h, NULL, OCI_ERROR, "OCIDefineObject call needed but not implemented yet");
- return 0;
+ if (ora_fetchtest && DBIc_ROW_COUNT(imp_sth)>0) {
+ --ora_fetchtest; /* trick for testing performance */
+ status = OCI_SUCCESS;
}
+ else {
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth));
+ }
- }
+ if (imp_sth->fetch_orient != OCI_DEFAULT) {
+ if (imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY)
+ croak ("attempt to use a scrollable cursor without first setting ora_exe_mode to OCI_STMT_SCROLLABLE_READONLY\n") ;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Scrolling Fetch, position before fetch=%d, "
+ "Orientation = %s , Fetchoffset =%d\n",
+ imp_sth->fetch_position, oci_fetch_options(imp_sth->fetch_orient),
+ imp_sth->fetch_offset);
+
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1, imp_sth->fetch_orient,imp_sth->fetch_offset, status);
+ /*this will work without a round trip so might as well open it up for all statments handles*/
+ /* default and OCI_FETCH_NEXT are the same so this avoids miscaluation on the next value*/
+ if (status==OCI_NO_DATA){
+ return Nullav;
+ }
+
+ OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " Scrolling Fetch, postion after fetch=%d\n",
+ imp_sth->fetch_position);
+ }
+ else {
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " dbd_describe'd %d columns (row bytes: %d max, %d est avg, cache: %d)\n",
- (int)num_fields, imp_sth->t_dbsize, imp_sth->est_width, imp_sth->cache_rows);
+ if (imp_sth->row_cache_off){ /*Do not use array fetch or local cache */
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status);
+ imp_sth->rs_fetch_count++;
+ imp_sth->rs_array_idx=0;
- return 1;
-}
+ }
+ else { /*Array Fetch the New Normal Super speedy and very nice*/
-AV *
-dbd_st_fetch(SV *sth, imp_sth_t *imp_sth)
-{
- sword status;
- int num_fields = DBIc_NUM_FIELDS(imp_sth);
- int ChopBlanks;
- int err;
- int i;
- AV *av;
-
- /* Check that execute() was executed sucessfully. This also implies */
- /* that dbd_describe() executed sucessfuly so the memory buffers */
- /* are allocated and bound. */
- if ( !DBIc_ACTIVE(imp_sth) ) {
- oci_error(sth, NULL, OCI_ERROR,
- "no statement executing (perhaps you need to call execute first)");
- return Nullav;
- }
+ imp_sth->rs_array_idx++;
+ if (imp_sth->rs_array_num_rows<=imp_sth->rs_array_idx && (imp_sth->rs_array_status==OCI_SUCCESS || imp_sth->rs_array_status==OCI_SUCCESS_WITH_INFO)) {
+/* PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_fetch fields...b\n");*/
- if (ora_fetchtest && DBIc_ROW_COUNT(imp_sth)>0) {
- --ora_fetchtest; /* trick for testing performance */
- status = OCI_SUCCESS;
- }
- else {
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth));
- OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,
- 1, (ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status);
- }
+ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp,imp_sth->errhp,imp_sth->rs_array_size,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status);
+
+ imp_sth->rs_array_status=status;
+ imp_sth->rs_fetch_count++;
+ if (oci_warn && (imp_sth->rs_array_status == OCI_SUCCESS_WITH_INFO)) {
+ oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch");
+ }
+ OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->rs_array_num_rows,0,OCI_ATTR_ROWS_FETCHED, status);
+ imp_sth->rs_array_idx=0;
+ imp_dbh->RowsInCache =imp_sth->rs_array_size;
+ imp_sth->RowsInCache =imp_sth->rs_array_size;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 || oci_warn)
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "...Fetched %d rows\n",imp_sth->rs_array_num_rows);
+
+ }
+ imp_dbh->RowsInCache--;
+ imp_sth->RowsInCache--;
- if (status != OCI_SUCCESS) {
- ora_fetchtest = 0;
- if (status == OCI_NO_DATA) {
- dTHR; /* for DBIc_ACTIVE_off */
- DBIc_ACTIVE_off(imp_sth); /* eg finish */
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_fetch no-more-data\n");
- return Nullav;
- }
- if (status != OCI_SUCCESS_WITH_INFO) {
- dTHR; /* for DBIc_ACTIVE_off */
- DBIc_ACTIVE_off(imp_sth); /* eg finish */
- oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch");
- return Nullav;
+
+
+
+ if (imp_sth->rs_array_num_rows>imp_sth->rs_array_idx) /* set status to success if rows in cache */
+ status=OCI_SUCCESS;
+ else
+ status=imp_sth->rs_array_status;
+ }
+ }
}
+
+ if (status != OCI_SUCCESS && status !=OCI_NEED_DATA) {
+ ora_fetchtest = 0;
+
+ if (status == OCI_NO_DATA) {
+ dTHR; /* for DBIc_ACTIVE_off */
+ DBIc_ACTIVE_off(imp_sth); /* eg finish */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn)
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_fetch no-more-data, fetch count=%d\n",
+ imp_sth->rs_fetch_count-1);
+ return Nullav;
+ }
+ if (status != OCI_SUCCESS_WITH_INFO) {
+ dTHR; /* for DBIc_ACTIVE_off */
+ DBIc_ACTIVE_off(imp_sth); /* eg finish */
+ oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch");
+ return Nullav;
+ }
+ if (oci_warn && (status == OCI_SUCCESS_WITH_INFO)) {
+ oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch");
+ }
+
+
/* for OCI_SUCCESS_WITH_INFO we fall through and let the */
/* per-field rcode value be dealt with as we fetch the data */
- }
+ }
- av = DBIS->get_fbav(imp_sth);
+ av = DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields %s\n",
- num_fields, oci_status_name(status));
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " dbd_st_fetched %d fields with status of %d(%s)\n",
+ num_fields,status, oci_status_name(status));
+ }
- ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks);
+ ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks);
+ err = 0;
- err = 0;
- for(i=0; i < num_fields; ++i) {
- imp_fbh_t *fbh = &imp_sth->fbh[i];
- fb_ary_t *fb_ary = fbh->fb_ary;
- int rc = fb_ary->arcode[0];
- SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */
-
- if (rc == 1406 /* field was truncated */
- && ora_dbtype_is_long(fbh->dbtype)/* field is a LONG */
- ) {
- int oraperl = DBIc_COMPAT(imp_sth);
- D_imp_dbh_from_sth ;
- D_imp_drh_from_dbh ;
-
- if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) {
- /* user says truncation is ok */
- /* Oraperl recorded the truncation in ora_errno so we */
- /* so also but only for Oraperl mode handles. */
- if (oraperl)
- sv_setiv(DBIc_ERR(imp_sth), (IV)rc);
- rc = 0; /* but don't provoke an error here */
- }
- /* else fall through and let rc trigger failure below */
- }
-
- if (rc == 0) { /* the normal case */
- if (fbh->fetch_func) {
- if (!fbh->fetch_func(sth, fbh, sv))
- ++err; /* fetch_func already called oci_error */
- }
- else {
- int datalen = fb_ary->arlen[0];
- char *p = (char*)&fb_ary->abuf[0];
- /* if ChopBlanks check for Oracle CHAR type (blank padded) */
- if (ChopBlanks && fbh->dbtype == 96) {
- while(datalen && p[datalen - 1]==' ')
- --datalen;
- }
- sv_setpvn(sv, p, (STRLEN)datalen);
-#ifdef UTF8_SUPPORT
- DBD_SET_UTF8(sv);
-#endif
- }
-
- } else if (rc == 1405) { /* field is null - return undef */
- (void)SvOK_off(sv);
-
- } else { /* See odefin rcode arg description in OCI docs */
- char buf[200];
- char *hint = "";
- /* These may get more case-by-case treatment eventually. */
- if (rc == 1406) { /* field truncated (see above) */
- if (!fbh->fetch_func) {
- /* Copy the truncated value anyway, it may be of use, */
- /* but it'll only be accessible via prior bind_column() */
- sv_setpvn(sv, (char*)&fb_ary->abuf[0],
- fb_ary->arlen[0]);
-#ifdef UTF8_SUPPORT
- DBD_SET_UTF8(sv);
-#endif
+ for(i=0; i < num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ fb_ary_t *fb_ary = fbh->fb_ary;
+ int rc = fb_ary->arcode[imp_sth->rs_array_idx];
+ ub1* row_data = &fb_ary->abuf[0]+(fb_ary->bufl*imp_sth->rs_array_idx);
+ SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */;
+
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) {
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " field #%d with rc=%d(%s)\n",i+1,rc,oci_col_return_codes(rc));
+ }
+
+ if (rc == 1406 /* field was truncated */
+ && ora_dbtype_is_long(fbh->dbtype)/* field is a LONG */
+ ){
+ int oraperl = DBIc_COMPAT(imp_sth);
+ D_imp_dbh_from_sth ;
+ D_imp_drh_from_dbh ;
+ if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) {
+ /* user says truncation is ok */
+ /* Oraperl recorded the truncation in ora_errno so we */
+ /* so also but only for Oraperl mode handles. */
+ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), (IV)rc);
+ rc = 0; /* but don't provoke an error here */
+ }
+ /* else fall through and let rc trigger failure below */
+ }
+
+ if (rc == 0 || /* the normal case*/
+ (rc == 1406 && DBIc_has(imp_sth,DBIcf_LongTruncOk))/*Field Truncaded*/) {
+
+ if (fbh->fetch_func) {
+ if (!fbh->fetch_func(sth, fbh, sv)){
+ ++err; /* fetch_func already called oci_error */
+ }
+ }
+ else {
+ int datalen = fb_ary->arlen[imp_sth->rs_array_idx];
+ char *p = (char*)row_data;
+ if (rc == 1406 ){
+ datalen= fbh->disize;
+ }
+
+
+ if (fbh->ftype == SQLT_LVB){
+ /* very special case for binary lobs that are directly fetched.
+ Seems I have to use SQLT_LVB to get the length all other will fail*/
+ datalen = *(ub4*)row_data;
+ sv_setpvn(sv, (char*)row_data+ sizeof(ub4), datalen);
+ }
+ else {
+ if (ChopBlanks && fbh->dbtype == 96) {
+ while(datalen && p[datalen - 1]==' ')
+ --datalen;
+ }
+ sv_setpvn(sv, p, (STRLEN)datalen);
+#if DBIXS_REVISION > 13590
+ /* If a bind type was specified we use DBI's sql_type_cast
+ to cast it - currently only number types are handled */
+ if ((fbh->req_type != 0) && (fbh->bind_flags != 0)) {
+ int sts;
+ char errstr[256];
+
+ sts = DBIc_DBISTATE(imp_sth)->sql_type_cast_svpv(
+ aTHX_ sv, fbh->req_type, fbh->bind_flags, NULL);
+
+ if (sts == 0) {
+ sprintf(errstr,
+ "over/under flow converting column %d to type %"IVdf"",
+ i+1, fbh->req_type);
+ oci_error(sth, imp_sth->errhp, OCI_ERROR, errstr);
+ return Nullav;
+
+ }
+ else if (sts == -2) {
+ sprintf(errstr,
+ "unsupported bind type %"IVdf" for column %d",
+ fbh->req_type, i+1);
+ /* issue warning */
+ DBIh_SET_ERR_CHAR(sth, imp_xxh, "0", 1, errstr, Nullch, Nullch);
+ if (CSFORM_IMPLIES_UTF8(fbh->csform) ){
+ SvUTF8_on(sv);
+ }
+ }
+ }
+ else
+#endif /* DBISTATE_VERSION > 94 */
+ {
+ if (CSFORM_IMPLIES_UTF8(fbh->csform) ){
+ SvUTF8_on(sv);
+ }
+ }
+ }
+ }
+
+ }
+ else if (rc == 1405) { /* field is null - return undef */
+ sv_set_undef(sv);
+ }
+ else { /* See odefin rcode arg description in OCI docs */
+ char buf[200];
+ char *hint = "";
+ /* These may get more case-by-case treatment eventually. */
+ if (rc == 1406) { /* field truncated (see above) */
+ if (!fbh->fetch_func) {
+ /* Copy the truncated value anyway, it may be of use, */
+ /* but it'll only be accessible via prior bind_column() */
+ sv_setpvn(sv, (char *)row_data,fb_ary->arlen[imp_sth->rs_array_idx]);
+ if ((CSFORM_IMPLIES_UTF8(fbh->csform)) && (fbh->ftype != SQLT_BIN)){
+ SvUTF8_on(sv);
+ }
+ }
+
+ if (ora_dbtype_is_long(fbh->dbtype)){ /* double check */
+ hint = ", LongReadLen too small and/or LongTruncOk not set";
+ }
+
+ }
+ else { /* set field that caused error to undef */
+ sv_set_undef(sv);
+ }
+ ++err; /* 'fail' this fetch but continue getting fields */
+ /* Some should probably be treated as warnings but */
+ /* for now we just treat them all as errors */
+ sprintf(buf,"ORA-%05d error on field %d of %d, ora_type %d%s",rc, i+1, num_fields, fbh->dbtype, hint);
+ oci_error(sth, imp_sth->errhp, OCI_ERROR, buf);
}
- if (ora_dbtype_is_long(fbh->dbtype)) /* double check */
- hint = ", LongReadLen too small and/or LongTruncOk not set";
- }
- else {
- (void)SvOK_off(sv); /* set field that caused error to undef */
- }
- ++err; /* 'fail' this fetch but continue getting fields */
- /* Some should probably be treated as warnings but */
- /* for now we just treat them all as errors */
- sprintf(buf,"ORA-%05d error on field %d of %d, ora_type %d%s",
- rc, i+1, num_fields, fbh->dbtype, hint);
- oci_error(sth, imp_sth->errhp, OCI_ERROR, buf);
- }
-
- if (DBIS->debug >= 5)
- PerlIO_printf(DBILOGFP, " %d (rc=%d): %s\n",
- i, rc, neatsvpv(sv,0));
- }
- return (err) ? Nullav : av;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ "\n %p (field=%d): %s\n", av, i,neatsvpv(sv,10));
+ }
+ }
+ return (err) ? Nullav : av;
}
ub4
-ora_parse_uid(imp_dbh, uidp, pwdp)
- imp_dbh_t *imp_dbh;
- char **uidp;
- char **pwdp;
+ora_parse_uid(imp_dbh_t *imp_dbh, char **uidp, char **pwdp)
{
- sword status;
- /* OCI 8 does not seem to allow uid to be "name/pass" :-( */
- /* so we have to split it up ourselves */
- if (strlen(*pwdp)==0 && strchr(*uidp,'/')) {
- SV *tmpsv = sv_2mortal(newSVpv(*uidp,0));
- *uidp = SvPVX(tmpsv);
- *pwdp = strchr(*uidp, '/');
- *(*pwdp)++ = '\0';
- /* XXX look for '@', e.g. "u/p@d" and "u@d" and maybe "@d"? */
- }
- if (**uidp == '\0' && **pwdp == '\0') {
- return OCI_CRED_EXT;
- }
- OCIAttrSet_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,
- *uidp, strlen(*uidp),
- (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status);
- OCIAttrSet_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,
- (strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp),
- (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status);
- return OCI_CRED_RDBMS;
+ dTHX;
+ sword status;
+
+ /* OCI 8 does not seem to allow uid to be "name/pass" :-( */
+ /* so we have to split it up ourselves */
+ if (strlen(*pwdp)==0 && strchr(*uidp,'/')) {
+ SV *tmpsv = sv_2mortal(newSVpv(*uidp,0));
+ *uidp = SvPVX(tmpsv);
+ *pwdp = strchr(*uidp, '/');
+ *(*pwdp)++ = '\0';
+ /* XXX look for '@', e.g. "u/p@d" and "u@d" and maybe "@d"? */
+ }
+ if (**uidp == '\0' && **pwdp == '\0') {
+ return OCI_CRED_EXT;
+ }
+#ifdef ORA_OCI_112
+ if (imp_dbh->using_drcp){
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION,
+ *uidp, strlen(*uidp),
+ (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status);
+
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION,
+ (strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp),
+ (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status);
+ }
+ else {
+#endif
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,
+ *uidp, strlen(*uidp),
+ (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status);
+
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,
+ (strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp),
+ (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status);
+#ifdef ORA_OCI_112
+ }
+#endif
+ return OCI_CRED_RDBMS;
}
int
-ora_db_reauthenticate(dbh, imp_dbh, uid, pwd)
- SV *dbh;
- imp_dbh_t *imp_dbh;
- char * uid;
- char * pwd;
+ora_db_reauthenticate(SV *dbh, imp_dbh_t *imp_dbh, char *uid, char *pwd)
{
- sword status;
- /* XXX should possibly create new session before ending the old so */
- /* that if the new one can't be created, the old will still work. */
- OCISessionEnd_log_stat(imp_dbh->svchp, imp_dbh->errhp,
- imp_dbh->authp, OCI_DEFAULT, status); /* XXX check status here?*/
- OCISessionBegin_log_stat( imp_dbh->svchp, imp_dbh->errhp, imp_dbh->authp,
- ora_parse_uid(imp_dbh, &uid, &pwd), (ub4) OCI_DEFAULT, status);
- if (status != OCI_SUCCESS) {
- oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
- return 0;
- }
- return 1;
+ dTHX;
+ sword status;
+ /* XXX should possibly create new session before ending the old so */
+ /* that if the new one can't be created, the old will still work. */
+ OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp,
+ imp_dbh->seshp, OCI_DEFAULT, status); /* XXX check status here?*/
+ OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,
+ ora_parse_uid(imp_dbh, &uid, &pwd), (ub4) OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
+ return 0;
+ }
+ return 1;
}
@@ -1504,14 +4308,14 @@ ora_db_reauthenticate(dbh, imp_dbh, uid, pwd)
static char *
rowid2hex(OCIRowid *rowid)
{
- int i;
- SV *sv = sv_2mortal(newSVpv("",0));
- for (i = 0; i < OCI_ROWID_LEN; i++) {
- char buf[6];
- sprintf(buf, "%02X ", (int)(((ub1*)rowid)[i]));
- sv_catpv(sv, buf);
- }
- return SvPVX(sv);
+ int i;
+ SV *sv = sv_2mortal(newSVpv("",0));
+ for (i = 0; i < OCI_ROWID_LEN; i++) {
+ char buf[6];
+ sprintf(buf, "%02X ", (int)(((ub1*)rowid)[i]));
+ sv_catpv(sv, buf);
+ }
+ return SvPVX(sv);
}
#endif
@@ -1519,436 +4323,619 @@ rowid2hex(OCIRowid *rowid)
static void *
alloc_via_sv(STRLEN len, SV **svp, int mortal)
{
- SV *sv = newSVpv("",0);
- sv_grow(sv, len+1);
- memset(SvPVX(sv), 0, len);
- if (mortal)
+ dTHX;
+ SV *sv = newSVpv("",0);
+ sv_grow(sv, len+1);
+ memset(SvPVX(sv), 0, len);
+ if (mortal)
sv_2mortal(sv);
- if (svp)
+ if (svp)
*svp = sv;
- return SvPVX(sv);
+ return SvPVX(sv);
}
char *
find_ident_after(char *src, char *after, STRLEN *len, int copy)
{
- int seen_key = 0;
- char *orig = src;
- char *p;
- while(*src) {
- if (*src == '\'' || *src == '"') {
- char delim = *src;
- while(*src && *src != delim) ++src;
- }
- else if (*src == '-' && src[1] == '-') {
- while(*src && *src != '\n') ++src;
- }
- else if (*src == '/' && src[1] == '*') {
- while(*src && !(*src == '*' && src[1]=='/')) ++src;
- }
- else if (isALPHA(*src)) {
- if (seen_key) {
- char *start = src;
- while(*src && (isALNUM(*src) || *src=='.' || *src=='$'))
- ++src;
- *len = src - start;
- if (copy) {
- p = alloc_via_sv(*len, 0, 1);
- strncpy(p, start, *len);
- p[*len] = '\0';
- return p;
- }
- return start;
- }
- else if ( toLOWER(*src)==toLOWER(*after)
- && (src==orig ? 1 : !isALPHA(src[-1]))
- ) {
- p = after;
- while(*p && *src && toLOWER(*p)==toLOWER(*src))
- ++p, ++src;
- if (!*p)
- seen_key = 1;
- }
- ++src;
- }
+
+ int seen_key = 0;
+ char *orig = src;
+ char *p;
+
+
+ while(*src){
+ if (*src == '\'') {
+ char delim = *src;
+ while(*src && *src != delim) ++src;
+ }
+ else if (*src == '-' && src[1] == '-') {
+ while(*src && *src != '\n') ++src;
+ }
+ else if (*src == '/' && src[1] == '*') {
+ while(*src && !(*src == '*' && src[1]=='/')) ++src;
+ }
+ else if (isALPHA(*src)) {
+ if (seen_key) {
+ char *start = src;
+ while(*src && (isALNUM(*src) || *src=='.' || *src=='$' || *src=='"'))
+ ++src;
+ *len = src - start;
+ if (copy) {
+ p = (char*)alloc_via_sv(*len, 0, 1);
+ strncpy(p, start, *len);
+ p[*len] = '\0';
+ return p;
+ }
+ return start;
+ }
+ else if ( toLOWER(*src)==toLOWER(*after)
+ && (src==orig ? 1 : !isALPHA(src[-1]))) {
+ p = after;
+ while(*p && *src && toLOWER(*p)==toLOWER(*src))
+ ++p, ++src;
+ if (!*p)
+ seen_key = 1;
+ }
+ ++src;
+ }
else
- ++src;
- }
- return NULL;
+ ++src;
+ }
+ return NULL;
}
+
+
struct lob_refetch_st {
- SV *sql_select;
- OCIStmt *stmthp;
- OCIBind *bindhp;
- OCIRowid *rowid;
- OCIParam *parmdp_tmp;
- OCIParam *parmdp_lob;
- int num_fields;
- SV *fbh_ary_sv;
- imp_fbh_t *fbh_ary;
+ OCIStmt *stmthp;
+ OCIBind *bindhp;
+ OCIRowid *rowid;
+ OCIParam *parmdp_tmp;
+ OCIParam *parmdp_lob;
+ int num_fields;
+ SV *fbh_ary_sv;
+ imp_fbh_t *fbh_ary;
};
static int
init_lob_refetch(SV *sth, imp_sth_t *imp_sth)
{
- SV *sv;
- SV *sql_select;
- HV *lob_cols_hv = NULL;
- sword status;
- OCIError *errhp = imp_sth->errhp;
- OCIDescribe *dschp = NULL;
- OCIParam *parmhp = NULL, *collisthd = NULL;
- ub2 numcols = 0;
- imp_fbh_t *fbh;
- int unmatched_params;
- I32 i;
- char *p;
- lob_refetch_t *lr = NULL;
- STRLEN tablename_len;
- char *tablename;
- char new_tablename[100];
-
- switch (imp_sth->stmt_type) {
- case OCI_STMT_UPDATE:
- tablename = find_ident_after(imp_sth->statement,
+ dTHX;
+ SV *sv;
+ SV *sql_select;
+ HV *lob_cols_hv = NULL;
+ sword status;
+ OCIError *errhp = imp_sth->errhp;
+ OCIParam *parmhp = NULL, *collisthd = NULL, *colhd = NULL;
+ ub2 numcols = 0;
+ imp_fbh_t *fbh;
+ int unmatched_params;
+ I32 i,j;
+ char *p;
+ lob_refetch_t *lr = NULL;
+ STRLEN tablename_len;
+ char *tablename;
+ char new_tablename[100];
+ switch (imp_sth->stmt_type) {
+ case OCI_STMT_UPDATE:
+ tablename = find_ident_after(imp_sth->statement,
"update", &tablename_len, 1);
- break;
- case OCI_STMT_INSERT:
- tablename = find_ident_after(imp_sth->statement,
+ break;
+ case OCI_STMT_INSERT:
+ tablename = find_ident_after(imp_sth->statement,
"into", &tablename_len, 1);
- break;
- default:
- return oci_error(sth, errhp, OCI_ERROR,
- "LOB refetch attempted for unsupported statement type");
- }
- if (!tablename)
- return oci_error(sth, errhp, OCI_ERROR,
+ break;
+ default:
+ return oci_error(sth, errhp, OCI_ERROR,
+ "LOB refetch attempted for unsupported statement type (see also ora_auto_lob attribute)");
+ }
+
+ if (!tablename)
+ return oci_error(sth, errhp, OCI_ERROR,
"Unable to parse table name for LOB refetch");
- OCIHandleAlloc_ok(imp_sth->envhp, &dschp, OCI_HTYPE_DESCRIBE, status);
- /* BEGIN NEW */
- OCIDescribeAny_log_stat(imp_sth->svchp, errhp, tablename, strlen(tablename),
- (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_SYN, dschp, status);
- if (status == OCI_SUCCESS) { /* There is a synonym, get the schema */
- char *syn_schema=NULL, *syn_name=NULL;
- OCIAttrGet_log_stat(dschp, OCI_HTYPE_DESCRIBE,
- &parmhp, 0, OCI_ATTR_PARAM, errhp, status);
- OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,
- &syn_schema, 0, OCI_ATTR_SCHEMA_NAME, errhp, status);
- OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,
- &syn_name, 0, OCI_ATTR_OBJ_NAME, errhp, status);
- strcpy(new_tablename, syn_schema);
- strcat(new_tablename, ".");
- strcat(new_tablename, syn_name);
- tablename=new_tablename;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " lob refetch synonym, schema=%s, name=%s, new tablename=%s\n", syn_schema, syn_name, tablename);
- }
- /* END NEW */
- OCIDescribeAny_log_stat(imp_sth->svchp, errhp, tablename, strlen(tablename),
- (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_TABLE, dschp, status);
- if (status != OCI_SUCCESS) {
- /* XXX this OCI_PTYPE_TABLE->OCI_PTYPE_VIEW fallback should actually be */
- /* a loop that includes synonyms etc */
- OCIDescribeAny_log_stat(imp_sth->svchp, errhp, tablename, strlen(tablename),
- (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_VIEW, dschp, status);
- if (status != OCI_SUCCESS) {
- OCIHandleFree_log_stat(dschp, OCI_HTYPE_DESCRIBE, status);
- return oci_error(sth, errhp, status, "OCIDescribeAny(view)/LOB refetch");
- }
- }
-
- OCIAttrGet_log_stat(dschp, OCI_HTYPE_DESCRIBE,
+ if (!imp_sth->dschp){
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth,imp_sth->errhp, status, "OCIHandleAlloc");
+ }
+
+ }
+
+ OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
+ (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_SYN, imp_sth->dschp, status);
+
+ if (status == OCI_SUCCESS) { /* There is a synonym, get the schema */
+ char *syn_schema=NULL;
+ char syn_name[100];
+ ub4 tn_len = 0, syn_schema_len = 0;
+
+ strncpy(syn_name,tablename,strlen(tablename));
+ /* Put the synonym name here for later user */
+
+ OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE,
+ &parmhp, 0, OCI_ATTR_PARAM, errhp, status);
+
+ OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
+ &syn_schema, &syn_schema_len, OCI_ATTR_SCHEMA_NAME, errhp, status);
+
+
+ OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
+ &tablename, &tn_len, OCI_ATTR_NAME, errhp, status);
+
+ strncpy(new_tablename,syn_schema,syn_schema_len);
+ new_tablename[syn_schema_len+1] = '\0';
+ new_tablename[syn_schema_len]='.';
+ strncat(new_tablename, tablename,tn_len);
+
+ tablename=new_tablename;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch using a synonym named=%s for %s \n",
+ syn_name,tablename);
+
+
+ }
+ OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
+ (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_TABLE, imp_sth->dschp, status);
+
+ if (status != OCI_SUCCESS) {
+ /* XXX this OCI_PTYPE_TABLE->OCI_PTYPE_VIEW fallback should actually be */
+ /* a loop that includes synonyms etc */
+ OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
+ (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_VIEW, imp_sth->dschp, status);
+ if (status != OCI_SUCCESS) {
+ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ return oci_error(sth, errhp, status, "OCIDescribeAny(view)/LOB refetch");
+ }
+ }
+
+ OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE,
&parmhp, 0, OCI_ATTR_PARAM, errhp, status);
- if ( ! status ) {
- OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,
+ if (!status ) {
+ OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&numcols, 0, OCI_ATTR_NUM_COLS, errhp, status);
- }
- if ( ! status ) {
- OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,
+ }
+
+ if (!status ) {
+ OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&collisthd, 0, OCI_ATTR_LIST_COLUMNS, errhp, status);
- }
- if (status != OCI_SUCCESS) {
- OCIHandleFree_log_stat(dschp, OCI_HTYPE_DESCRIBE, status);
- return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch");
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " lob refetch from table %s, %d columns:\n",
- tablename, numcols);
-
- for (i = 1; i <= (long)numcols; i++) {
- OCIParam *colhd;
- ub2 col_dbtype;
- char *col_name;
- ub4 col_name_len;
- OCIParamGet_log_stat(collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd,
- i, status);
- if (status)
- break;
- OCIAttrGet_log_stat(colhd, OCI_DTYPE_PARAM, &col_dbtype, 0,
- OCI_ATTR_DATA_TYPE, errhp, status);
- if (status)
- break;
- OCIAttrGet_log_stat(colhd, OCI_DTYPE_PARAM, &col_name, &col_name_len,
- OCI_ATTR_NAME, errhp, status);
- if (status)
- break;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " lob refetch table col %d: '%.*s' otype %d\n",
- (int)i, (int)col_name_len,col_name, col_dbtype);
- if (col_dbtype != SQLT_CLOB && col_dbtype != SQLT_BLOB)
- continue;
+ }
+
+ if (status != OCI_SUCCESS) {
+ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch");
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch from table %s, %d columns:\n",
+ tablename, numcols);
+
+ for (i = 1; i <= (long)numcols; i++) {
+ ub2 col_dbtype;
+ char *col_name;
+ ub4 col_name_len;
+ OCIParamGet_log_stat(imp_sth, collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd, i, status);
+ if (status)
+ break;
+
+ OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_dbtype, 0,
+ OCI_ATTR_DATA_TYPE, errhp, status);
+ if (status)
+ break;
+
+ OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_name, &col_name_len,
+ OCI_ATTR_NAME, errhp, status);
+ if (status)
+ break;
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch table col %d: '%.*s' otype %d\n",
+ (int)i, (int)col_name_len,col_name, col_dbtype);
+
+ if (col_dbtype != SQLT_CLOB && col_dbtype != SQLT_BLOB)
+ continue;
+
+ if (!lob_cols_hv)
+ lob_cols_hv = newHV();
+
+ sv = newSViv(col_dbtype);
+ (void)sv_setpvn(sv, col_name, col_name_len);
+
+ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
+ SvUTF8_on(sv);
+
+ (void)SvIOK_on(sv); /* "what a wonderful hack!" */
+ (void)hv_store(lob_cols_hv, col_name,col_name_len, sv,0);
+ OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM);
+ colhd = NULL;
+ }
+
+ if (colhd)
+ OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, errhp, status,
+ "OCIDescribeAny/OCIParamGet/OCIAttrGet/LOB refetch");
+ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ return 0;
+ }
+
if (!lob_cols_hv)
- lob_cols_hv = newHV();
- sv = newSViv(col_dbtype);
- (void)sv_setpvn(sv, col_name, col_name_len);
-#ifdef UTF8_SUPPORT
- DBD_SET_UTF8(sv);
-#endif
- (void)SvIOK_on(sv); /* what a wonderful hack! */
- hv_store(lob_cols_hv, col_name,col_name_len, sv,0);
- }
- if (status != OCI_SUCCESS) {
- OCIHandleFree_log_stat(dschp, OCI_HTYPE_DESCRIBE, status);
- return oci_error(sth, errhp, status,
- "OCIDescribeAny/OCIParamGet/OCIAttrGet/LOB refetch");
- }
- if (!lob_cols_hv)
- return oci_error(sth, errhp, OCI_ERROR,
- "LOB refetch failed, no lobs in table");
+ return oci_error(sth, errhp, OCI_ERROR,
+ "LOB refetch failed, no lobs in table");
- /* our bind params are in %imp_sth->all_params_hv
+ /* our bind params are in %imp_sth->all_params_hv
our table cols are in %lob_cols_hv
we now iterate through our bind params
and allocate them to the appropriate table columns
- */
- Newz(1, lr, 1, lob_refetch_t);
- unmatched_params = 0;
- lr->num_fields = 0;
- lr->fbh_ary = alloc_via_sv(sizeof(imp_fbh_t) * HvKEYS(lob_cols_hv)+1,
- &lr->fbh_ary_sv, 0);
-
- sql_select = newSVpv("select ",0);
-
- hv_iterinit(imp_sth->all_params_hv);
- while( (sv = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) {
- int matched = 0;
- phs_t *phs = (phs_t*)(void*)SvPVX(sv);
- if (sv == &sv_undef || !phs)
- croak("panic: unbound params");
- if (phs->ftype != SQLT_CLOB && phs->ftype != SQLT_BLOB)
- continue;
-
- hv_iterinit(lob_cols_hv);
- while( (sv = hv_iternextsv(lob_cols_hv, &p, &i)) != NULL ) {
- char sql_field[200];
- if (phs->ora_field) { /* must match this phs by field name */
- char *ora_field_name = SvPV(phs->ora_field,na);
- if (SvCUR(phs->ora_field) != SvCUR(sv)
- || ibcmp(ora_field_name, SvPV(sv,na), SvCUR(sv) ) )
- continue;
- }
- else /* basic dumb match by type */
- if (phs->ftype != SvIV(sv))
- continue;
- else { /* got a type match - check it's safe */
- SV *sv_other;
- char *p_other;
- /* would any other lob field match this type? */
- while( (sv_other = hv_iternextsv(lob_cols_hv, &p_other, &i)) != NULL ) {
- if (phs->ftype != SvIV(sv_other))
+ */
+ Newz(1, lr, 1, lob_refetch_t);
+ unmatched_params = 0;
+ lr->num_fields = 0;
+ lr->fbh_ary = (imp_fbh_t*)alloc_via_sv(sizeof(imp_fbh_t) * HvKEYS(lob_cols_hv)+1,
+ &lr->fbh_ary_sv, 0);
+
+ sql_select = sv_2mortal(newSVpv("select ",0));
+
+ hv_iterinit(imp_sth->all_params_hv);
+ while( (sv = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) {
+ int matched = 0;
+ phs_t *phs = (phs_t*)(void*)SvPVX(sv);
+
+ if (sv == &PL_sv_undef || !phs)
+ croak("panic: unbound params");
+
+ if (phs->ftype != SQLT_CLOB && phs->ftype != SQLT_BLOB)
continue;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " both %s and %s have type %d - ambiguous\n",
- neatsvpv(sv,0), neatsvpv(sv_other,0), (int)SvIV(sv_other));
- Safefree(lr);
- return oci_error(sth, errhp, OCI_ERROR,
- "Need bind_param(..., { ora_field=>... }) attribute to identify table LOB field names");
- }
- }
- matched = 1;
- sprintf(sql_field, "%s%s \"%s\"",
- (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]);
- sv_catpv(sql_select, sql_field);
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch %s param: otype %d, matched field '%s' %s(%s)\n",
- phs->name, phs->ftype, p,
- (phs->ora_field) ? "by name " : "by type ", sql_field);
- hv_delete(lob_cols_hv, p, i, 0);
- fbh = &lr->fbh_ary[lr->num_fields++];
- fbh->name = phs->name;
- fbh->ftype = phs->ftype;
- fbh->dbtype = phs->ftype;
- fbh->disize = 99;
- fbh->desc_t = OCI_DTYPE_LOB;
- OCIDescriptorAlloc_ok(imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
- break; /* we're done with this placeholder now */
- }
- if (!matched) {
- ++unmatched_params;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch %s param: otype %d, UNMATCHED\n",
- phs->name, phs->ftype);
- }
- }
- if (unmatched_params) {
- Safefree(lr);
- return oci_error(sth, errhp, OCI_ERROR,
- "Can't match some parameters to LOB fields in the table, check type and name");
- }
- sv_catpv(sql_select, " from ");
- sv_catpv(sql_select, tablename);
- sv_catpv(sql_select, " where rowid = :rid for update"); /* get row with lock */
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch sql: %s\n", SvPVX(sql_select));
- lr->sql_select = sql_select;
+ hv_iterinit(lob_cols_hv);
+
+ while( (sv = hv_iternextsv(lob_cols_hv, &p, &j)) != NULL ) {
+ char sql_field[200];
+ if (phs->ora_field) { /* must match this phs by field name */
+ char *ora_field_name = SvPV(phs->ora_field,PL_na);
+ if (SvCUR(phs->ora_field) != SvCUR(sv)
+ || ibcmp(ora_field_name, SvPV(sv,PL_na), (I32)SvCUR(sv) ) )
+ continue;
+ }
+ else { /* basic dumb match by type */
+ if (phs->ftype != SvIV(sv)){
+ continue;
+ }
+ else { /* got a type match - check it's safe */
+ SV *sv_other;
+ char *p_other;
+ /* would any other lob field match this type? */
+ while( (sv_other = hv_iternextsv(lob_cols_hv, &p_other, &i)) != NULL ) {
+ if (phs->ftype != SvIV(sv_other))
+ continue;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " both %s and %s have type %d - ambiguous\n",
+ neatsvpv(sv,0), neatsvpv(sv_other,0),
+ (int)SvIV(sv_other));
+ Safefree(lr);
+ sv_free((SV*)lob_cols_hv);
+ return oci_error(sth, errhp, OCI_ERROR,
+ "Need bind_param(..., { ora_field=>... }) attribute to identify table LOB field names");
+ }
+ }
+ }
+
+ matched = 1;
+ sprintf(sql_field, "%s%s \"%s\"",
+ (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]);
+ sv_catpv(sql_select, sql_field);
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch %s param: otype %d, matched field '%s' %s(%s)\n",
+ phs->name, phs->ftype, p,
+ (phs->ora_field) ? "by name " : "by type ", sql_field);
+ (void)hv_delete(lob_cols_hv, p, i, G_DISCARD);
+ fbh = &lr->fbh_ary[lr->num_fields++];
+ fbh->name = phs->name;
+ fbh->ftype = phs->ftype;
+ fbh->dbtype = phs->ftype;
+ fbh->disize = 99;
+ fbh->desc_t = OCI_DTYPE_LOB;
+ OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
+
+ break; /* we're done with this placeholder now */
- lr->stmthp = NULL;
- lr->bindhp = NULL;
- lr->rowid = NULL;
- lr->parmdp_tmp = NULL;
- lr->parmdp_lob = NULL;
+ }
+ if (!matched) {
+ ++unmatched_params;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch %s param: otype %d, UNMATCHED\n",
+ phs->name, phs->ftype);
+ }
+ }
+ sv_free((SV*)lob_cols_hv);
+ if (unmatched_params) {
+ Safefree(lr);
+ return oci_error(sth, errhp, OCI_ERROR,
+ "Can't match some parameters to LOB fields in the table, check type and name");
+ }
- OCIHandleAlloc_ok(imp_sth->envhp, &lr->stmthp, OCI_HTYPE_STMT, status);
- OCIStmtPrepare_log_stat(lr->stmthp, errhp,
+ sv_catpv(sql_select, " from ");
+ sv_catpv(sql_select, tablename);
+ sv_catpv(sql_select, " where rowid = :rid for update"); /* get row with lock */
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch sql: %s\n", SvPVX(sql_select));
+ lr->stmthp = NULL;
+ lr->bindhp = NULL;
+ lr->rowid = NULL;
+ lr->parmdp_tmp = NULL;
+ lr->parmdp_lob = NULL;
+ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &lr->stmthp, OCI_HTYPE_STMT, status);
+ OCIStmtPrepare_log_stat(imp_sth, lr->stmthp, errhp,
(text*)SvPVX(sql_select), SvCUR(sql_select), OCI_NTV_SYNTAX,
- OCI_DEFAULT, status);
- if (status != OCI_SUCCESS)
- return oci_error(sth, errhp, status, "OCIStmtPrepare/LOB refetch");
-
- /* bind the rowid input */
- OCIDescriptorAlloc_ok(imp_sth->envhp, &lr->rowid, OCI_DTYPE_ROWID);
- OCIBindByName_log_stat(lr->stmthp, &lr->bindhp, errhp, (text*)":rid", 4,
- &lr->rowid, sizeof(OCIRowid*), SQLT_RDD, 0,0,0,0,0, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS)
- return oci_error(sth, errhp, status, "OCIBindByPos/LOB refetch");
-
- /* define the output fields */
- for(i=0; i < lr->num_fields; ++i) {
- OCIDefine *defnp = NULL;
- imp_fbh_t *fbh = &lr->fbh_ary[i];
- phs_t *phs;
- SV **phs_svp = hv_fetch(imp_sth->all_params_hv, fbh->name,strlen(fbh->name), 0);
- if (!phs_svp)
- croak("panic: LOB refetch for '%s' param (%d) - name not found",
- fbh->name,i+1);
- phs = (phs_t*)(void*)SvPVX(*phs_svp);
- fbh->special = phs;
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch %d for '%s' param: ftype %d setup\n",
+ OCI_DEFAULT, status);
+
+ if (status != OCI_SUCCESS) {
+ OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
+ Safefree(lr);
+ return oci_error(sth, errhp, status, "OCIStmtPrepare/LOB refetch");
+ }
+
+ /* bind the rowid input */
+ OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &lr->rowid, OCI_DTYPE_ROWID);
+ OCIBindByName_log_stat(imp_sth, lr->stmthp, &lr->bindhp, errhp, (text*)":rid", 4,
+ &lr->rowid, sizeof(OCIRowid*), SQLT_RDD, 0,0,0,0,0, OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
+ OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
+ Safefree(lr);
+ return oci_error(sth, errhp, status, "OCIBindByPos/LOB refetch");
+ }
+
+ /* define the output fields */
+ for(i=0; i < lr->num_fields; ++i) {
+ OCIDefine *defnp = NULL;
+ imp_fbh_t *fbh = &lr->fbh_ary[i];
+ phs_t *phs;
+ SV **phs_svp = hv_fetch(imp_sth->all_params_hv, fbh->name,strlen(fbh->name), 0);
+ if (!phs_svp)
+ croak("panic: LOB refetch for '%s' param (%ld) - name not found",fbh->name,(unsigned long)i+1);
+ phs = (phs_t*)(void*)SvPVX(*phs_svp);
+ fbh->special = phs;
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch %d for '%s' param: ftype %d setup\n",
(int)i+1,fbh->name, fbh->dbtype);
- fbh->fb_ary = fb_ary_alloc(fbh->disize, 1);
- OCIDefineByPos_log_stat(lr->stmthp, &defnp, errhp, (ub4)i+1,
- &fbh->desc_h, -1, (ub2)fbh->ftype,
+ fbh->fb_ary = fb_ary_alloc(fbh->disize, 1);
+ OCIDefineByPos_log_stat(imp_sth, lr->stmthp, &defnp, errhp, (ub4)i+1,
+ &fbh->desc_h, -1, (ub2)fbh->ftype,
fbh->fb_ary->aindp, 0, fbh->fb_ary->arcode, OCI_DEFAULT, status);
- if (status != OCI_SUCCESS)
- return oci_error(sth, errhp, status, "OCIDefineByPos/LOB refetch");
- }
+ if (status != OCI_SUCCESS) {
+ OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
+ OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
+ Safefree(lr);
+ fb_ary_free(fbh->fb_ary);
+ fbh->fb_ary = NULL;
+ return oci_error(sth, errhp, status, "OCIDefineByPos/LOB refetch");
+ }
+ }
- imp_sth->lob_refetch = lr; /* structure copy */
- return 1;
-}
+ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
+ imp_sth->lob_refetch = lr; /* structure copy */
+ return 1;
+}
int
post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handles on error */
{
- /* To insert a new LOB transparently (without using 'INSERT . RETURNING .') */
- /* we have to insert an empty LobLocator and then fetch it back from the */
- /* server before we can call OCILobWrite on it! This function handles that. */
- sword status;
- int i;
- OCIError *errhp = imp_sth->errhp;
- ub4 rowid_iter = 0;
- lob_refetch_t *lr;
- D_imp_dbh_from_sth;
- SV *dbh = (SV*)DBIc_MY_H(imp_dbh);
-
- if (row_count == 0)
- return 1; /* nothing to do */
- if (row_count > 1)
- return oci_error(sth, errhp, OCI_ERROR, "LOB refetch attempted for multiple rows");
-
- if (!imp_sth->lob_refetch)
- if (!init_lob_refetch(sth, imp_sth))
- return 0; /* init_lob_refetch already called oci_error */
- lr = imp_sth->lob_refetch;
-
- OCIAttrGet_stmhp_stat(imp_sth, (dvoid**)lr->rowid, &rowid_iter, OCI_ATTR_ROWID,
- status);
- if (status != OCI_SUCCESS)
- return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID /LOB refetch");
-
- OCIStmtExecute_log_stat(imp_sth->svchp, lr->stmthp, errhp,
- 1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */
- if (status != OCI_SUCCESS)
- return oci_error(sth, errhp, status,
- ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch"));
-
- for(i=0; i < lr->num_fields; ++i) {
- imp_fbh_t *fbh = &lr->fbh_ary[i];
- int rc = fbh->fb_ary->arcode[0];
- phs_t *phs = (phs_t*)fbh->special;
- ub4 amtp;
- SvUPGRADE(phs->sv, SVt_PV); /* just in case */
- amtp = SvCUR(phs->sv); /* XXX UTF8? */
- if (rc == 1405) { /* NULL - return undef */
- (void)SvOK_off(phs->sv);
- status = OCI_SUCCESS;
- }
- else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail (OCI 8.0.4) */
- OCILobWrite_log_stat(imp_sth->svchp, errhp,
- fbh->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
- 0,0, 0,SQLCS_IMPLICIT, status);
- }
- else { /* amtp==0 so truncate LOB to zero length */
- OCILobTrim_log_stat(imp_sth->svchp, errhp, fbh->desc_h, 0, status);
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch %d for '%s' param: ftype %d, len %ld: %s %s\n",
- i+1,fbh->name, fbh->dbtype, ul_t(amtp),
- (rc==1405 ? "NULL" : (amtp > 0) ? "LobWrite" : "LobTrim"), oci_status_name(status));
- if (status != OCI_SUCCESS) {
- return oci_error(sth, errhp, status, "OCILobTrim/OCILobWrite/LOB refetch");
+
+ /* To insert a new LOB transparently (without using 'INSERT . RETURNING .') */
+ /* we have to insert an empty LobLocator and then fetch it back from the */
+ /* server before we can call OCILobWrite on it! This function handles that. */
+ dTHX;
+ sword status;
+ int i;
+ OCIError *errhp = imp_sth->errhp;
+ lob_refetch_t *lr;
+ D_imp_dbh_from_sth;
+ SV *dbh = (SV*)DBIc_MY_H(imp_dbh);
+
+ if (!imp_sth->auto_lob)
+ return 1; /* application doesn't want magical lob handling */
+
+ if (imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE){
+ /* PL/SQL is handled by lob_phs_ora_free_templobpost_execute */
+ if (imp_sth->has_lobs) { /*get rid of OCILob Temporary used in non inout bind*/
+ SV *phs_svp;
+ I32 i;
+ char *p;
+ hv_iterinit(imp_sth->all_params_hv);
+ while( (phs_svp = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) {
+ phs_t *phs = (phs_t*)(void*)SvPVX(phs_svp);
+
+
+
+ if (phs->desc_h && !phs->is_inout){
+ OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, phs->desc_h, status);
+
+
+ /* boolean lobEmpty=1;*/
+ /* OCIAttrSet_log_stat(phs->desc_h, phs->desc_t,&lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);*/
+ /* OCIHandleFree_log_stat(phs->desc_h, phs->desc_t, status);*/
+ }
+ /*this seem to cause an error later on so I just got rid of it for Now does */
+ /* not seem to kill anything */
+ }
+ }
+ return 1;
}
- }
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
- dbd_db_commit(dbh, imp_dbh);
+ if (row_count == 0)
+ return 1; /* nothing to do */
+ if (row_count > 1)
+ return oci_error(sth, errhp, OCI_ERROR, "LOB refetch attempted for multiple rows");
+
+ if (!imp_sth->lob_refetch) {
+ if (!init_lob_refetch(sth, imp_sth))
+ return 0; /* init_lob_refetch already called oci_error */
+ }
+ lr = imp_sth->lob_refetch;
+
+ OCIAttrGet_stmhp_stat(imp_sth, lr->rowid, 0, OCI_ATTR_ROWID,status);
+
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID /LOB refetch");
+
+ OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, lr->stmthp, errhp,1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */
+
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, errhp, status,
+
+ ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch"));
+
+ for(i=0; i < lr->num_fields; ++i) {
+ imp_fbh_t *fbh = &lr->fbh_ary[i];
+ int rc = fbh->fb_ary->arcode[0];
+ phs_t *phs = (phs_t*)fbh->special;
+ ub4 amtp;
+
+ (void)SvUPGRADE(phs->sv, SVt_PV);
+
+ amtp = SvCUR(phs->sv); /* XXX UTF8? */
+ if (rc == 1405) { /* NULL - return undef */
+ sv_set_undef(phs->sv);
+ status = OCI_SUCCESS;
+ }
+ else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail (OCI 8.0.4) */
+ if( ! fbh->csid ) {
+ ub1 csform = SQLCS_IMPLICIT;
+ ub2 csid = 0;
+ OCILobCharSetForm_log_stat(imp_sth,
+ imp_sth->envhp,
+ errhp,
+ (OCILobLocator*)fbh->desc_h,
+ &csform,
+ status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, errhp, status, "OCILobCharSetForm");
+#ifdef OCI_ATTR_CHARSET_ID
+ /* Effectively only used so AL32UTF8 works properly */
+ OCILobCharSetId_log_stat(imp_sth,
+ imp_sth->envhp,
+ errhp,
+ (OCILobLocator*)fbh->desc_h,
+ &csid,
+ status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, errhp, status, "OCILobCharSetId");
+#endif /* OCI_ATTR_CHARSET_ID */
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
+ fbh->csid = csid;
+ fbh->csform = csform;
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " calling OCILobWrite fbh->csid=%d fbh->csform=%d amtp=%d\n",
+ fbh->csid, fbh->csform, amtp );
+
+ OCILobWrite_log_stat(imp_sth, imp_sth->svchp, errhp,
+ (OCILobLocator*)fbh->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
+ 0,0, fbh->csid ,fbh->csform, status);
+
+ if (status != OCI_SUCCESS) {
+ return oci_error(sth, errhp, status, "OCILobWrite in post_execute_lobs");
+ }
+
+ } else { /* amtp==0 so truncate LOB to zero length */
+ OCILobTrim_log_stat(imp_sth, imp_sth->svchp, errhp, (OCILobLocator*)fbh->desc_h, 0, status);
+
+ if (status != OCI_SUCCESS) {
+ return oci_error(sth, errhp, status, "OCILobTrim in post_execute_lobs");
+ }
+
+ }
+
+ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(
+ DBIc_LOGPIO(imp_sth),
+ " lob refetch %d for '%s' param: ftype %d, len %ld: %s %s\n",
+ i+1,fbh->name, fbh->dbtype, ul_t(amtp),
+ (rc==1405 ? "NULL" : (amtp > 0) ? "LobWrite" : "LobTrim"), oci_status_name(status));
+
+ if (status != OCI_SUCCESS) {
+ return oci_error(sth, errhp, status, "OCILobTrim/OCILobWrite/LOB refetch");
+ }
+ }
+
+ if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
+ dbd_db_commit(dbh, imp_dbh);
- return 1;
+ return 1;
}
void
ora_free_lob_refetch(SV *sth, imp_sth_t *imp_sth)
{
- lob_refetch_t *lr = imp_sth->lob_refetch;
- int i;
- sword status;
- OCIHandleFree_log_stat(lr->stmthp, OCI_HTYPE_STMT, status);
- if (status != OCI_SUCCESS)
- oci_error(sth, imp_sth->errhp, status, "ora_free_lob_refetch/OCIHandleFree");
- for(i=0; i < lr->num_fields; ++i) {
- imp_fbh_t *fbh = &lr->fbh_ary[i];
- ora_free_fbh_contents(fbh);
- }
- sv_free(lr->sql_select);
- sv_free(lr->fbh_ary_sv);
- Safefree(imp_sth->lob_refetch);
- imp_sth->lob_refetch = NULL;
+ dTHX;
+ lob_refetch_t *lr = imp_sth->lob_refetch;
+ int i;
+ sword status;
+ if (lr->rowid)
+ OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
+ OCIHandleFree_log_stat(imp_sth, lr->stmthp, OCI_HTYPE_STMT, status);
+
+ if (status != OCI_SUCCESS)
+ oci_error(sth, imp_sth->errhp, status, "ora_free_lob_refetch/OCIHandleFree");
+
+ for(i=0; i < lr->num_fields; ++i) {
+ imp_fbh_t *fbh = &lr->fbh_ary[i];
+ ora_free_fbh_contents(sth, fbh);
+ }
+ sv_free(lr->fbh_ary_sv);
+ Safefree(imp_sth->lob_refetch);
+ imp_sth->lob_refetch = NULL;
}
+ub4
+ora_db_version(SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ sword status;
+ text buf[2];
+ ub4 vernum;
+
+ if( imp_dbh->server_version > 0 ) {
+ return imp_dbh->server_version;
+ }
+
-#endif
+ /* XXX should possibly create new session before ending the old so */
+ /* that if the new one can't be created, the old will still work. */
+ OCIServerRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, buf, 2,OCI_HTYPE_SVCCTX, &vernum , status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionServerRelease");
+ return 0;
+ }
+ imp_dbh->server_version = vernum;
+ return vernum;
+}
@@ -1,14 +1,14 @@
-#ifdef OCI_V8_SYNTAX
+#ifndef DBD_OCI_TRACEON
/* OCI functions "wrapped" to produce tracefile dumps (may be handy when giving
- diagnostic info to Oracle Support, or just learning about OCI)
- Macros are named "_log" as a mnemonic that they log to the tracefile if needed
- Macros named "_log_stat" return status in last parameter.
+ diagnostic info to Oracle Support, or just learning about OCI)
+ Macros are named "_log" as a mnemonic that they log to the tracefile if needed
+ Macros named "_log_stat" return status in last parameter.
*/
-#define DBD_OCI_TRACEON (DBIS->debug >= 6)
-#define DBD_OCI_TRACEFP (DBILOGFP)
-#define OciTp ("OCI") /* OCI Trace Prefix */
+#define DBD_OCI_TRACEON(h) (DBIc_DBISTATE(h)->debug >= 6 || dbd_verbose >= 6)
+#define DBD_OCI_TRACEFP(h) (DBIc_LOGPIO(h))
+#define OciTp ("\tOCI") /* OCI Trace Prefix */
#define OciTstr(s) ((s) ? (text*)(s) : (text*)"<NULL>")
#define ul_t(v) ((unsigned long)(v))
#define pul_t(v) ((unsigned long *)(v))
@@ -17,247 +17,585 @@
/* XXX TO DO
- 1. Add parenthesis around all macro args. (or do item 4 below case-by-case)
- DMG: Partly done, sort of. At least the types all match the doc'd casts, anyway.
+ 1. Add parenthesis around all macro args. (or do item 4 below case-by-case)
+ DMG: Partly done, sort of. At least the types all match the doc'd casts, anyway.
- 2. #define a set of OciTxxx macros for different types of parameters
+ 2. #define a set of OciTxxx macros for different types of parameters
that would allow
a: casting to be hidden
b: casting easily changed on different platforms (64bit etc)
c: mapping of some type values to strings,
d: return pointed-to value instead of pointer where applicable
- How to output arguments that are handles to opaque entities (OCIEnv*, etc)?
- Output of pointer address is a quick n' dirty way of identifying
- any number of handles that may be allocated.... yuck...
- It sure would be nice to give something more mnemonic! (and meaningful!)
- XXX Turn pointers into variable names by adding a prefix letter and, where
+ How to output arguments that are handles to opaque entities (OCIEnv*, etc)?
+ Output of pointer address is a quick n' dirty way of identifying
+ any number of handles that may be allocated.... yuck...
+ It sure would be nice to give something more mnemonic! (and meaningful!)
+ XXX Turn pointers into variable names by adding a prefix letter and, where
appropriate an &, thus: "...,&p%ld,...",
If done well the log will read like a compilable program.
*/
+#define OCIServerRelease_log_stat(impdbh,sc,errhp,b,bl,ht,ver,stat) \
+ stat =OCIServerRelease(sc,errhp,b,bl,ht,ver);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIServerRelease(%p)=%s\n",\
+ OciTp, sc,oci_status_name(stat)),stat \
+ : stat
+
+#define OCISessionRelease_log_stat(impdbh,svchp, errhp,stat) \
+ stat =OCISessionRelease(svchp, errhp, NULL, (ub4)0, OCI_DEFAULT);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCISessionRelease(svchp=%p)=%s\n",\
+ OciTp, svchp,oci_status_name(stat)),stat \
+ : stat
+
+#define OCISessionPoolDestroy_log_stat(impdbh, ph, errhp,stat ) \
+ stat =OCISessionPoolDestroy(ph, errhp,OCI_DEFAULT);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCISessionPoolDestroy(ph=%p)=%s\n",\
+ OciTp, ph,oci_status_name(stat)),stat \
+ : stat
+#define OCISessionGet_log_stat(impdbh,envhp, errhp, sh, ah,pn,pnl,stat) \
+ stat =OCISessionGet(envhp, errhp, sh, ah,pn,pnl,NULL,0, NULL, NULL, NULL, OCI_SESSGET_SPOOL);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCISessionGet(envhp=%p,sh=%p,ah=%p,pn=%p,pnl=%d)=%s\n",\
+ OciTp, envhp,sh,ah,pn,pnl,oci_status_name(stat)),stat \
+ : stat
+
+#define OCISessionPoolCreate_log_stat(impdbh,envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,stat) \
+ stat =OCISessionPoolCreate(envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,OCI_DEFAULT);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCISessionPoolCreate(envhp=%p,ph=%p,pn=%p,pnl=%p,min=%d,max=%d,incr=%d, un=%s,unl=%d,pw=%s,pwl=%d)=%s\n",\
+ OciTp, envhp,ph,pn,pnl,sn,sm,si,un,unl,pw,pwl,oci_status_name(stat)),stat \
+ : stat
+
+#if defined(ORA_OCI_102)
+#define OCIPing_log_stat(impdbh,sc,errhp,stat) \
+ stat =OCIPing(sc,errhp,OCI_DEFAULT);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIPing(%p)=%s\n",\
+ OciTp, sc,oci_status_name(stat)),stat \
+ : stat
+#endif
+
+#define OCIServerVersion_log_stat(impdbh,sc,errhp,b,bl,ht,stat) \
+ stat =OCIServerVersion(sc,errhp,b,bl,ht);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIServerVersion_log_stat(%p,%s)=%s\n",\
+ OciTp, sc,b,oci_status_name(stat)),stat \
+ : stat
+
+#define OCIStmtGetPieceInfo_log_stat(impsth,stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece,stat) \
+ stat =OCIStmtGetPieceInfo(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIStmtGetPieceInfo_log_stat(%p,%p,%u)=%s\n",\
+ OciTp, (void*)errhp,fbh,*piece,oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIStmtSetPieceInfo_log_stat(impsth,ptr,errhp,buf,blen,p,indp,rc,stat) \
+ stat =OCIStmtSetPieceInfo(ptr,OCI_HTYPE_DEFINE,errhp, buf, blen, p,indp,rc);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIStmtSetPieceInfo_log_stat(%p,%p,%d,%p)=%s\n",\
+ OciTp, (void*)errhp,fbh,piece,blen,oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIDefineDynamic_log_stat(impsth,defnp,errhp,fbh,stat) \
+ stat =OCIDefineDynamic(defnp,errhp,fbh,(OCICallbackDefine) presist_lob_fetch_cbk );\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIDefineDynamic_log_stat(%p,%p,%p)=%s\n",\
+ OciTp, (void*)defnp, (void*)errhp,fbh,oci_status_name(stat)),stat \
+ : stat
+
+#define OCIXMLTypeCreateFromSrc_log_stat(impdbh,svchp,errhp,duration,src_type,src_ptr,ind,xml,stat) \
+ stat =OCIXMLTypeCreateFromSrc (svchp,errhp,duration,(ub1)src_type,(dvoid *)src_ptr,(sb4)ind, xml);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIXMLTypeCreateFromSrc_log_stat(%p,%p,%d,%d,%p,%d,%p)=%s\n",\
+ OciTp, (void*)svchp,(void*)errhp, duration, src_type, src_ptr, ind, xml, oci_status_name(stat)),stat \
+ : stat
+
+#define OCILobFileIsOpen_log_stat(impdbh,envhp,errhp,loc,is_open,stat) \
+ stat = OCILobFileIsOpen(envhp,errhp,loc,is_open);\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCILobFileIsOpen_log_stat(%p,%p,%p,%p,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp, loc, is_open, *is_open,oci_status_name(stat)),stat : stat
+
+#define OCILobLocatorIsInit_log_stat(impdbh,envhp,errhp,loc,is_initp,stat) \
+ stat =OCILobLocatorIsInit (envhp,errhp,loc,is_initp );\
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCILobLocatorIsInit_log_stat(%p,%p,%p,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,loc,*is_initp,oci_status_name(stat)),stat \
+ : stat
+
+#define OCIObjectPin_log_stat(impsth,envhp,errhp,or,ot,stat) \
+ stat = OCIObjectPin(envhp,errhp,or,(OCIComplexObject *)0,OCI_PIN_LATEST,OCI_DURATION_TRANS,OCI_LOCK_NONE,ot);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sObjectPin_log_stat(%p,%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,or,ot,oci_status_name(stat)),stat \
+ : stat
+
+/*
+#define OCICollGetElem_log_stat(envhp,errhp,v,i,ex,e,ne,stat)\
+ stat = OCICollGetElem(envhp,errhp, v,i,ex,e,ne);\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sOCICollGetElem_log_stat(%p,%p,%d,%d,%d,%d,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,v,i,ex,e,ne,oci_status_name(stat)),stat \
+ : stat
+*/
+/*
+#define OCITableFirst_log_stat(envhp,errhp,v,i,stat)\
+ stat = OCITableFirst(envhp,errhp,v,i);\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sOCITableFirst_log_stat(%p,%p,%d,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,v,i,oci_status_name(stat)),stat \
+ : stat
+*/
+#define OCIObjectGetAttr_log_stat(impsth,envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue, attrtdo, stat) \
+ stat = OCIObjectGetAttr(envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo); \
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIObjectGetAttr_log_stat(%p,%p,%p,%p,%p,%p,%p,%d,%p,%d,%p,%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp,(void*)errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo,oci_status_name(stat)),stat \
+ : stat
+
+
+
+#define OCIIntervalToText_log_stat(impsth,envhp,errhp,di,sb,ln,sl,stat) \
+ stat = OCIIntervalToText(envhp,errhp, *(OCIInterval**)di,3,3,sb,ln,sl);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIIntervalToText(%p,%p,%p,%s)=%s\n",\
+ OciTp, (void*)errhp, di,sl,sb,oci_status_name(stat)),stat \
+ : stat
+
+#define OCIDateTimeToText_log_stat(impsth,envhp,errhp,d,sl,sb,stat) \
+ stat = OCIDateTimeToText(envhp,errhp, *(OCIDateTime**)d,(CONST text*) 0,(ub1) 0,6, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIDateTimeToText(%p,%p,%p,%s)=%s\n",\
+ OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIDateToText_log_stat(impsth,errhp,d,sl,sb,stat) \
+ stat = OCIDateToText(errhp, (CONST OCIDate *) d,(CONST text*) 0,(ub1) 0, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sDateToText_log_stat(%p,%p,%p,%s)=%s\n",\
+ OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIIterDelete_log_stat(impsth,envhp,errhp,itr,stat) \
+ stat = OCIIterDelete(envhp,errhp,itr );\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIIterDelete_log_stat(%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,itr,oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIIterCreate_log_stat(impsth,envhp,errhp,coll,itr,stat) \
+ stat = OCIIterCreate(envhp,errhp,coll,itr);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sIterCreate_log_stat(%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,(void*)coll,oci_status_name(stat)),stat \
+ : stat
+/*
+#define OCICollSize_log_stat(envhp,errhp,coll,coll_siz,stat)\
+ stat = OCICollSize(envhp,errhp,(CONST OCIColl *)coll,coll_siz);\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sOCICollSize_log_stat(%p,%p,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp,oci_status_name(stat)),stat \
+ : stat
+*/
+#define OCIDefineObject_log_stat(impsth,defnp,errhp,tdo,eo_buff,eo_ind,stat) \
+ stat = OCIDefineObject(defnp,errhp,tdo,eo_buff,0,eo_ind, 0);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIDefineObject(%p,%p,%p)=%s\n",\
+ OciTp, (void*)defnp, (void*)errhp, (void*)tdo,oci_status_name(stat)),stat \
+ : stat
+
+#define OCITypeByName_log(impsth,envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo,stat) \
+ stat = OCITypeByName(envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo); \
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sTypeByName(%p,%p,%p,%s,%d,%s,%d,\"\",0,%d,%d,%p)=%s\n", \
+ OciTp, (void*)envhp, (void*)errhp, (void*)svchp, sn,snl,tn,tnl,duration,option,tdo,oci_status_name(stat)), stat \
+ :stat
+
+#define OCITypeByRef_log_stat(impsth,envhp,errhp,ref,tdo,stat) \
+ stat = OCITypeByRef(envhp,errhp,ref,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\
+ (DBD_OCI_TRACEON(impsth)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sTypeByRef(%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp, (void*)ref,oci_status_name(stat)),stat \
+ : stat
+
+/* added by lab */
+#define OCILobCharSetId_log_stat(impxxh, envhp, errhp, locp, csidp, stat ) \
+ stat = OCILobCharSetId( envhp, errhp, locp, csidp ); \
+ (DBD_OCI_TRACEON(impxxh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobCharSetId(%p,%p,%p,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp, (void*)locp, *csidp, oci_status_name(stat)),stat \
+ : stat
+
+/* added by lab */
+#define OCILobCharSetForm_log_stat(impxxh, envhp, errhp, locp, formp, stat ) \
+ stat = OCILobCharSetForm( envhp, errhp, locp, formp ); \
+ (DBD_OCI_TRACEON(impxxh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobCharSetForm(%p,%p,%p,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp, (void*)locp, *formp, oci_status_name(stat)),stat \
+ : stat
+
+/* added by lab */
+#define OCINlsEnvironmentVariableGet_log_stat(impdbh, valp, size, item, charset, rsizep ,stat ) \
+ stat = OCINlsEnvironmentVariableGet( valp, size, item, charset, rsizep ); \
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sNlsEnvironmentVariableGet(%d,%lu,%d,%d,%lu)=%s\n",\
+ OciTp, *valp, (unsigned long)size, item, charset, (unsigned long)*rsizep, oci_status_name(stat)),stat \
+ : stat
+
+/* added by lab */
+#define OCIEnvNlsCreate_log_stat(impdbh, envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ,stat ) \
+ stat = OCIEnvNlsCreate(envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ); \
+ (DBD_OCI_TRACEON(impdbh)) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sEnvNlsEnvCreate(%p,%s,%d,%d,%p,%p,%p,%d,%p,%d,%d)=%s\n", \
+ OciTp, (void*)envp, oci_mode(mode),mode, ctxp, (void*)f1, (void*)f2, (void*)f3, sz, (void*)usremepp ,chset, nchset, oci_status_name(stat)),stat \
+ : stat
+
+
+#define OCIAttrGet_log_stat(impxxh, th,ht,ah,sp,at,eh,stat) \
+ stat = OCIAttrGet(th,ht,ah,sp,at,eh); \
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \
+ OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_attr_name(at),(void*)eh,\
+ oci_status_name(stat)),stat : stat
-#define OCIAttrGet_log_stat(th,ht,ah,sp,at,eh,stat) \
+#define OCIAttrGet_d_log_stat(impsth, th,ht,ah,sp,at,eh,stat) \
stat = OCIAttrGet(th,ht,ah,sp,at,eh); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sAttrGet(%p,%s,%p,%p,%lu,%p)=%s\n", \
- OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),ul_t(at),(void*)eh,\
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \
+ OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_dtype_attr_name(at),(void*)eh,\
+ oci_status_name(stat)),stat : stat
+
+ #define OCIAttrGet_parmap(imp_sth,dh, ht, p1, l, stat) \
+ OCIAttrGet_log_stat(imp_sth, dh, ht, \
+ (void*)(p1), (l), OCI_ATTR_PARAM, imp_sth->errhp, stat)
+
+
+#define OCIAttrGet_parmdp(imp_sth, parmdp, p1, l, a, stat) \
+ OCIAttrGet_d_log_stat(imp_sth, parmdp, OCI_DTYPE_PARAM, \
+ (void*)(p1), (l), (a), imp_sth->errhp, stat)
-#define OCIAttrGet_parmdp(imp_sth, parmdp, p1, l, a, stat) \
- OCIAttrGet_log_stat(parmdp, OCI_DTYPE_PARAM, \
+#define OCIAttrGet_stmhp_stat(imp_sth, p1, l, a, stat) \
+ OCIAttrGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, \
(void*)(p1), (l), (a), imp_sth->errhp, stat)
-#define OCIAttrGet_stmhp_stat(imp_sth, p1, l, a, stat) \
- OCIAttrGet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, \
+#define OCIAttrGet_stmhp_stat2(imp_sth, stmhp, p1, l, a, stat) \
+ OCIAttrGet_log_stat(imp_sth, stmhp, OCI_HTYPE_STMT, \
(void*)(p1), (l), (a), imp_sth->errhp, stat)
-#define OCIAttrSet_log_stat(th,ht,ah,s1,a,eh,stat) \
+#define OCIAttrSet_log_stat(impxxh,th,ht,ah,s1,a,eh,stat) \
stat=OCIAttrSet(th,ht,ah,s1,a,eh); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sAttrSet(%p,%s,%p,%lu,%lu,%p)=%s\n", \
- OciTp, (void*)th,oci_hdtype_name(ht),(void*)(ah),ul_t(s1),ul_t(a),(void*)eh, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sAttrSet(%p,%s, %p,%lu,Attr=%s,%p)=%s\n", \
+ OciTp, (void*)th,oci_hdtype_name(ht),(void *)ah,ul_t(s1),oci_attr_name(a),(void*)eh, \
+ oci_status_name(stat)),stat : stat
-#define OCIBindByName_log_stat(sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md,stat) \
+#define OCIBindByName_log_stat(impsth,sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md,stat) \
stat=OCIBindByName(sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sBindByName(%p,%p,%p,\"%s\",%ld,%p,%ld,%u,%p,%p,%p,%lu,%p,%lu)=%s\n",\
- OciTp, (void*)sh,(void*)bp,(void*)eh,p1,sl_t(pl),(void*)(v), \
- sl_t(vs),(ub2)(dt),(void*)(in),(ub2*)(al),(ub2*)(rc), \
- ul_t((mx)),pul_t((cu)),ul_t((md)), \
- oci_status_name(stat)),stat : stat
-
-#define OCIBindDynamic_log(bh,eh,icx,cbi,ocx,cbo,stat) \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sBindByName(%p,%p,%p,\"%s\",placeh_len=%ld,value_p=%p,value_sz=%ld," \
+ "dty=%u,indp=%p,alenp=%p,rcodep=%p,maxarr_len=%lu,curelep=%p (*=%d),mode=%s,%lu)=%s\n",\
+ OciTp, (void*)sh,(void*)bp,(void*)eh,p1,sl_t(pl),(void*)(v), \
+ sl_t(vs),(ub2)(dt),(void*)(in),(ub2*)(al),(ub2*)(rc), \
+ ul_t((mx)),pul_t((cu)),(cu ? *(int*)cu : 0 ) ,oci_bind_options(md),ul_t((md)), \
+ oci_status_name(stat)),stat : stat
+
+#define OCIBindArrayOfStruct_log_stat(impsth,bp,ep,sd,si,sl,sr,stat) \
+ stat=OCIBindArrayOfStruct(bp,ep,sd,si,sl,sr); \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sOCIBindArrayOfStruct(%p,%p,%u,%u,%u,%u)=%s\n", \
+ OciTp,(void*)bp,(void*)ep,sd,si,sl,sr, \
+ oci_status_name(stat)),stat : stat
+
+#define OCIBindDynamic_log(impsth,bh,eh,icx,cbi,ocx,cbo,stat) \
stat=OCIBindDynamic(bh,eh,icx,cbi,ocx,cbo); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sBindDynamic(%p,%p,%p,%p,%p,%p)=%s\n", \
- OciTp, (void*)bh,(void*)eh,(void*)icx,(void*)cbi, \
- (void*)ocx,(void*)cbo, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sBindDynamic(%p,%p,%p,%p,%p,%p)=%s\n", \
+ OciTp, (void*)bh,(void*)eh,(void*)icx,(void*)cbi, \
+ (void*)ocx,(void*)cbo, \
+ oci_status_name(stat)),stat : stat
-#define OCIDefineByPos_log_stat(sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m,stat) \
+#define OCIDefineByPos_log_stat(impsth,sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m,stat) \
stat=OCIDefineByPos(sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sDefineByPos(%p,%p,%p,%lu,%p,%ld,%u,%p,%p,%p,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)dp,(void*)eh,ul_t((p1)),(void*)(vp), \
- sl_t(vs),(ub2)dt,(void*)(ip),(ub2*)(rp),(ub2*)(cp),ul_t(m), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sDefineByPos(%p,%p,%p,%lu,%p,%ld,%u,%p,%p,%p,mode=%s,%lu)=%s\n", \
+ OciTp, (void*)sh,(void*)dp,(void*)eh,ul_t((p1)),(void*)(vp), \
+ sl_t(vs),(ub2)dt,(void*)(ip),(ub2*)(rp),(ub2*)(cp),oci_define_options(m),ul_t(m), \
+ oci_status_name(stat)),stat : stat
-#define OCIDescribeAny_log_stat(sh,eh,op,ol,opt,il,ot,dh,stat) \
+#define OCIDescribeAny_log_stat(impsth,sh,eh,op,ol,opt,il,ot,dh,stat) \
stat=OCIDescribeAny(sh,eh,op,ol,opt,il,ot,dh); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sDescribeAny(%p,%p,%p,%lu,%u,%u,%u,%p)=%s\n", \
- OciTp, (void*)sh,(void*)eh,(void*)op,ul_t(ol), \
- (ub1)opt,(ub1)il,(ub1)ot,(void*)dh, \
- oci_status_name(stat)),stat : stat
-
-#define OCIDescriptorAlloc_ok(envhp, p1, t) \
- if (DBD_OCI_TRACEON) PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sDescriptorAlloc(%p,%p,%s,0,0)\n", \
- OciTp,(void*)envhp,(void*)(p1),oci_hdtype_name(t)); \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sDescribeAny(%p,%p,%p,%lu,%u,%u,%u,%p)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,(void*)op,ul_t(ol), \
+ (ub1)opt,(ub1)il,(ub1)ot,(void*)dh, \
+ oci_status_name(stat)),stat : stat
+
+#define OCIDescriptorAlloc_ok(impxxh,envhp, p1, t) \
+ if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sDescriptorAlloc(%p,%p,%s,0,0)\n", \
+ OciTp,(void*)envhp,(void*)(p1),oci_hdtype_name(t)); \
if (OCIDescriptorAlloc((envhp), (void**)(p1), (t), 0, 0)==OCI_SUCCESS); \
- else croak("OCIDescriptorAlloc (type %ld) failed",t)
+ else croak("OCIDescriptorAlloc (type %d) failed",t)
-#define OCIDescriptorFree_log(d,t) \
- if (DBD_OCI_TRACEON) PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sDescriptorFree(%p,%s)\n", OciTp, (void*)d,oci_hdtype_name(t)); \
+#define OCIDescriptorFree_log(impxxh,d,t) \
+ if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sDescriptorFree(%p,%s)\n", OciTp, (void*)d,oci_hdtype_name(t)); \
OCIDescriptorFree(d,t)
-#define OCIEnvInit_log_stat(ev,md,xm,um,stat) \
+#define OCIEnvInit_log_stat(impdbh,ev,md,xm,um,stat) \
stat=OCIEnvInit(ev,md,xm,um); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sEnvInit(%p,%lu,%lu,%p)=%s\n", \
- OciTp, (void*)ev,ul_t(md),ul_t(xm),(void*)um, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sEnvInit(%p,%lu,%lu,%p)=%s\n", \
+ OciTp, (void*)ev,ul_t(md),ul_t(xm),(void*)um, \
+ oci_status_name(stat)),stat : stat
-#define OCIErrorGet_log_stat(hp,rn,ss,ep,bp,bs,t, stat) \
+#define OCIErrorGet_log_stat(impxxh, hp,rn,ss,ep,bp,bs,t, stat) \
((stat = OCIErrorGet(hp,rn,ss,ep,bp,bs,t)), \
- ((DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sErrorGet(%p,%lu,\"%s\",%p,\"%s\",%lu,%lu)=%s\n", \
- OciTp, (void*)hp,ul_t(rn),OciTstr(ss),psl_t(ep), \
- bp,ul_t(bs),ul_t(t), oci_status_name(stat)),stat : stat))
+ ((DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sErrorGet(%p,%lu,\"%s\",%p,\"%s\",%lu,%lu)=%s\n", \
+ OciTp, (void*)hp,ul_t(rn),OciTstr(ss),psl_t(ep), \
+ bp,ul_t(bs),ul_t(t), oci_status_name(stat)),stat : stat))
-#define OCIHandleAlloc_log_stat(ph,hp,t,xs,ump,stat) \
+#define OCIHandleAlloc_log_stat(impxxh,ph,hp,t,xs,ump,stat) \
stat=OCIHandleAlloc(ph,hp,t,xs,ump); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sHandleAlloc(%p,%p,%s,%lu,%p)=%s\n", \
- OciTp, (void*)ph,(void*)hp,oci_hdtype_name(t),ul_t(xs),(void*)ump, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sHandleAlloc(%p,%p,%s,%lu,%p)=%s\n", \
+ OciTp, (void*)ph,(void*)hp,oci_hdtype_name(t),ul_t(xs),(void*)ump, \
+ oci_status_name(stat)),stat : stat
-#define OCIHandleAlloc_ok(envhp, p1, t, stat) \
- OCIHandleAlloc_log_stat((envhp),(void**)(p1),(t),0,0, stat); \
+#define OCIHandleAlloc_ok(impxxh,envhp, p1, t, stat) \
+ OCIHandleAlloc_log_stat(impxxh,(envhp),(void**)(p1),(t),0,0, stat); \
if (stat==OCI_SUCCESS) ; \
else croak("OCIHandleAlloc(%s) failed",oci_hdtype_name(t))
-#define OCIHandleFree_log_stat(hp,t,stat) \
- stat=OCIHandleFree( (hp), (t)); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sHandleFree(%p,%s)=%s\n",OciTp,(void*)hp,oci_hdtype_name(t), \
- oci_status_name(stat)),stat : stat
-
-#define OCIInitialize_log_stat(md,cp,mlf,rlf,mfp,stat) \
- stat=OCIInitialize(md,cp,mlf,rlf,mfp); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sInitialize(%lu,%p,%p,%p,%p)=%s\n", \
- OciTp, ul_t(md),(void*)cp,(void*)mlf,(void*)rlf,(void*)mfp, \
- oci_status_name(stat)),stat : stat
+#define OCIHandleFree_log_stat(impxxh,hp,t,stat) \
+ stat=OCIHandleFree( (hp), (t)); \
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sHandleFree(%p,%s)=%s\n",OciTp,(void*)hp,oci_hdtype_name(t), \
+ oci_status_name(stat)),stat : stat
-#define OCILobGetLength_log_stat(sh,eh,lh,l,stat) \
+#define OCILobGetLength_log_stat(impxxh,sh,eh,lh,l,stat) \
stat=OCILobGetLength(sh,eh,lh,l); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobGetLength(%p,%p,%p,%p)=%s\n", \
- OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(l), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobGetLength(%p,%p,%p,%p)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(l), \
+ oci_status_name(stat)),stat : stat
+
+
+#define OCILobGetChunkSize_log_stat(impdbh,sh,eh,lh,cs,stat) \
+ stat=OCILobGetChunkSize(sh,eh,lh,cs); \
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sLobGetChunkSize(%p,%p,%p,%p)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(cs), \
+ oci_status_name(stat)),stat : stat
-#define OCILobFileOpen_log_stat(sv,eh,lh,mode,stat) \
+
+#define OCILobFileOpen_log_stat(impxxh,sv,eh,lh,mode,stat) \
stat=OCILobFileOpen(sv,eh,lh,mode); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobFileOpen(%p,%p,%p,%u)=%s\n", \
- OciTp, (void*)sv,(void*)eh,(void*)lh,(ub1)mode, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobFileOpen(%p,%p,%p,%u)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh,(ub1)mode, \
+ oci_status_name(stat)),stat : stat
-#define OCILobFileClose_log_stat(sv,eh,lh,stat) \
+#define OCILobFileClose_log_stat(impsth,sv,eh,lh,stat) \
stat=OCILobFileClose(sv,eh,lh); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobFileClose(%p,%p,%p)=%s\n", \
- OciTp, (void*)sv,(void*)eh,(void*)lh, \
- oci_status_name(stat)),stat : stat
-
-#define OCILobRead_log_stat(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sLobFileClose(%p,%p,%p)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh, \
+ oci_status_name(stat)),stat : stat
+/*Added by JPS for Jeffrey.Klein*/
+
+#define OCILobCreateTemporary_log_stat(impdbh,sv,eh,lh,csi,csf,lt,ca,dur,stat) \
+ stat=OCILobCreateTemporary(sv,eh,lh,csi,csf,lt,ca,dur); \
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sLobCreateTemporary(%p,%p,%p,%lu,%lu,%lu,%lu,%lu)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh, \
+ ul_t(csi),ul_t(csf),ul_t(lt),ul_t(ca),ul_t(dur), \
+ oci_status_name(stat)),stat : stat
+/*end add*/
+
+#define OCILobFreeTemporary_log_stat(impxxh,sv,eh,lh,stat) \
+ stat=OCILobFreeTemporary(sv,eh,lh); \
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobFreeTemporary(%p,%p,%p)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh, \
+ oci_status_name(stat)),stat : stat
+
+#define OCILobIsTemporary_log_stat(impsth,ev,eh,lh,istemp,stat) \
+ stat=OCILobIsTemporary(ev,eh,lh,istemp); \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sLobIsTemporary(%p,%p,%p,%p)=%s\n", \
+ OciTp, (void*)ev,(void*)eh,(void*)lh,(void*)istemp, \
+ oci_status_name(stat)),stat : stat
+
+/*Added by JPS for Jeffrey.Klein */
+
+#define OCILobLocatorAssign_log_stat(impdbh,sv,eh,src,dest,stat) \
+ stat=OCILobLocatorAssign(sv,eh,src,dest); \
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sLobLocatorAssign(%p,%p,%p,%p)=%s\n", \
+ OciTp,(void*)sv,(void*)eh,(void*)src,(void*)dest, \
+ oci_status_name(stat)),stat : stat
+
+/*end add*/
+
+#define OCILobRead_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \
stat=OCILobRead(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobRead(%p,%p,%p,%p,%lu,%p,%lu,%p,%p,%u,%u)=%s\n", \
- OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
- (void*)bp,ul_t(bl),(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobRead(%p,%p,%p,%p,%lu,%p,%lu,%p,%p,%u,%u)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
+ (void*)bp,ul_t(bl),(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
+ oci_status_name(stat)),stat : stat
-#define OCILobTrim_log_stat(sv,eh,lh,l,stat) \
+#define OCILobTrim_log_stat(impxxh,sv,eh,lh,l,stat) \
stat=OCILobTrim(sv,eh,lh,l); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobTrim(%p,%p,%p,%lu)=%s\n", \
- OciTp, (void*)sv,(void*)eh,(void*)lh,ul_t(l), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobTrim(%p,%p,%p,%lu)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh,ul_t(l), \
+ oci_status_name(stat)),stat : stat
-#define OCILobWrite_log_stat(sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf,stat) \
+#define OCILobWrite_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf,stat) \
stat=OCILobWrite(sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sLobWrite(%p,%p,%p,%p,%lu,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \
- OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
- (void*)bp,ul_t(bl),(ub1)p1, \
- (void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
- oci_status_name(stat)),stat : stat
-
-#define OCIParamGet_log_stat(hp,ht,eh,pp,ps,stat) \
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobWrite(%p,%p,%p,%p,%lu,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
+ (void*)bp,ul_t(bl),(ub1)p1, \
+ (void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
+ oci_status_name(stat)),stat : stat
+
+#define OCILobWriteAppend_log_stat(impxxh,sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf,stat) \
+ stat=OCILobWriteAppend(sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf); \
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sLobWriteAppend(%p,%p,%p,%p,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \
+ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am), \
+ (void*)bp,ul_t(bl),(ub1)p1, \
+ (void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
+ oci_status_name(stat)),stat : stat
+
+#define OCIParamGet_log_stat(impsth,hp,ht,eh,pp,ps,stat) \
stat=OCIParamGet(hp,ht,eh,pp,ps); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sParamGet(%p,%lu,%p,%p,%lu)=%s\n", \
- OciTp, (void*)hp,ul_t((ht)),(void*)eh,(void*)pp,ul_t(ps), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sParamGet(%p,%lu,%p,%p,%lu,%s)=%s\n", \
+ OciTp, (void*)hp,ul_t((ht)),(void*)eh,(void*)pp,ul_t(ps), \
+ oci_hdtype_name(ht),oci_status_name(stat)),stat : stat
-#define OCIServerAttach_log_stat(imp_dbh, dbname,stat) \
+#define OCIServerAttach_log_stat(imp_dbh, dbname,md,stat) \
stat=OCIServerAttach( imp_dbh->srvhp, imp_dbh->errhp, \
- (text*)dbname, (sb4)strlen(dbname), 0); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sServerAttach(%p, %p, \"%s\", %d, 0)=%s\n", \
- OciTp, (void*)imp_dbh->srvhp,(void*)imp_dbh->errhp, dbname, \
- strlen(dbname), oci_status_name(stat)),stat : stat
+ (text*)dbname, (sb4)strlen(dbname), md); \
+ (DBD_OCI_TRACEON(imp_dbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(imp_dbh), \
+ "%sServerAttach(%p, %p, \"%s\", %lu, mode=%s,%lu)=%s\n", \
+ OciTp, (void*)imp_dbh->srvhp,(void*)imp_dbh->errhp, dbname, \
+ ul_t(strlen(dbname)), oci_mode(md),ul_t(md),oci_status_name(stat)),stat : stat
-#define OCIStmtExecute_log_stat(sv,st,eh,i,ro,si,so,md,stat) \
+#define OCIStmtExecute_log_stat(impsth,sv,st,eh,i,ro,si,so,md,stat) \
stat=OCIStmtExecute(sv,st,eh,i,ro,si,so,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sStmtExecute(%p,%p,%p,%lu,%lu,%p,%p,%lu)=%s\n", \
- OciTp, (void*)sv,(void*)st,(void*)eh,ul_t((i)), \
- ul_t((ro)),(void*)(si),(void*)(so),ul_t((md)), \
- oci_status_name(stat)),stat : stat
-
-#define OCIStmtFetch_log_stat(sh,eh,nr,or,md,stat) \
- stat=OCIStmtFetch(sh,eh,nr,or,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sStmtFetch(%p,%p,%lu,%u,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,ul_t(md), \
- oci_status_name(stat)),stat : stat
-
-#define OCIStmtPrepare_log_stat(sh,eh,s1,sl,l,m,stat) \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sStmtExecute(%p,%p,%p,%lu,%lu,%p,%p,mode=%s,%lu)=%s\n", \
+ OciTp, (void*)sv,(void*)st,(void*)eh,ul_t((i)), \
+ ul_t((ro)),(void*)(si),(void*)(so),oci_exe_mode(md),ul_t((md)), \
+ oci_status_name(stat)),stat : stat
+
+#define OCIStmtFetch_log_stat(impsth,sh,eh,nr,or,os,stat) \
+ stat=OCIStmtFetch2(sh,eh,nr,or,os,OCI_DEFAULT); \
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sStmtFetch(%p,%p,%lu,%u,%d)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,(ub2)os, \
+ oci_status_name(stat)),stat : stat
+
+#define OCIStmtPrepare_log_stat(impsth,sh,eh,s1,sl,l,m,stat) \
stat=OCIStmtPrepare(sh,eh,s1,sl,l,m); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sStmtPrepare(%p,%p,'%s',%lu,%lu,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,s1,ul_t(sl),ul_t(l),ul_t(m), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
+ "%sStmtPrepare(%p,%p,'%s',%lu,%lu,%lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,s1,ul_t(sl),ul_t(l),ul_t(m), \
+ oci_status_name(stat)),stat : stat
-#define OCIServerDetach_log_stat(sh,eh,md,stat) \
+#define OCIServerDetach_log_stat(impdbh,sh,eh,md,stat) \
stat=OCIServerDetach(sh,eh,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sServerDetach(%p,%p,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,ul_t(md), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sServerDetach(%p,%p,mode=%s,%lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \
+ oci_status_name(stat)),stat : stat
-#define OCISessionBegin_log_stat(sh,eh,uh,cr,md,stat) \
+#define OCISessionBegin_log_stat(impdbh,sh,eh,uh,cr,md,stat) \
stat=OCISessionBegin(sh,eh,uh,cr,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sSessionBegin(%p,%p,%p,%lu,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,(void*)uh,ul_t(cr),ul_t(md), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sSessionBegin(%p,%p,%p,%lu,mode=%s %lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,(void*)uh,ul_t(cr),oci_mode(md),ul_t(md), \
+ oci_status_name(stat)),stat : stat
-#define OCISessionEnd_log_stat(sh,eh,ah,md,stat) \
+#define OCISessionEnd_log_stat(impdbh,sh,eh,ah,md,stat) \
stat=OCISessionEnd(sh,eh,ah,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sSessionEnd(%p,%p,%p,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,(void*)ah,ul_t(md), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sSessionEnd(%p,%p,%p,mode=%s %lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,(void*)ah,oci_mode(md),ul_t(md), \
+ oci_status_name(stat)),stat : stat
-#define OCITransCommit_log_stat(sh,eh,md,stat) \
+#define OCITransCommit_log_stat(impxxh,sh,eh,md,stat) \
stat=OCITransCommit(sh,eh,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sTransCommit(%p,%p,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,ul_t(md), \
- oci_status_name(stat)),stat : stat
+ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
+ "%sTransCommit(%p,%p,%lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,ul_t(md), \
+ oci_status_name(stat)),stat : stat
-#define OCITransRollback_log_stat(sh,eh,md,stat) \
+#define OCITransRollback_log_stat(impdbh,sh,eh,md,stat) \
stat=OCITransRollback(sh,eh,md); \
- (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
- "%sTransRollback(%p,%p,%lu)=%s\n", \
- OciTp, (void*)sh,(void*)eh,ul_t(md), \
- oci_status_name(stat)),stat : stat
-
-#endif /* OCI_V8_SYNTAX */
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sTransRollback(%p,%p,mode=%s %lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \
+ oci_status_name(stat)),stat : stat
+
+#define OCIDBStartup_log_stat(impdbh,svchp,errhp,admhp,mode,flags,stat) \
+ stat=OCIDBStartup(svchp,errhp,admhp,mode,flags); \
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIDBStartup(%p,%p,%p,%u,%u)=%s\n", \
+ OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode,flags, \
+ oci_status_name(stat)),stat : stat
+
+#define OCIDBShutdown_log_stat(impdbh,svchp,errhp,admhp,mode,stat) \
+ stat=OCIDBShutdown(svchp,errhp,admhp,mode); \
+ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
+ "%sOCIDBShutdown(%p,%p,%p,%u)=%s\n", \
+ OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode, \
+ oci_status_name(stat)),stat : stat
+
+
+#endif /* !DBD_OCI_TRACEON */
@@ -1,1812 +0,0 @@
-# -*- perl -*-
-
-use strict;
-
-my $script = <<'SCRIPT';
-~startperl~ -w
-
-################################################################################
-# Copyright (c) 1999 Alan Burlison
-#
-# You may distribute under the terms of either the GNU General Public License
-# or the Artistic License, as specified in the Perl README file, with the
-# exception that it cannot be placed on a CD-ROM or similar media for commercial
-# distribution without the prior approval of the author.
-#
-# This code is provided with no warranty of any kind, and is used entirely at
-# your own risk.
-#
-# This code was written by the author as a private individual, and is in no way
-# endorsed or warrantied by Sun Microsystems.
-#
-# Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
-#
-################################################################################
-
-use strict;
-use File::Basename;
-use DBI;
-use Tk;
-use Tk::Balloon;
-use Tk::ErrorDialog;
-use Tk::ROText;
-
-################################################################################
-# Subclassed version of Tk::Tree that allows button3 to have a callback attached
-
-package Tk::B3Tree;
-use strict;
-use base qw(Tk::Tree);
-Construct Tk::Widget qw(B3Tree);
-
-sub ClassInit
-{
-my ($class, $mw) = @_;
-$class->SUPER::ClassInit($mw);
-$mw->bind($class, "<3>", "Button3");
-return $class;
-}
-
-sub Populate
-{
-my ($self, $args) = @_;
-$self->SUPER::Populate($args);
-$self->ConfigSpecs(-b3command => [ "CALLBACK", "b3command", "B3command",
- undef ]);
-}
-
-sub Button3
-{
-my $w = shift;
-my $Ev = $w->XEvent;
-my $ent = $w->GetNearest($Ev->y);
-return unless (defined($ent) and length($ent));
-$w->Callback(-b3command => $ent);
-}
-
-################################################################################
-
-package main;
-use vars qw($VERSION);
-$VERSION = "1.1";
-
-# Globals
-# $ProgName Program name (without pathname)
-# $Db Database handle
-# $DbName Oracle database name
-# $User Oracle user name
-# $Schema Oracle schema name
-# $SqlMarker String used to identify SQL generated by explain
-# $OracleVersion Oracle version number
-# $CharWidth Width of a character in pixels
-# $Plan Current query plan as a Perl data structure
-# $LoginDialog Login dialog
-# $SchemaDialog Schema dialog
-# $SaveDialog Save File dialog
-# $OpenDialog Open File dialog
-# $FileDir Current file save/open directory
-# $PlanMain Query plan main window
-# $PlanTitle Title of query plan main window
-# $PlanTree Tree used to display the query plan
-# $PlanStep ROText used to display the selected plan step details
-# $PlanSql Text used to allow SQL editing
-# $Balloon For balloon help
-# $GrabMain SQL cache grab main window
-# $GrabStatus Text label used for feedback/status info
-# $GrabSelection Tag of currently selected SQL statement in the SQL cache
-# $GrabSql ROText used to hold the contents of the SQL cache
-# $GrabDetails ROText used to display the selected statement details
-use vars qw($ProgName $Db $DbName $User $Schema $SqlMarker $OracleVersion
- $CharWidth $Plan $LoginDialog $SchemaDialog $OpenDialog $SaveDialog
- $FileDir $PlanMain $PlanTitle $PlanTree $PlanStep $PlanSql $Balloon
- $GrabMain $GrabStatus $GrabSelection $GrabSql $GrabDetails);
-$SqlMarker = "/* This statement was generated by explain */";
-
-################################################################################
-# Switch the hourglass on or off
-
-sub busy($)
-{
-my ($state) = @_;
-if ($state && $PlanMain->grabCurrent()) { $PlanMain->Busy(-recurse => 1); }
-else { $PlanMain->Unbusy(1); }
-}
-
-################################################################################
-# Display an error message in a dialog
-
-sub error($@)
-{
-my ($parent, @lines) = @_;
-
-my ($msg, $height, $width);
-$msg = join("\n", @lines);
-$msg =~ s/\n$//;
-$msg =~ s/ \(DBD:/\n(DBD:/;
-$msg =~ s/(indicator at char \d+ in) /$1\n/;
-@lines = split("\n", $msg);
-$height = @lines;
-$width = 0;
-foreach my $line (@lines)
- { my $l = length($line); $width = $l if ($l > $width); }
-$width = 80 if ($width > 80);
-$height = 4 if ($height < 4);
-$height = 10 if ($height > 10);
-
-busy(0);
-my $dialog = $PlanMain->Toplevel(-title => "Error");
-$dialog->withdraw();
-my $text = $dialog->Scrolled("ROText", -height => $height, -width => $width,
- -borderwidth => 3, -relief => "raised",
- -wrap => "word", -scrollbars => "oe")
- ->pack(-padx => 6, -pady => 6, -expand => 1, -fill => "both");
-$text->insert("1.0", $msg);
-
-my $ok_cb = sub { $dialog->destroy() };
-$dialog->Button(-text => "OK", -default => "active", -command => $ok_cb)
- ->pack(-padx => 6, -pady => 6);
-$dialog->bind("<KeyPress-Return>", $ok_cb);
-$dialog->Popup;
-}
-
-################################################################################
-
-sub about($;$)
-{
-my ($parent, $win) = @_;
-my $msg = <<EOM;
-
- $ProgName version $VERSION
- Copyright (c) 1998 Alan Burlison
- Alan.Burlison\@uk.sun.com
-
- You may distribute under the terms of either the GNU General Public License
- or the Artistic License, as specified in the Perl README file, with the
- exception that it cannot be placed on a CD-ROM or similar media for commercial
- distribution without the prior approval of the author.
-
- This code is provided with no warranty of any kind, and is used entirely at
- your own risk.
-
- This code was written by the author as a private individual, and is in no way
- endorsed or warrantied by Sun Microsystems.
-
-EOM
-
-my $dialog;
-$dialog = $parent->Toplevel(-title => "About $ProgName");
-$dialog->withdraw();
-$dialog->resizable(0, 0);
-my $text = $dialog->Text(-borderwidth => 3, -width => 80, -height => 16,
- -relief => "raised")
- ->pack(-padx => 6, -pady => 6);
-$text->insert("1.0", $msg);
-my $cb;
-if ($win)
- {
- $$win = $dialog;
- $cb = sub { $dialog->destroy(); undef($$win); };
- }
-else
- {
- $cb = sub { $dialog->destroy(); };
- }
-$dialog->Button(-text => "OK", -command => $cb)->pack(-padx => 6, -pady => 6);
-$dialog->Popup();
-return($dialog);
-}
-
-################################################################################
-
-sub update_title()
-{
-$PlanMain->configure(-title =>
- $User
- ? $User eq $Schema
- ? "$ProgName - connected to $DbName as $User"
- : "$ProgName - connected to $DbName as $User [schema $Schema]"
- : "$ProgName - not connected"
- );
-}
-
-################################################################################
-
-sub help($)
-{
-my ($parent) = @_;
-require Tk::Pod;
-$parent->Pod(-file => $0, -scrollbars => "e");
-}
-
-################################################################################
-# Login to the database. The new database handle is put into $Db, and the
-# Oracle version number is put into $OracleVersion
-
-sub login($$$)
-{
-my ($database, $username, $password) = @_;
-
-busy(1);
-# Close any existing handle
-if ($Db)
- {
- $Db->disconnect();
- $Db = undef;
- $DbName = $User = $Schema = undef;
- update_title();
- }
-
-# Connect and initialise
-$Db = DBI->connect("dbi:Oracle:$database", $username, $password,
- { AutoCommit => 0, PrintError => 0})
- || die("Can't login to Oracle:\n$DBI::errstr\n");
-$Db->{LongReadLen} = 4096;
-$Db->{LongTruncOk} = 1;
-
-# Get the user name and check the Oracle version
-my $qry = $Db->prepare(qq(
- $SqlMarker select user, version from product_component_version
- where lower(product) like '%oracle%'
-));
-if (! $qry->execute())
- {
- my $err = $DBI::errstr;
- $qry->finish();
- $Db->disconnect();
- $Db = undef;
- die("Can't fetch Oracle version:\n$err\n");
- }
-($User, $OracleVersion) = $qry->fetchrow_array();
-$qry->finish();
-$DbName = $database || $ENV{TWO_TASK} || $ENV{ORACLE_SID};
-$Schema = $User;
-
-# Check there is a plan_table for this user
-$qry = $Db->prepare(qq(
- $SqlMarker select 1 from user_tables where table_name = 'PLAN_TABLE'
-));
-$qry->execute();
-if (! $qry->fetchrow_arrayref())
- {
- $qry->finish();
- $Db->disconnect();
- $Db = undef;
- die("User $User does not have a PLAN_TABLE.\n",
- "Run the script utlxplan.sql to create one.\n");
- }
-
-busy(0);
-return(1);
-}
-
-################################################################################
-# Clear the plan tree & details windows
-
-sub clear_plan()
-{
-$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
-$PlanTree->delete("all") if ($PlanTree);
-$PlanStep->delete("1.0", "end") if ($PlanStep);
-}
-
-################################################################################
-# Clear the SQL editor pane
-
-sub clear_editor()
-{
-$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
-$PlanTree->delete("all") if ($PlanTree);
-$PlanStep->delete("1.0", "end") if ($PlanStep);
-$PlanSql->delete("1.0", "end");
-}
-
-################################################################################
-# Display the structure of an index
-
-sub disp_index($$)
-{
-my ($owner, $index) = @_;
-
-# Create the index definition frame
-busy(1);
-my $dialog = $PlanMain->Toplevel(-title => "Index");
-$dialog->withdraw();
-$dialog->resizable(0, 0);
-my $index_fr = $dialog->Frame(-borderwidth => 3, -relief => "raised");
-$index_fr->Label(-text => "$owner.$index", -relief => "ridge",
- -borderwidth => 1)
- ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we",
- -ipadx => 3);
-$index_fr->Label(-text => "Table", -relief => "ridge", -borderwidth => 1)
- ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
-$index_fr->Label(-text => "Column", -relief => "ridge", -borderwidth => 1)
- ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
-
-# Show the table columns the index is built upon
-my $qry = $Db->prepare(qq(
- $SqlMarker select table_owner, table_name, column_name
- from all_ind_columns
- where index_owner = :1 and index_name = :2
- order by column_position
-));
-$qry->execute($owner, $index) || die("Index columns:\n$DBI::errstr\n");
-
-# For each column in the index, display its details
-my ($tab_txt, $col_txt);
-while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array()))
- {
- $tab_txt .= "$tab_owner.$table\n";
- $col_txt .= "$column\n";
- }
-$qry->finish();
-chop($tab_txt, $col_txt);
-$index_fr->Label(-text => $tab_txt, -relief => "ridge", -borderwidth => 1,
- -justify => "left")
- ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
-$index_fr->Label(-text => $col_txt, -relief => "ridge", -borderwidth => 1,
- -justify => "left")
- ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
-$index_fr->pack(-side => "top", -fill => "x");
-
-# Pack the grid and add the close button
-$dialog->Button(-text => "Close", -command => sub { $dialog->destroy(); })
- ->pack(-padx => 6, -pady => 6);
-
-$dialog->Popup();
-busy(0);
-return(1);
-}
-
-################################################################################
-# Callback for adding/removing index definitions to a table dialog
-
-sub disp_table_cb($$$$$)
-{
-my ($owner, $table, $num_cols, $index_fr, $index_bn) = @_;
-
-# If this is the first time through, fetch the index definitions
-busy(1);
-if (! $index_fr->children())
- {
- # This will retrieve the names & owners of all the indexes on the table
- my $qry = $Db->prepare(qq(
- $SqlMarker select owner, index_name
- from all_indexes
- where table_owner = :1 and table_name = :2
- order by owner, index_name
- ));
-
- # Build up a list of all the indexes
- $qry->execute($owner, $table) || die("Table indexes:\n$DBI::errstr\n");
- my (@indexes, $ind_owner, $ind_name);
- while (($ind_owner, $ind_name) = $qry->fetchrow_array())
- { push(@indexes, { owner => $ind_owner, name => $ind_name }); }
- $qry->finish();
-
- # Special for no indexes
- if (@indexes == 0)
- {
- $index_fr->Label(-text => "No\nindexes\ndefined", -relief => "ridge",
- -borderwidth => 1)->pack(-ipadx => 3, -ipady => 4);
- }
- else
- {
- # Do the header label
- $index_fr->Label(-text => "Index\norder", -relief => "ridge",
- -borderwidth => 1)
- ->grid(-column => 0, -row => 0, -sticky => "we", -ipadx => 3,
- -ipady => 2, -columnspan => scalar(@indexes), -rowspan => 2);
-
- # This will retrieve (table column id, index position) for an index
- $qry = $Db->prepare(qq(
- $SqlMarker select atc.column_id, aic.column_position
- from all_tab_columns atc, all_ind_columns aic
- where aic.index_owner = :1 and aic.index_name = :2
- and atc.owner = aic.table_owner and atc.table_name = aic.table_name
- and atc.column_name = aic.column_name
- order by aic.index_name, atc.column_id
- ));
-
- # For each index, add a label describing the index
- my $cb = sub { disp_index($_[1], $_[2]); };
- my $grid_col = 0;
- foreach my $index (@indexes)
- {
- ($ind_owner, $ind_name) = @{$index}{qw(owner name)};
- $qry->execute($ind_owner, $ind_name)
- || die("Index columns:\n$DBI::errstr\n");
- my $index_txt;
- my $col = 1;
- while (my ($col_id, $col_pos) = $qry->fetchrow_array())
- {
- $index_txt .= "\n" x ($col_id - $col) . "$col_pos\n";
- $col = $col_id + 1;
- }
- $index_txt .= "\n" x ($num_cols - ($col - 1));
- chop($index_txt);
- my $label = $index_fr->Label(-text => $index_txt, -relief => "ridge",
- -borderwidth => 1, -justify => "left")
- ->grid(-column => $grid_col, -row => 2, -sticky => "w",
- -ipadx => 3);
- $label->bind("<1>", [ $cb, $ind_owner, $ind_name ]);
- $Balloon->attach($label, -msg => "$ind_owner.$ind_name",
- -balloonposition => "mouse");
- $grid_col++;
- }
- }
- }
-if ($index_bn->cget(-text) eq "Indexes")
- {
- $index_bn->configure(-text => "Hide Indexes");
- $index_fr->pack(-side => "right", -expand => 1);
- }
-else
- {
- $index_bn->configure(-text => "Indexes");
- $index_fr->packForget();
- }
-busy(0);
-return(1);
-}
-
-################################################################################
-# Display a popup dialog showing the structure of a table
-
-sub disp_table($$)
-{
-my ($owner, $table) = @_;
-
-# Create the dialog for displaying the object details
-busy(1);
-my $dialog = $PlanMain->Toplevel(-title => "Table");
-$dialog->withdraw();
-$dialog->resizable(0, 0);
-
-# Create the table definition frame
-my $box1 = $dialog->Frame(-borderwidth => 3, -relief => "raised");
-my $box2 = $box1->Frame(-borderwidth => 0);
-my $table_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
-$table_fr->Label(-text => "$owner.$table",
- -relief => "ridge", -borderwidth => 1)
- ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");
-$table_fr->Label(-text => "Name", -relief => "ridge", -borderwidth => 1)
- ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
-$table_fr->Label(-text => "Type", -relief => "ridge", -borderwidth => 1)
- ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
-
-# This will get the table description
-my $qry = $Db->prepare(qq(
- $SqlMarker select column_name, data_type, data_length,
- data_precision, data_scale
- from all_tab_columns
- where owner = :1 and table_name = :2
- order by column_id
- ));
-$qry->execute($owner, $table)
- || die("Table columns:\n$DBI::errstr\n");
-
-my ($num_cols, $name_txt, $type_txt);
-while ((my ($name, $type, $length, $precision, $scale)
- = $qry->fetchrow_array()))
- {
- if ($precision)
- {
- $type .= "($precision";
- $type .= ",$scale" if ($scale);
- $type .= ")";
- }
- elsif ($type =~ /CHAR/)
- {
- $type .= "($length)";
- }
- $name_txt .= "$name\n";
- $type_txt .= "$type\n";
- $num_cols++;
- }
-$qry->finish();
-chop($name_txt, $type_txt);
-$table_fr->Label(-text => $name_txt, -relief => "ridge", -borderwidth => 1,
- -justify => "left")
- ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
-$table_fr->Label(-text => $type_txt, -relief => "ridge", -borderwidth => 1,
- -justify => "left")
- ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
-$table_fr->pack(-side => "left");
-
-# Now create a frame for the index definition & pack the whole lot
-my $index_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
-$box2->pack();
-$box1->pack(-side => "top", -fill => "x", -expand => 1);
-
-# Create the buttons at the bottom
-$box1 = $dialog->Frame(-borderwidth => 0);
-$box1->Button(-text => "Close", -command => sub { $dialog->destroy(); })
- ->pack(-padx => 6, -side => "left", -expand => 1);
-my $index_bn;
-$index_bn = $box1->Button(-text => "Indexes")
- ->pack(-padx => 6, -side => "left", -expand => 1);
-$index_bn->configure(-command => sub { disp_table_cb($owner, $table, $num_cols,
- $index_fr, $index_bn); });
-$box1->pack(-side => "bottom", -pady => 6);
-
-$dialog->Popup();
-busy(0);
-return(1);
-}
-
-################################################################################
-# Display the query plan tree
-
-sub disp_plan_tree()
-{
-$PlanTitle->configure(-text => $Plan->{title});
-$PlanTree->delete("all");
-my $steps = 0;
-foreach my $step (@{$Plan->{id}})
- {
- my $item = $PlanTree->add($step->{key}, -text => $step->{desc});
- $steps++;
- }
-$PlanTree->autosetmode();
-if ($steps)
- {
- $PlanTree->selectionSet("1");
- disp_plan_step("1");
- }
-}
-
-################################################################################
-# Display the statistics for a given plan step
-
-sub disp_plan_step($)
-{
-my ($key) = @_;
-my $row = $Plan->{key}{$key};
-$PlanStep->delete("1.0", "end");
-my $info = "";
-$info .= "Cost:\t\t$row->{COST}\t(Estimate of the cost of this step)\n"
- . "Cardinality:\t$row->{CARDINALITY}\t"
- . "(Estimated number of rows fetched by this step)\n"
- . "Bytes:\t\t$row->{BYTES}\t"
- . "(Estimated number of bytes fetched by this step)\n"
- if ($row->{COST});
-$info .= "\nPartition\nStart:\t$row->{PARTITION_START}\tStop:\t\t"
- . "$row->{PARTITION_STOP}\tId:\t\t$row->{PARTITION_ID}\n"
- if ($row->{PARTITION_START});
-$info .= "\nSQL used by Parallel Query Slave:\n$row->{OTHER}"
- if ($row->{OTHER});
-$PlanStep->insert("1.0", $info);
-}
-
-################################################################################
-# Display a popup dialog showing the structure of the table or index used in
-# the passed plan step
-
-sub disp_plan_step_obj($)
-{
-my ($key) = @_;
-
-# Get the plan step & return if it doesn't refer to an object
-my $row = $Plan->{key}{$key};
-return(1) if (! $row->{OBJECT_NAME});
-
-# Work out the type of the object - table or index
-busy(1);
-my $qry = $Db->prepare(qq(
- $SqlMarker select object_type from all_objects
- where object_name = :1 and owner = :2
-));
-$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
- || die("Object type:\n$DBI::errstr\n");
-my ($object_type) = $qry->fetchrow_array();
-$qry->finish();
-busy(0);
-
-if ($object_type eq "TABLE")
- {
- disp_table($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
- }
-elsif ($object_type eq "INDEX")
- {
- disp_index($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
- }
-else
- {
- die("Unknown object type $object_type",
- "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n");
- }
-}
-
-################################################################################
-# Display a list of available indexes on a table, and display the selected
-# table definition
-
-sub disp_index_popup($)
-{
-my ($key) = @_;
-
-# Get the plan step & return if it doesn't refer to an object
-my $row = $Plan->{key}{$key};
-return(1) if (! $row->{OBJECT_NAME});
-
-# Work out the type of the object - table or index
-busy(1);
-my $qry = $Db->prepare(qq(
- $SqlMarker select object_type from all_objects
- where object_name = :1 and owner = :2
-));
-$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
- || die("Object type:\n$DBI::errstr\n");
-my ($object_type) = $qry->fetchrow_array();
-$qry->finish();
-if ($object_type ne "TABLE")
- {
- busy(0);
- return(1);
- }
-
-# Build the popup menu
-$qry = $Db->prepare(qq(
- $SqlMarker select owner, index_name from all_indexes
- where table_name = :1 and table_owner = :2
-));
-$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
- || die("Table indexes:\n$DBI::errstr\n");
-my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#000000");
-$menu->command(-label => "Indexes", -state => "disabled");
-
-$menu->separator();
-my $count = 0;
-while ((my ($index_owner, $index_name) = $qry->fetchrow_array()))
- {
- $menu->command(-label => "$index_owner.$index_name",
- -command => [ \&disp_index, $index_owner, $index_name ]);
- $count++;
- }
-$qry->finish();
-busy(0);
-$menu->Popup(-popover => "cursor", -popanchor => "nw") if ($count);
-return(1);
-}
-
-################################################################################
-# Produce the query plan for the SQL in $PlanSql and store it in $Plan
-
-sub _explain()
-{
-# Check there is some SQL
-my $stmt = $PlanSql->get("1.0", "end");
-$stmt =~ s/;//g;
-die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/);
-
-# Check we are logged on
-die("You are not logged on to Oracle\n") if (! $Db);
-
-# Set up the various query strings
-# Note that for some reason you can't use bind variables in 'explain plan'
-my $prefix = "explain plan set statement_id = '$$' for\n";
-my $plan_sql = qq(
- $SqlMarker select level, operation, options, object_node, object_owner,
- object_name, object_instance, object_type, id, parent_id, position,
- other);
-if ($OracleVersion ge "7.3")
- { $plan_sql .= qq(, cost, cardinality, bytes, other_tag) };
-if ($OracleVersion ge "8")
- { $plan_sql .= qq(, partition_start, partition_stop, partition_id) };
-$plan_sql .= qq(
- from plan_table
- where statement_id = :1
- connect by prior id = parent_id and statement_id = :1
- start with id = 0 and statement_id = :1
-);
-
-# Clean any old stuff from the plan_table
-busy(1);
-$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
- undef, $$)
- || die("Delete from plan_table:\n$DBI::errstr\n");
-$Db->commit();
-
-# Switch schema if required
-if ($Schema ne $User)
- {
- $Db->do(qq($SqlMarker alter session set current_schema = $Schema))
- || die("Cannot change schema to $Schema:\n$DBI::errstr\n");
- }
-
-# Explain the plan - need to save message if failed!
-$Plan = { schema => $Schema, sql => $stmt };
-my $fail;
-$fail = $DBI::errstr if (!$Db->do($prefix . $stmt));
-
-# Switch back schema if required
-if ($Schema ne $User)
- {
- $Db->do(qq($SqlMarker alter session set current_schema = $User))
- || die("Set current schema to $User:\n$DBI::errstr\n");
- }
-# Now we can safely die if the exmplai plan failed
-die("Explain plan:\n$fail\n") if ($fail);
-
-# Read back the plan
-my $qry = $Db->prepare($plan_sql)
- || die("Unsupported PLAN_TABLE format:\n$DBI::errstr\n");
-$qry->execute($$) || die("Read plan:\n$DBI::errstr\n");
-while (my $row = $qry->fetchrow_hashref())
- {
- if ($row->{ID} == 0)
- {
- $Plan->{title} = "Query Plan for " . lc($row->{OPERATION});
- $Plan->{title} .= ". Cost = $row->{POSITION}" if ($row->{POSITION});
- }
- else
- {
- # Line wrap the OTHER field
- $row->{OTHER} =~ s/((.{1,80})(\s+|,|$))/$1\n/g if ($row->{OTHER});
-
- # Construct a descriptive string for the query step
- my $desc = "$row->{OPERATION}";
- $desc .= " $row->{OPTIONS}" if ($row->{OPTIONS});
- $desc .= " $row->{OBJECT_TYPE}" if ($row->{OBJECT_TYPE});
- $desc .= " of $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}"
- if ($row->{OBJECT_OWNER} && $row->{OBJECT_NAME});
- $desc .= " using PQS $row->{OBJECT_NODE} $row->{OTHER_TAG}"
- if ($row->{OBJECT_NODE});
- $row->{desc} = $desc;
-
- # Construct a hierarchical key for the query step
- if (! $row->{PARENT_ID})
- {
- my $key = "$row->{POSITION}";
- $row->{key} = $key;
- $Plan->{id}[$row->{ID} - 1] = $row;
- $Plan->{key}{$key} = $row;
- }
- else
- {
- my $parent = $Plan->{id}[$row->{PARENT_ID} - 1];
- my $key = "$parent->{key}.$row->{POSITION}";
- $row->{key} = $key;
- $Plan->{id}[$row->{ID} - 1] = $row;
- $Plan->{key}{$key} = $row;
- $parent->{child}[$row->{POSITION} - 1] = $row;
- }
- }
- }
-# Top of the tree is step 0
-$Plan->{tree} = $Plan->{id}[0];
-
-# Clean up
-$qry->finish();
-$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
- undef, $$);
-$Db->commit();
-busy(0);
-return(1);
-}
-
-################################################################################
-# Wrapper for _explain - adds error handling
-
-sub explain
-{
-clear_plan();
-if (! eval { _explain(); }) { error($PlanMain, $@); }
-else { disp_plan_tree(); }
-}
-
-################################################################################
-# Display a login dialog
-
-sub login_dialog($)
-{
-my ($parent) = @_;
-
-# Create the dialog
-if (! $LoginDialog)
- {
- my $username = "/";
- my $password = "";
- my $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID};
-
- $LoginDialog = $parent->Toplevel(-title => "Login to Oracle");
- $LoginDialog->withdraw();
- $LoginDialog->resizable(0, 0);
- my $box;
-
- # Create the entry labels & fields
- $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
- $box->Label(-text => "Username")
- ->grid(-column => 0, -row => 0, -sticky => "w");
- $box->Entry(-textvariable => \$username, -width => 30)
- ->grid(-column => 1, -row => 0, -sticky => "w");
- $box->Label(-text => "Password")
- ->grid(-column => 0, -row => 1, -sticky => "w");
- $box->Entry(-textvariable => \$password, -width => 30, -show => "*")
- ->grid(-column => 1, -row => 1, -sticky => "w");
- $box->Label(-text => "Database")
- ->grid(-column => 0, -row => 2, -sticky => "w");
- $box->Entry(-textvariable => \$database, -width => 30)
- ->grid(-column => 1, -row => 2, -sticky => "w");
- $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
-
- # Create the buttons & callbacks
- $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
- my $cb = sub
- {
- if (! eval { login($database, $username, $password); })
- {
- error($parent, $@);
- $LoginDialog->raise($parent);
- }
- else
- {
- update_title();
- $LoginDialog->withdraw();
- }
- };
- $box->Button(-text => "Login", -default => "active", -command => $cb)
- ->pack(-side => "left", -expand => 1, -pady => 6);
- $box->Button(-text => "Cancel", -command => sub { $LoginDialog->withdraw() })
- ->pack(-side => "right", -expand => 1, -pady => 6);
- $box->pack(-expand => 1, -fill => "both");
- $LoginDialog->bind("<KeyPress-Return>", $cb);
- }
-
-# Activate the dialog
-$LoginDialog->Popup();
-}
-
-################################################################################
-
-sub schema_dialog($)
-{
-my ($parent) = @_;
-
-if (! $Db)
- {
- error($parent, "You are not logged on to Oracle\n");
- return;
- }
-
-# Create the dialog
-if (! $SchemaDialog)
- {
- $SchemaDialog = $parent->Toplevel(-title => "Change Schema");
- $SchemaDialog->withdraw();
- $SchemaDialog->resizable(0, 0);
- my ($box, $schema);
-
- # Create the entry labels & fields
- $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
- $box->Label(-text => "Schema")
- ->pack(-side => "left", -anchor => "e", -expand => 1);
- $box->Entry(-textvariable => \$schema, -width => 30)
- ->pack(-side => "right", -anchor => "w", -expand => 1);
- $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
-
- # Create the buttons & callbacks
- $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
- my $cb = sub
- {
- # Try changing to the specified schema
- $schema = uc($schema);
- if (! $Db->do(qq($SqlMarker alter session set current_schema = $schema)))
- {
- error($parent, "Cannot change schema to $schema:", $DBI::errstr);
- $SchemaDialog->raise($parent);
- }
- else
- {
- # Change back to the user's schema
- $Db->do(qq($SqlMarker alter session set current_schema = $User))
- || die("Cannot change schema to $User\n$DBI::errstr");
- $Schema = $schema;
- update_title();
- $SchemaDialog->withdraw();
- }
- };
- $box->Button(-text => "Default", -command => sub { $schema = $User; })
- ->pack(-side => "left", -expand => 1, -pady => 6);
- $box->Button(-text => "Apply", -default => "active", -command => $cb)
- ->pack(-side => "left", -expand => 1, -pady => 6);
- $box->Button(-text => "Cancel",
- -command => sub { $SchemaDialog->withdraw() })
- ->pack(-side => "left", -expand => 1, -pady => 6);
- $box->pack(-expand => 1, -fill => "both");
- $SchemaDialog->bind("<KeyPress-Return>", $cb);
- }
-
-# Activate the dialog
-$SchemaDialog->Popup();
-}
-
-################################################################################
-# Open a file and read it into the SQL editor frame
-
-sub open_file($)
-{
-# Open the file
-my ($file) = @_;
-use IO::File;
-my $fh;
-if (! ($fh = IO::File->new($file, "r")))
- {
- error($PlanMain, "Cannot open $file:\n", $!);
- return(0);
- }
-
-# Clear the plan, plan details & SQL editor, then load into the SQL editor
-clear_editor();
-while (my $line = $fh->getline())
- {
- $PlanSql->insert("end", $line);
- }
-$fh->close();
-return(1);
-}
-
-################################################################################
-# Display a file open dialog & load into the SQL editor
-
-sub open_dialog($)
-{
-my ($parent) = @_;
-
-# Put up the dialog
-require Cwd; import Cwd;
-require Tk::FileSelect;
-$FileDir = cwd() if (! $FileDir);
-if (! $OpenDialog)
- {
- $OpenDialog = $parent->FileSelect(-title => "Open File",
- -create => 0);
- }
-$OpenDialog->configure(-directory => $FileDir);
-my $file = $OpenDialog->Show();
-return if (! $file);
-$FileDir = $OpenDialog->cget(-directory);
-open_file($file);
-}
-
-################################################################################
-# Display a file save dialog & save the contents of the passed Text widget
-
-sub save_dialog($$)
-{
-my ($parent, $text) = @_;
-
-# Put up the dialog
-require Cwd; import Cwd;
-require IO::File;
-require Tk::FileSelect;
-$FileDir = cwd() if (! $FileDir);
-if (! $SaveDialog)
- {
- $SaveDialog = $parent->FileSelect(-title => "Save File",
- -create => 1);
- }
-$SaveDialog->configure(-directory => $FileDir);
-my $file = $SaveDialog->Show();
-return if (! $file);
-$FileDir = $SaveDialog->cget(-directory);
-
-# Save the Text widget contents to the selected file
-my $fh;
-if (! ($fh = IO::File->new($file, "w")))
- {
- error($PlanMain, "Cannot open $file:\n", $!);
- return;
- }
-$fh->print($text->get("1.0", "end"));
-$fh->close();
-}
-
-################################################################################
-# Copy SQL from the grab window into the explain SQL editor
-
-sub copy_sql($$)
-{
-my ($text, $tag) = @_;
-return if (! defined($tag));
-clear_editor();
-$PlanSql->insert("end", $text->get("$tag.first", "$tag.last"));
-$Schema = $text->tag("cget", $tag, -data);
-update_title();
-$PlanMain->deiconify();
-}
-
-################################################################################
-# Display info from v$sqlarea for the selected statement in the SQL cache
-
-sub disp_sql_cache_info($$)
-{
-my ($address, $puid) = @_;
-
-# Empty the widget & prepare the SQL
-$GrabDetails->delete("1.0", "end");
-busy(1);
-my $qry = $Db->prepare(qq(
- $SqlMarker select executions, disk_reads, buffer_gets, rows_processed,
- sorts, loads, parse_calls, first_load_time
- from v\$sqlarea where address = :1
-)) || die("Statement info:\n$DBI::errstr\n");
-
-# Read the info. Note that the statement *may* have been purged from the cache!
-$qry->execute($address);
-if (! (my ($executions, $disk_reads, $buffer_gets, $rows_processed,
- $sorts, $loads, $parse_calls, $first_load_time)
- = $qry->fetchrow_array()))
- {
- $GrabDetails->insert("1.0", "This statement is no longer in the SQL cache");
- }
-else
- {
- $first_load_time =~ s!/! !;
- $GrabDetails->insert("1.0", "First executed by user", "bold",
- " $puid ", "",
- " at", "bold", " $first_load_time\n");
- $GrabDetails->insert("end", "Total ", "bold");
- $GrabDetails->insert("end", sprintf("Executions: %8d\n", $executions));
- my $fmt =
- "Disk reads: %8d Buffer gets: %8d Rows processed: %8d\n"
- . "Sorts: %8d Loads: %8d Parse calls: %8d\n";
- $GrabDetails->insert("end",
- sprintf($fmt, $disk_reads, $buffer_gets, $rows_processed,
- $sorts, $loads, $parse_calls));
- if ($executions > 0)
- {
- $GrabDetails->insert("end", "Average per Execution\n", "bold");
- $fmt =
- "Disk reads: %8.1f Buffer gets: %8.1f "
- . "Rows processed: %8.1f\n"
- . "Sorts: %8.1f Loads: %8.1f "
- . "Parse calls: %8.1f\n";
- $GrabDetails->insert("end",
- sprintf($fmt, $disk_reads / $executions, $buffer_gets / $executions,
- $rows_processed / $executions, $sorts / $executions,
- $loads / $executions, $parse_calls / $executions));
- }
- }
-busy(0);
-
-# Display the formated info
-return(1);
-}
-
-################################################################################
-# Callback for whenever a bit of grabbed SQL is selected
-
-sub grab_select_cb($$)
-{
-my ($text, $tag) = @_;
-$text->tag("configure", $GrabSelection, -background => undef)
- if ($GrabSelection);
-$text->tag("configure", $tag, -background => "#43ce80");
-my $puid = $text->tag("cget", $tag, -data);
-$GrabSelection = $tag;
-if (! eval { disp_sql_cache_info($tag, $puid); })
- { error($GrabMain, $@); }
-}
-
-################################################################################
-# Scan v$sqlarea for SQL statements matching the specified conditions.
-# $order_by is a v$sqlarea column name used to rank the statements
-# $sort_by is "asc" or "desc"
-# $user is who first issued the statement (case insensitive)
-# $pattern is a perl regexp used to filter the SQL
-# $rows is the maximum number of rows to display
-
-sub grab($$$$$$$)
-{
-my ($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows) = @_;
-
-# Check we are logged on
-die("You are not logged on to Oracle\n") if (! $Db);
-
-# Munge args as necessary
-$no_sys = $no_sys ? qq{and user_name not in ('SYS', 'SYSTEM')} : qq{};
-$rows = -1 if ($rows !~ /^\d+$/);
-$user = uc($user);
-
-# Clear the frames
-$GrabSql->delete("1.0", "end");
-$GrabDetails->delete("1.0", "end");
-$GrabStatus->configure(-text => "Please wait...");
-
-# Define the callbacks for highlighting etc
-my $highlight = sub
- {
- my ($text, $tag) = @_;
- $text->tag("configure", $tag, -relief => "raised", -borderwidth => 1);
- };
-my $normal = sub
- {
- my ($text, $tag) = @_;
- $text->tag("configure", $tag, -relief => "flat");
- };
-
-# Prepare the queries
-busy(1);
-my $qry1 = qq{$SqlMarker select address, username from v\$sqlarea, all_users};
-$qry1 .= qq{ where sql_text not like '\%$SqlMarker\%'};
-$qry1 .= qq{ and sql_text not like '\%insert into \%plan_table\%'};
-$qry1 .= qq{ and sql_text not like '\%explain plan\%'};
-$qry1 .= qq{ and user_id = parsing_user_id}; # if($user || $no_sys);
-$qry1 .= qq{ and username = :1} if ($user);
-$qry1 .= qq{ and username not in ('SYS', 'SYSTEM')} if ($no_sys);
-if ($ordering eq "total")
- { $qry1 .= qq{ order by $order_by $sort_by}; }
-elsif ($ordering eq "average")
- { $qry1 .= qq{ order by $order_by / greatest(executions, 1) $sort_by}; }
-$qry1 = $Db->prepare($qry1) || die("SQL Cache capture:\n$DBI::errstr\n");
-
-my $qry2;
-if ($OracleVersion ge "7.2")
- {
- $qry2 = $Db->prepare(qq(
- $SqlMarker select sql_text from v\$sqltext_with_newlines
- where address = :1 order by piece))
- || die("SQL text:\n$DBI::errstr\n");
- }
-else{
- $qry2 = $Db->prepare(qq(
- $SqlMarker select sql_text from v\$sqltext
- where address = :1 order by piece))
- || die("SQL text:\n$DBI::errstr\n");
- }
-
-# For each SQL query in the shared pool...
-if ($user) { $qry1->execute($user) || die("SQL text:\n$DBI::errstr\n"); }
-else { $qry1->execute() || die("SQL text:\n$DBI::errstr\n"); }
-my $count = 0;
-my $first_address;
-while ($count != $rows && (my ($address, $puid) = $qry1->fetchrow_array()))
- {
- # ...glue together the components of the SQL string & print out
- $qry2->execute($address) || die("SQL text:\n$DBI::errstr\n");
- my ($sql_text) = "";
- while (my ($sql) = $qry2->fetchrow_array())
- {
- $sql_text .= $sql;
- }
- $qry2->finish();
- $sql_text =~ s/^\s+//;
- $sql_text =~ s/\n\s*\n/\n/;
- $sql_text =~ s/\s+$//s;
-
- # Skip if it doesn't match the supplied pattern
- next if ($pattern && eval { $sql_text !~ /$pattern/is; });
-
- # Display the statement and set up the bindings
- $GrabSql->insert("end", $sql_text, $address, "\n\n");
- $GrabSql->tag("configure", $address, -data => $puid);
- $GrabSql->tag("bind", $address, "<Any-Enter>" => [ $highlight, $address ]);
- $GrabSql->tag("bind", $address, "<Any-Leave>" => [ $normal, $address ]);
- $GrabSql->tag("bind", $address, "<Double-1>" => [ \©_sql, $address]);
- $GrabSql->tag("bind", $address, "<1>" => [ \&grab_select_cb, $address ]);
- $GrabSql->update();
-
- $count++;
- $first_address = $address if (! defined($first_address));
- if ($rows > 0)
- { $GrabStatus->configure(-text => "$count of $rows queries grabbed"); }
- else
- { $GrabStatus->configure(-text => "$count queries grabbed"); }
- }
-
-# Clean up
-$qry1->finish();
-grab_select_cb($GrabSql, $first_address) if ($first_address);
-$GrabStatus->configure(-text => "$count queries grabbed");
-busy(0);
-return(1);
-}
-
-################################################################################
-# Create a top-level window for getting SQL from the shared pool cache
-
-sub grab_main
-{
-# If it already exists, just make it visible)
-if ($GrabMain)
- {
- $GrabMain->deiconify();
- $GrabMain->raise($PlanMain);
- return;
- }
-
-# Otherwise, build the grab window
-$GrabMain = $PlanMain->Toplevel(-title => "$ProgName - SQL cache");
-$GrabMain->protocol("WM_DELETE_WINDOW", sub { $GrabMain->withdraw(); });
-
-# Defaults & callbacks
-my $ordering = "";
-my $order_by = "";
-my $sort_by = "";
-my $no_sys = 1;
-my $user = "";
-my $pattern = "";
-my $rows = 100;
-my $grab_cb = sub
- {
- if (! eval { grab($ordering, $order_by, $sort_by, $no_sys,
- $user, $pattern, $rows); })
- { error($GrabMain, $@); }
- };
-my (%ord_bn, %sort_bn); # For "order by" and "sort order" buttons
-my $ord_bn_cb = sub
- {
- if ($ordering eq "")
- {
- $order_by = "";
- $sort_by = "";
- foreach my $bn (values(%ord_bn))
- { $bn->configure(-state => "disabled"); }
- foreach my $bn (values(%sort_bn))
- { $bn->configure(-state => "disabled"); }
- }
- elsif ($ordering eq "total")
- {
- $order_by = "disk_reads" if ($order_by eq "");
- $sort_by = "desc" if ($sort_by eq "");
- foreach my $bn (values(%ord_bn))
- { $bn->configure(-state => "normal"); }
- foreach my $bn (values(%sort_bn))
- { $bn->configure(-state => "normal"); }
- }
- else # $ordering eq "average"
- {
- $order_by = "disk_reads"
- if ($order_by eq "" || $order_by eq "executions");
- $sort_by = "desc" if ($sort_by eq "");
- foreach my $bn (values(%ord_bn))
- { $bn->configure(-state => "normal"); }
- $ord_bn{executions}->configure(-state => "disabled");
- $ord_bn{first_load_time}->configure(-state => "disabled");
- foreach my $bn (values(%sort_bn))
- { $bn->configure(-state => "normal"); }
- }
- };
-
-### Menubar
-my $menubar = $GrabMain->Frame(-relief => "raised", -borderwidth => 3);
-$menubar->pack(-fill => "x");
-
-my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
-$menubar_file->command(-label => "Save File ...", -underline => 0,
- -command => sub { save_dialog($PlanMain, $GrabSql); });
-$menubar_file->separator();
-$menubar_file->command(-label => "Capture SQL", -underline => 0,
- -command => $grab_cb);
-$menubar_file->command(-label => "Copy to Explain", -underline => 9,
- -command => sub { copy_sql($GrabSql, $GrabSelection); });
-$menubar_file->command(-label => "Close", -underline => 1,
- -command => sub { $GrabMain->withdraw(); });
-$menubar_file->pack(-side => "left");
-
-my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
-$menubar_help->command(-label => "About ...", -underline => 0,
- -command => sub { about($GrabMain); });
-$menubar_help->command(-label => "Usage ...", -underline => 0,
- -command => sub { help($GrabMain); });
-$menubar_help->pack(-side => "right");
-
-### SQL cache display
-my ($frame, $frame1, $frame2, $frame3);
-$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame1 = $frame->Frame(-highlightthickness => 0);
-$frame1->Label(-text => "SQL Cache")->pack(-side => "left");
-$GrabStatus = $frame1->Label(-text => "")->pack(-side => "right");
-$frame1->pack(-fill => "x");
-$GrabSql = $frame->Scrolled("ROText", -setgrid => "true", -scrollbars => "oe",
- -height => 15, -width => 80, -borderwidth => 0,
- -wrap => "word")
- ->pack(-fill => "both", -expand => 1);
-$frame->pack(-fill => "both", -expand => 1);
-
-### SQL statement details
-$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Label(-text => "SQL Statement Statistics")->pack(-anchor => "nw");
-$GrabDetails = $frame->ROText(-height => 7, -width => 80, -borderwidth => 0,
- -setgrid => "true", -wrap => "none")
- ->pack(-fill => "x");
-$GrabDetails->tagConfigure("bold", -font => "bold");
-$frame->pack(-fill => "x");
-
-### SQL selection
-$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Label(-text => "SQL Selection Criterea")->pack(-anchor => "w");
-$frame1 = $frame->Frame(-highlightthickness => 1);
-
-## SQL sort frame
-$frame1->Label(-text => "Order SQL by")
- ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
-$frame2 = $frame1->Frame(-highlightthickness => 0);
-
-# Ordering frame
-$frame3 = $frame2->Frame(-highlightthickness => 1);
-$frame3->Radiobutton(-text => "No ordering", -highlightthickness => 0,
- -value => "", -variable => \$ordering,
- -command => $ord_bn_cb)
- ->pack(-anchor => "w");
-$frame3->Radiobutton(-text => "Total", -highlightthickness => 0,
- -value => "total", -variable => \$ordering,
- -command => $ord_bn_cb)
- ->pack(-anchor => "w");
-$frame3->Radiobutton(-text => "Average per execution",
- -highlightthickness => 0, -value => "average",
- -variable => \$ordering, -command => $ord_bn_cb)
- ->pack(-anchor => "w");
-$frame3->pack(-side => "left", -padx => 6);
-
-# Order by frame
-$frame3 = $frame2->Frame(-highlightthickness => 1);
-$ord_bn{disk_reads} =
- $frame3->Radiobutton(-text => "Disk reads", -highlightthickness => 0,
- -value => "disk_reads", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 0, -sticky => "w");
-$ord_bn{buffer_gets} =
- $frame3->Radiobutton(-text => "Buffer gets", -highlightthickness => 0,
- -value => "buffer_gets", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 1, -row => 0, -sticky => "w");
-$ord_bn{rows_processed} =
- $frame3->Radiobutton(-text => "Rows processed", -highlightthickness => 0,
- -value => "rows_processed", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 1, -sticky => "w");
-$ord_bn{sorts} =
- $frame3->Radiobutton(-text => "Sorts", -highlightthickness => 0,
- -value => "sorts", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 1, -row => 1, -sticky => "w");
-$ord_bn{loads} =
- $frame3->Radiobutton(-text => "Loads", -highlightthickness => 0,
- -value => "loads", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 2, -sticky => "w");
-$ord_bn{parse_calls} =
- $frame3->Radiobutton(-text => "Parse calls", -highlightthickness => 0,
- -value => "parse_calls", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 1, -row => 2, -sticky => "w");
-$ord_bn{executions} =
- $frame3->Radiobutton(-text => "Executions", -highlightthickness => 0,
- -value => "executions", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 3, -sticky => "w");
-$ord_bn{first_load_time} =
- $frame3->Radiobutton(-text => "First load", -highlightthickness => 0,
- -value => "first_load_time", -variable => \$order_by,
- -command => $ord_bn_cb)
- ->grid(-column => 1, -row => 3, -sticky => "w");
-$frame3->pack(-side => "left", -padx => 6);
-
-# Sort order frame
-$frame3 = $frame2->Frame(-highlightthickness => 1);
-$sort_bn{desc} =
- $frame3->Radiobutton(-text => "Descending", -highlightthickness => 0,
- -value => "desc", -variable => \$sort_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 0, -sticky => "w");
-$sort_bn{asc} =
- $frame3->Radiobutton(-text => "Ascending", -highlightthickness => 0,
- -value => "asc", -variable => \$sort_by,
- -command => $ord_bn_cb)
- ->grid(-column => 0, -row => 1, -sticky => "w");
-$frame3->pack(-side => "right", -padx => 6);
-$frame2->grid(-column => 0, -row => 1, -sticky => "w", -columnspan => 2);
-
-## Other options frame
-$frame2 = $frame1->Frame(-highlightthickness => 0);
-$frame2->Checkbutton(-text => "Exclude queries by SYS or SYSTEM",
- -variable => \$no_sys, -offvalue => 0, -onvalue => 1,
- -highlightthickness => 0)
- ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
-$frame2->Label(-text => "First user to execute statement")
- ->grid(-column => 0, -row => 1, -sticky => "w");
-$frame2->Entry(-textvariable => \$user, -width => 30)
- ->grid(-column => 1, -row => 1, -sticky => "w");
-$frame2->Label(-text => "SQL matches pattern")
- ->grid(-column => 0, -row => 2, -sticky => "w");
-$frame2->Entry(-textvariable => \$pattern, -width => 30)
- ->grid(-column => 1, -row => 2, -sticky => "w");
-$frame2->Label(-text => "Maximum number of statements")
- ->grid(-column => 0, -row => 3, -sticky => "w");
-$frame2->Entry(-textvariable => \$rows, -width => 4)
- ->grid(-column => 1, -row => 3, -sticky => "w");
-$frame2->grid(-column => 0, -row => 2, -sticky => "we",
- -columnspan => 2, -padx => 6, -pady => 6);
-$frame1->pack(-fill => "x");
-&$ord_bn_cb(); # Set the buttons to the initial state
-$frame->pack(-fill => "x", ipadx => 6, -ipady => 6);
-
-### Buttons
-$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Button(-text => "Capture SQL", -command => $grab_cb)
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->Button(-text => "Copy to Explain",
- -command => sub { copy_sql($GrabSql, $GrabSelection); })
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->Button(-text => "Close", -command => sub { $GrabMain->withdraw(); })
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->pack(-fill => "x");
-}
-
-################################################################################
-# Main
-
-### Main window
-$ProgName = basename($0);
-$ProgName =~ s/\..*$//;
-$PlanMain = MainWindow->new();
-$PlanMain->withdraw();
-update_title();
-$Balloon = $PlanMain->Balloon();
-
-### Splash screen
-my $splash;
-if (@ARGV == 0 || $ARGV[0] ne '-q')
- {
- about($PlanMain, \$splash);
- $splash->after(10000,
- sub { if ($splash) { $splash->destroy(); undef($splash); } });
- $PlanMain->update();
- }
-else
- { shift(@ARGV); }
-
-### Menubar
-my $menubar = $PlanMain->Frame(-relief => "raised", -borderwidth => 3);
-
-# Create a bold font $ figure out charcter spacing
-my $t = $PlanMain->Text();
-my $f = $t->cget(-font);
-$t->fontCreate("bold", $PlanMain->fontActual($f), -weight => "bold");
-$CharWidth = $PlanMain->fontMeasure($f, "X");
-undef($f);
-$t->destroy();
-undef($t);
-
-my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
-$menubar_file->command(-label => "Login ...", -underline => 0,
- -command => sub { login_dialog($PlanMain); });
-$menubar_file->command(-label => "Schema ...", -underline => 2,
- -command => sub { schema_dialog($PlanMain); });
-$menubar_file->command(-label => "Explain", -underline => 0,
- -command => \&explain);
-$menubar_file->command(-label => "SQL Cache ...", -underline => 4,
- -command => \&grab_main);
-$menubar_file->separator();
-$menubar_file->command(-label => "Open File ...", -underline => 0,
- -command => sub { open_dialog($PlanMain); });
-$menubar_file->command(-label => "Save File ...", -underline => 0,
- -command => sub { save_dialog($PlanMain, $PlanSql); });
-$menubar_file->separator();
-$menubar_file->command(-label => "Exit", -underline => 1,
- -command => sub { $Db->disconnect() if ($Db); exit(0); });
-$menubar_file->pack(-side => "left");
-
-my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
-$menubar_help->command(-label => "About ...", -underline => 0,
- -command => sub { about($PlanMain); });
-$menubar_help->command(-label => "Usage ...", -underline => 0,
- -command => sub { help($PlanMain); });
-$menubar_help->pack(-side => "right");
-$menubar->pack(-fill => "x");
-
-### Query plan tree
-my $frame;
-$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
-$PlanTitle = $frame->Label(-text => "Query Plan")->pack(-anchor => "nw");
-my $b1_cb = sub
- { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); };
-my $b3_cb = sub
- { error($PlanMain, $@) if (! eval { disp_index_popup($_[0])}); };
-$PlanTree = $frame->Scrolled("B3Tree", -height => 15, -width => 80,
- -borderwidth => 0, -highlightthickness => 1,
- -scrollbars => "osoe",
- -browsecmd => \&disp_plan_step,
- -command => $b1_cb, -b3command => $b3_cb)
- ->pack(-expand => 1, -fill => "both");
-$frame->pack(-expand => 1, -fill => "both");
-
-### Query plan statement details
-$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Label(-text => "Query Step Details")->pack(-anchor => "nw");
-$PlanStep = $frame->Scrolled("ROText", -height => 8, -width => 80,
- -borderwidth => 0, -wrap => "none",
- -setgrid => "true", -scrollbars => "osoe")
- ->pack(-fill => "x");
-$frame->pack(-fill => "x");
-
-### SQL text editor
-$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Label(-text => "SQL Editor")->pack(-anchor => "nw");
-$PlanSql = $frame->Scrolled("Text", -setgrid => "true", -scrollbars => "oe",
- -borderwidth => 0, -height => 15, -width => 80,
- -wrap => "word")
- ->pack(-expand => 1, -fill => "both");
-$frame->pack(-expand => 1, -fill => "both");
-
-### Buttons
-$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
-$frame->Button(-text => "Explain", -command => \&explain)
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->Button(-text => "Clear", -command => \&clear_editor)
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->Button(-text => "SQL Cache", -command => \&grab_main)
- ->pack(-side => "left", -expand => 1, -pady => 6);
-$frame->pack(-fill => "x");
-
-### user/pass@db command-line argument processing
-$PlanMain->update();
-$PlanMain->deiconify();
-$splash->raise() if (defined($splash));
-if (@ARGV >= 1 && $ARGV[0] =~ /\w*\/\w*(@\w+)?/)
- {
- my ($username, $password, $database) = split(/[\/@]/, shift(@ARGV));
- if (! $username) { $username = "/"; $password = ""; }
- if (! $database) { $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; }
- error($PlanMain, $@) if (! eval { login($database, $username, $password); });
- update_title();
- }
-else
- {
- login_dialog($PlanMain);
- }
-
-### SQL filename argument processing
-if (@ARGV >= 1 && -r $ARGV[0])
- {
- my $file = shift(@ARGV);
- if (open_file($file))
- {
- $FileDir = dirname($file);
- explain() if ($Db);
- }
- }
-
-# Doncha just love GUI programming :-)
-MainLoop();
-
-################################################################################
-__END__
-
-=head1 NAME
-
-explain, ora_explain - Visualise Oracle query plans
-
-=head1 SYNOPSIS
-
- $ explain [ [ user/password@database ] sql script ]
- $ ora_explain [ [ user/password@database ] sql script ]
-
-B<Note:> When bundled with DBD::Oracle, the script is called ora_explain
-
-=head1 DESCRIPTION
-
-Explain is a GUI-based tool that enables easier visualisation of Oracle Query
-plans. A query plan is the access path that Oracle will use to satisfy a SQL
-query. The Oracle query optimiser is responsible for deciding on the optimal
-path to use. Needless to say, understanding such plans requires a fairly
-sophisticated knowledge of Oracle architecture and internals.
-
-Explain allows a user to interactively edit a SQL statemant and view the
-resulting query plan with the click of a single button. The effects of
-modifying the SQL or of adding hints can be rapidly established.
-
-Explain allows the user to capture all the SQL currently cached by Oracle. The
-SQL capture can be filtered and sorted by different criterea, e.g. all SQL
-matching a pattern, order by number of executions etc.
-
-Explain is written using Perl, DBI/DBD::Oracle and Tk.
-
-=head1 PREREQUISITES
-
-=over 2
-
-=item 1.
-
-Oracle 7 or Oracle 8, with SQL*Net if appropriate
-
-=item 2.
-
-L<Perl 5.004_04|perl> or later
-
-=item 3.
-
-L<DBI> version 1.02 or later
-
-=item 4.
-
-L<DBD::Oracle> 0.54 or later
-
-=item 5.
-
-L<Tk|Tk::overview> 800.011 or later
-
-=item 6.
-
-L<Tk::Pod> 3.15 or later
-
-=back
-
-Items 2 through 6 can be obtained from any CPAN mirror.
-
-=head1 INSTALLATION
-
-=over 2
-
-=item 1.
-
-Check you have all the prequisites installed and working.
-
-=item 2.
-
-Run 'perl Makefile.PL; make instal1'
-
-=item 3.
-
-Make sure you have run the script $ORACLE_HOME/rdbms/admin/utlxplan.sql
-from a SQL*Plus session. This script creates the PLAN_TABLE that is used
-by Oracle when explaining query plans.
-
-=back
-
-=head1 HOW TO USE
-
-Type "explain" or "ora_explain" at the shell prompt. A window will appear with
-a menu bar and three frames, labelled "Query Plan", "Query Step Details" and
-"SQL Editor". At the bottom of the window are three buttons labelled
-"Explain", "Clear" and "SQL Cache". A login dialog will also appear, into
-which you should enter the database username, password and database instance
-name (SID). The parameters you enter are passed to the DBI->connect() method,
-so if you have any problems refer to the DBI and DBD::Oracle documentation.
-
-Optionally you may supply up to two command-line arguments. If the first
-argument is of the form username/password@database, explain will use this to
-log in to Oracle, otherwise if it is a filename it will be loaded into the SQL
-editor. If two arguments are supplied, the second one will be assumed to be a
-filename.
-
-Examples:
-
- explain scott/tiger@DEMO query.sql
- explain / query.sql
- explain query.sql
-
-=head2 Explain functionality
-
-The menu bar has two pulldown menus, "File" and "Help". "File" allows you to
-login to Oracle, Change the current schema, Capture the contents of the Oracle
-SQL cache, Load SQL from files, Save SQL to files and to Exit the program.
-"Help" allows you to view release information and read this documentation.
-
-The "SQL Editor" frame allows the editing of a SQL statement. This should be
-just a single statement - multiple statements are not allowed. Refer to the
-documentation for the Tk text widget for a description of the editing keys
-available. Text may be loaded and saved by using the "File" pulldown menu.
-
-Once you have entered a SQL statement, the "Explain" button at the bottom of
-the window will generate the query plan for the statement. A tree
-representation of the plan will appear in the "Query Plan" frame. Individual
-"legs" of the plan may be expanded and collapsed by clicking on the "+' and "-"
-boxes on the plan tree. The tree is drawn so that the "innermost" or "first"
-query steps are indented most deeply. The connecting lines show the
-"parent-child" relationships between the query steps. For a comprehensive
-explanation of the meaning of query plans you should refer to the relevant
-Oracle documentation. The "Clear" button will empty the editor & query plan
-tree panes.
-
-Single-clicking on a plan step in the Query Plan pane will display more
-detailed information on that query step in the Query Step Details frame. This
-information includes Oracle's estimates of cost, cardinality and bytes
-returned. The exact information displayed depends on the Oracle version.
-Again, for detailed information on the meaning of these fields, refer to the
-Oracle documentation.
-
-Double-clicking on a plan step that refers to either a table or an index will
-pop up a dialog box showing the definition of the table or index in a format
-similar to that of the SQL*Plus 'desc' command.
-
-The dialog that appears has a button labelled 'Index'. Clicking on this will
-expand the table dialog to show all the indexes defined on the table. Each
-column represents an index, and the figures define the order that the table
-columns appears in the index. To find out the name of an index, position the
-mouse over the index column. A single click will display the definition of the
-index in a seperate dialog.
-
-Right-clicking on a plan step that refers to a table will pop up a menu showing
-a list of the indexes available for the table. Selecting an index will display
-its definition in a dialog box.
-
-=head2 Capture SQL Cache functionality
-
-The explain window has an option on the "File" menu labelled "SQL Cache ...",
-as well as a button with the same function. Selecting this will popup a new
-top-level window containing a menu bar and three frames, labelled "SQL Cache",
-"SQL Statement Statistics" and "SQL Selection Criterea". At the bottom of the
-window are three buttons labelled "Capture SQL", "Explain" and "Close".
-
-The menu bar has two pulldown menus "File" and "Help". "File" allows you to
-Save the contents of the SQL Cache pane to a file, copy the selected SQL
-statement to the Explain window and Close the Grab window.
-
-The "SQL Cache" frame shows the statements currently in the Oracle SQL cache.
-As you move the cursor over this window, each SQL statement will be highlighted
-with an outline box. Single-clicking on a statement in the SQL Cache pane will
-highlight the stamement in green and display more detailed information on that
-statement in the SQL Statement Statistics frame.
-
-If you want to save the entire contents of the SQL Cache pane, you can do this
-from the "File" menu.
-
-The "SQL Selection Criterea" frame allows you to specify which SQL statements
-you are interested in, and how you want them sorted. The pattern used to select
-statements is a normal perl regexp. Once you have defined the selection
-criterea, clicking the "Capture SQL" button will read all the matching
-statements from the SQL cache and display them in the top frame.
-
-Double-clicking on a statement in the "SQL Cache" pane, selecting "Explain"
-from the "File" menu or clicking the "Explain" button will copy the currently
-highlighted statement in the "SQL Cache" pane to the SQL editor in the Explain
-window, so that the query plan for the statement can be examined. Note also
-that the current schema will be changed to that of the user who first executed
-the captured statement.
-
-=head1 SEE ALSO
-
-This tool assumes that you already know how to interpret Oracle query plans.
-If need an explanation of the information displayed by this tool, you should
-refer to the appropriate Oracle documentation. Information can be found in the
-"Concepts" and "Oracle Tuning" manuals - look for "Query plan" and "Explain
-plan". Two other useful sources of information are:
-
- Oracle Performance Tuning, 2nd ed.
- Mark Gurry and Peter Corrigan
- O'Reilly & Associates, Inc.
- ISBN 1-56592-237-9
-
- Advanced Oracle Tuning and Administration
- Eyal Aronoff, Kevin Loney and Noorali Sonawalla
- Oracle Press (Osborne)
- ISBN 0-07-882241-6
-
-=head1 SUPPORT
-
-Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
-
-=head1 COPYRIGHT AND DISCLAIMER
-
-Copyright (c) 1999 Alan Burlison
-
-You may distribute under the terms of either the GNU General Public License
-or the Artistic License, as specified in the Perl README file, with the
-exception that it cannot be placed on a CD-ROM or similar media for commercial
-distribution without the prior approval of the author.
-
-This code is provided with no warranty of any kind, and is used entirely at
-your own risk.
-
-This code was written by the author as a private individual, and is in no way
-endorsed or warrantied by Sun Microsystems.
-
-=cut
-SCRIPT
-
-use Config;
-
-my $file = __FILE__; $file =~ s/\.PL$//;
-
-$script =~ s/\~(\w+)\~/$Config{$1}/eg;
-if (!(open(FILE, ">$file")) ||
- !(print FILE $script) ||
- !(close(FILE))) {
- die "Error while writing $file: $!\n";
-}
-print "Extracted $file from ",__FILE__," with variable substitutions.\n";
-
-# End.
@@ -1,53 +0,0 @@
-# DBD::Oracle Oraperl emulation. This file is not relevant to the
-# emulation but is included for completeness only.
-# I have updated %ora_types in case it's used. Tim Bunce.
-
-# oraperl.ph
-#
-# Various constants which may be useful in oraperl programs
-#
-# Author: Kevin Stock
-# Date: 28th October 1991
-# Last Change: 8th April 1992
-
-
-# Oraperl error codes, set in $ora_errno
-
-$ORAP_NOMEM = 100001; # out of memory
-$ORAP_INVCSR = 100002; # invalid cursor supplied
-$ORAP_INVLDA = 100003; # invalid lda supplied
-$ORAP_NOSID = 100004; # couldn't set ORACLE_SID
-$ORAP_BADVAR = 100005; # bad colon variable sequence
-$ORAP_NUMVARS = 100006; # wrong number of colon variables
-$ORAP_NODATA = 100007; # statement does not return data
-
-
-# Oraperl debugging codes for $ora_debug
-# From version 2, you shouldn't really use these.
-
-$ODBG_EXEC = 8; # program execution
-$ODBG_STRNUM = 32; # string/numeric conversions
-$ODBG_MALLOC = 128; # memory allocation/release
-
-# Oracle datatypes
-# I don't know whether these are valid for all versions.
-
-%ora_types =
-(
- 1, 'character array',
- 2, 'number',
- 3, 'signed integer',
- 4, 'float',
- 7, 'packed decimal',
- 8, 'long string',
- 9, 'varchar',
- 11, 'rowid',
- 12, 'date',
- 15, 'varraw',
- 23, 'raw',
- 24, 'long raw',
- 96, 'char',
- 106,'mlslabel',
-);
-
-1;
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+use Test::More 0.88;
+# This is a relatively nice way to avoid Test::NoWarnings breaking our
+# expectations by adding extra tests, without using no_plan. It also helps
+# avoid any other test module that feels introducing random tests, or even
+# test plans, is a nice idea.
+our $success = 0;
+END { $success && done_testing; }
+
+# List our own version used to generate this
+my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.10\n";
+
+eval { # no excuses!
+ # report our Perl details
+ my $want = '5.006';
+ $v .= "perl: $] (wanted $want) on $^O from $^X\n\n";
+};
+defined($@) and diag("$@");
+
+# Now, our module version dependencies:
+sub pmver {
+ my ($module, $wanted) = @_;
+ $wanted = " (want $wanted)";
+ my $pmver;
+ eval "require $module;";
+ if ($@) {
+ if ($@ =~ m/Can't locate .* in \@INC/) {
+ $pmver = 'module not found.';
+ } else {
+ diag("${module}: $@");
+ $pmver = 'died during require.';
+ }
+ } else {
+ my $version;
+ eval { $version = $module->VERSION; };
+ if ($@) {
+ diag("${module}: $@");
+ $pmver = 'died during VERSION check.';
+ } elsif (defined $version) {
+ $pmver = "$version";
+ } else {
+ $pmver = '<undef>';
+ }
+ }
+
+ # So, we should be good, right?
+ return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n");
+}
+
+eval { $v .= pmver('B','any version') };
+eval { $v .= pmver('Carp','any version') };
+eval { $v .= pmver('DBI','1.51') };
+eval { $v .= pmver('Data::Dumper','any version') };
+eval { $v .= pmver('Devel::Peek','any version') };
+eval { $v .= pmver('DynaLoader','any version') };
+eval { $v .= pmver('Encode','any version') };
+eval { $v .= pmver('Exporter','any version') };
+eval { $v .= pmver('ExtUtils::MakeMaker','6.30') };
+eval { $v .= pmver('Math::BigInt','any version') };
+eval { $v .= pmver('Test::More','0.88') };
+eval { $v .= pmver('Thread::Semaphore','any version') };
+eval { $v .= pmver('lib','any version') };
+eval { $v .= pmver('strict','any version') };
+eval { $v .= pmver('utf8','any version') };
+eval { $v .= pmver('vars','any version') };
+eval { $v .= pmver('warnings','any version') };
+
+
+# All done.
+$v .= <<'EOT';
+
+Thanks for using my code. I hope it works for you.
+If not, please try and include this output in the bug report.
+That will help me reproduce the issue and solve your problem.
+
+EOT
+
+diag($v);
+ok(1, "we really didn't test anything, just reporting data");
+$success = 1;
+
+# Work around another nasty module on CPAN. :/
+no warnings 'once';
+$Template::Test::NO_FLUSH = 1;
+exit 0;
@@ -0,0 +1,45 @@
+# reports on all interesting versions
+
+use strict;
+use warnings;
+
+use lib 't';
+
+use Test::More tests => 2;
+
+use DBD::Oracle qw/ ORA_OCI /;
+require 'nchar_test_lib.pl';
+
+my $oci_version = ORA_OCI();
+
+diag "OCI client library version: ", $oci_version;
+
+ok $oci_version;
+
+SKIP: {
+ my $dsn = oracle_test_dsn();
+ my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+ my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }) or
+ note <<'END_NOTE' or skip q{can't connect to database} => 1;
+
+Can't connect to an Oracle instance.
+
+Without a database connection, most of DBD::Oracle's test suite will
+be skipped. To let the tests use a database, set up the
+environment variables ORACLE_USERID and ORACLE_DSN. E.g.:
+
+ $ export ORACLE_USERID='scott/tiger'
+ $ export ORACLE_DSN='dbi:Oracle:testdb'
+
+END_NOTE
+
+ my $sth = $dbh->prepare( q{select * from v$version where banner like 'Oracle%'} );
+ $sth->execute;
+
+ my $version = join ' ', $sth->fetchrow;
+
+ diag 'database version: ', $version;
+
+ ok $version;
+}
@@ -0,0 +1,33 @@
+#!perl -w
+
+use strict;
+use warnings;
+
+# Base DBD Driver Test
+use Test::More tests => 6;
+
+require_ok('DBI');
+
+eval {
+ import DBI;
+};
+
+is $@ => '', 'successfully import DBI';
+
+is ref DBI->internal => 'DBI::dr', 'internal';
+
+my $drh = eval {
+ # This is a special case. install_driver should not normally be used.
+ DBI->install_driver('Oracle');
+};
+
+is $@ => '', 'install_driver'
+ or diag "Failed to load Oracle extension and/or shared libraries";
+
+SKIP: {
+ skip 'install_driver failed - skipping remaining', 2 if $@;
+
+ is ref $drh => 'DBI::dr', 'install_driver';
+
+ ok $drh->{Version}, 'version';
+}
@@ -0,0 +1,131 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use DBI;
+use Config;
+use DBD::Oracle qw(ORA_OCI);
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+my $dbh = DBI->connect($dsn, $dbuser, '',
+ {
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => 28;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+my($sth, $p1, $p2, $tmp);
+SKIP: {
+ skip "not unix-like", 2 unless $Config{d_semctl};
+
+ my @ora_oci_version = split /\./, ORA_OCI();
+ skip 'solaris with OCI>9.x', 2
+ if $^O eq 'solaris' and $ora_oci_version[0] > 9;
+
+ # basic check that we can fork subprocesses and wait for the status
+ # after having connected to Oracle
+
+ # at some point, this should become a subtest
+
+ my $success = is system("exit 1;"), 1<<8, 'system exit 1 should return 256';
+ $success &&= is system("exit 0;"), 0, 'system exit 0 should return 0';
+
+ unless ( $success ) {
+ diag <<END_NOTE;
+The test might have failed because you are using a
+a bequeather to connect to the server.
+
+If you need to continue using a bequeather to connect to a server on the
+same host as the client add
+
+ bequeath_detach = yes
+
+to your sqlnet.ora file or you won't be able to safely use fork/system
+functions in Perl.
+
+END_NOTE
+
+ }
+
+}
+
+$sth = $dbh->prepare(q{
+ /* also test preparse doesn't get confused by ? :1 */
+ /* also test placeholder binding is case insensitive */
+ select :a, :A from user_tables -- ? :1
+});
+ok($sth->{ParamValues}, 'preparse, case insensitive, placeholders in comments');
+is(keys %{$sth->{ParamValues}}, 1, 'number of parameters');
+is($sth->{NUM_OF_PARAMS}, 1, 'expected number of parameters');
+ok($sth->bind_param(':a', 'a value'), 'bind_param for select parameter');
+ok($sth->execute, 'execute for select parameter');
+ok($sth->{NUM_OF_FIELDS}, 'NUM_OF_FIELDS');
+eval {
+ local $SIG{__WARN__} = sub { die @_ }; # since DBI 1.43
+ $p1=$sth->{NUM_OFFIELDS_typo};
+};
+ok($@ =~ /attribute/, 'unrecognised attribute');
+ok($sth->{Active}, 'statement is active');
+ok($sth->finish, 'finish');
+ok(!$sth->{Active}, 'statement is not active');
+
+$sth = $dbh->prepare("select * from user_tables");
+ok($sth->execute, 'execute for user_tables');
+ok($sth->{Active}, 'active for user_tables');
+1 while ($sth->fetch); # fetch through to end
+ok(!$sth->{Active}, 'user_tables not active after fetch');
+
+# so following test works with other NLS settings/locations
+ok($dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"),
+ 'set NLS_NUMERIC_CHARACTERS');
+
+ok($tmp = $dbh->selectall_arrayref(q{
+ select 1 * power(10,-130) "smallest?",
+ 9.9999999999 * power(10,125) "biggest?"
+ from dual
+}), 'select all for arithmetic');
+my @tmp = @{$tmp->[0]};
+#warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp";
+ok($tmp[0] <= 1.0000000000000000000000000000000001e-130, "tmp0=$tmp[0]");
+ok($tmp[1] >= 9.99e+125, "tmp1=$tmp[1]");
+
+
+my $warn='';
+eval {
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 1;
+ $dbh->do("some invalid sql statement");
+};
+ok($@ =~ /DBD::Oracle::db do failed:/, "eval error: ``$@'' expected 'do failed:'");
+#print "''$warn''";
+ok($warn =~ /DBD::Oracle::db do failed:/, "warn error: ``$warn'' expected 'do failed:'");
+ok($DBI::err, 'err defined');
+$dbh->{RaiseError} = 0;
+$dbh->{PrintError} = 0;
+# ---
+
+ok( $dbh->ping, 'ping - connected');
+
+my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar
+note sprintf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci;
+
+ok("$ora_oci", 'ora_oci defined');
+ok($ora_oci >= 8, "ora_oci $ora_oci >= 8");
+my @ora_oci = split(/\./, $ora_oci,-1);
+ok(scalar @ora_oci >= 2, 'version has 2 or more components');
+ok((scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci),
+ 'version looks like numbers');
+is($ora_oci[0], int($ora_oci), 'first number is int');
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+$| = 1;
+
+## ----------------------------------------------------------------------------
+## 12imptdata.t
+## By Jeffrey Klein,
+## ----------------------------------------------------------------------------
+
+use strict;
+use DBI;
+use Config qw(%Config);
+# must be done before Test::More - see Threads in Test::More pod
+BEGIN { eval "use threads; use threads::shared;" }
+my $use_threads_err = $@;
+use Test::More;
+
+BEGIN {
+ if ($DBI::VERSION <= 1.601){
+ plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later.";
+ }
+ die $use_threads_err if $use_threads_err; # need threads
+}
+
+unshift @INC, 't';
+require 'nchar_test_lib.pl';
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect( $dsn, $dbuser, '', {
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => 7;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+my $drh = $dbh->{Driver};
+my ($sess_1) = $dbh->selectrow_array("select userenv('sessionid') from dual");
+
+is $drh->{Kids}, 1, "1 kid";
+is $drh->{ActiveKids}, 1, "1 active kid";
+
+my $imp_data = $dbh->take_imp_data;
+is $drh->{Kids}, 0, "no kids";
+is $drh->{ActiveKids}, 0, "no active kids";
+
+$dbh = DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } );
+my ($sess_2) = $dbh->selectrow_array("select userenv('sessionid') from dual");
+is $sess_1, $sess_2, "got same session";
+
+is $drh->{Kids}, 1, "1 kid";
+is $drh->{ActiveKids}, 1, "1 active kid";
+
+__END__
@@ -0,0 +1,187 @@
+#!/usr/bin/perl
+$| = 1;
+
+## ----------------------------------------------------------------------------
+## 14threads.t
+## By Jeffrey Klein,
+## ----------------------------------------------------------------------------
+
+BEGIN { eval "use threads; use threads::shared;" }
+my $use_threads_err = $@;
+use DBI;
+use Config qw(%Config);
+use Test::More;
+
+BEGIN {
+ if ( !$Config{useithreads} || $] < 5.008 ) {
+ plan skip_all => "this $^O perl $] not configured to support iThreads";
+ } elsif ($DBI::VERSION <= 1.601){
+ plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later.";
+ }
+ die $use_threads_err if $use_threads_err; # need threads
+}
+
+use strict;
+use DBI;
+
+use Test::More;
+
+unshift @INC, 't';
+require 'nchar_test_lib.pl';
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '',{
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => 19;
+ $dbh->disconnect;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+my $last_session : shared;
+our @pool : shared;
+
+# run five threads in sequence
+# each should get the same session
+
+# TESTS: 5
+
+for my $i ( 0 .. 4 ) {
+ threads->create(
+ sub {
+ my $dbh = get_dbh_from_pool();
+
+ my $session = session_id($dbh);
+
+ if ( $i > 0 ) {
+ is $session, $last_session,
+ "session $i matches previous session";
+ } else {
+ ok $session, "session $i created",
+ }
+
+ $last_session = $session;
+ free_dbh_to_pool($dbh);
+ }
+ )->join;
+
+
+}
+
+# TESTS: 1
+is scalar(@pool), 1, 'one imp_data in pool';
+
+# get two sessions in same thread
+# TESTS: 2
+threads->create(
+ sub {
+ my $dbh1 = get_dbh_from_pool();
+ my $s1 = session_id($dbh1);
+
+ my $dbh2 = get_dbh_from_pool();
+ my $s2 = session_id($dbh2);
+
+ ok $s1 ne $s2, 'thread gets two separate sessions';
+
+ free_dbh_to_pool($dbh1);
+
+ my $dbh3 = get_dbh_from_pool();
+ my $s3 = session_id($dbh3);
+
+ is $s3, $s1, 'get same session after free';
+
+ free_dbh_to_pool($dbh2);
+ free_dbh_to_pool($dbh3);
+ }
+)->join;
+
+# TESTS: 1
+is scalar(@pool), 2, 'two imp_data in pool';
+
+#trade dbh between threads
+my @thr;
+my @sem;
+use Thread::Semaphore;
+
+# create locked semaphores
+for my $i (0..2) {
+ push @sem, Thread::Semaphore->new(0);
+}
+
+undef $last_session;
+
+# 3 threads, 3 iterations
+# TESTS: 9
+for my $t ( 0..2 ) {
+ $thr[$t] = threads->create(
+ sub {
+ my $partner = ( $t + 1 ) % 3;
+
+ for my $i ( 1 .. 3 ) {
+ $sem[$t]->down;
+
+ my $dbh = get_dbh_from_pool();
+ my $session = session_id($dbh);
+ if ( defined $last_session ) {
+ is $session, $last_session,
+ "thread $t, loop $i matches previous session";
+ } else {
+ ok $session,
+ "thread $t, loop $i created session";
+ }
+ $last_session = $session;
+ free_dbh_to_pool($dbh);
+
+ # signal next thread
+ $sem[$partner]->up;
+ }
+ }
+ );
+}
+
+# start thread 0!
+$sem[0]->up;
+
+$_->join for @thr;
+
+# TESTS: 1
+empty_pool();
+
+is scalar(@pool), 0, 'pool empty';
+
+exit;
+
+sub get_dbh_from_pool {
+ my $imp = pop @pool;
+
+ # if pool is empty, $imp is undef
+ # in that case, get new dbh
+ return connect_dbh($imp);
+}
+
+sub free_dbh_to_pool {
+ my $imp = $_[0]->take_imp_data or return;
+ push @pool, $imp;
+}
+
+sub empty_pool {
+ get_dbh_from_pool() while @pool;
+}
+
+sub connect_dbh {
+ my $imp_data = shift;
+ my $dsn = oracle_test_dsn();
+ my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+ DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } );
+}
+
+sub session_id {
+ my $dbh = shift;
+ my ($s) = $dbh->selectrow_array("select userenv('sessionid') from dual");
+ return $s;
+}
+__END__
@@ -0,0 +1,48 @@
+#!perl
+use strict;
+use warnings;
+
+use DBI;
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $testcount = 9;
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+my $dbh = DBI->connect($dsn, $dbuser, '',{
+ PrintError => 0,
+ });
+if ($dbh) {
+ plan tests => $testcount;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+my ($nls_parameters_before, $nls_parameters_after);
+my $old_date_format = 'HH24:MI:SS DD/MM/YYYY';
+my $new_date_format = 'YYYYMMDDHH24MISS';
+
+ok($dbh->do("alter session set nls_date_format='$old_date_format'"), 'set date format');
+
+like($dbh->ora_can_unicode, qr/^[0123]/, 'ora_can_unicode');
+
+ok($nls_parameters_before = $dbh->ora_nls_parameters, 'fetch ora_nls_parameters');
+is(ref($nls_parameters_before), 'HASH', 'check ora_nls_parameters returned hashref');
+is($nls_parameters_before->{'NLS_DATE_FORMAT'}, $old_date_format, 'check returned nls_date_format');
+
+ok($dbh->do("alter session set nls_date_format='$new_date_format'"), 'alter date format');
+ok(eq_hash($nls_parameters_before, $dbh->ora_nls_parameters), 'check ora_nls_parameters caches old values');
+
+$nls_parameters_before->{NLS_DATE_FORMAT} = 'foo';
+isnt($nls_parameters_before->{NLS_DATE_FORMAT},
+ $dbh->ora_nls_parameters->{NLS_DATE_FORMAT}, 'check ora_nls_parameters returns a copy');
+
+is($dbh->ora_nls_parameters(1)->{'NLS_DATE_FORMAT'}, $new_date_format, 'refetch and check new nls_date_format value');
+
+__END__
@@ -0,0 +1,173 @@
+#!perl -w
+use Test::More;
+use DBI;
+use DBD::Oracle qw(:ora_types ORA_OCI);
+use Data::Dumper;
+use Math::BigInt;
+use strict;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my @test_sets = (
+ [ "CHAR(10)", 10 ],
+ [ "VARCHAR(10)", 10 ],
+ [ "VARCHAR2(10)", 10 ],
+);
+
+# Set size of test data (in 10KB units)
+# Minimum value 3 (else tests fail because of assumptions)
+# Normal value 8 (to test 64KB threshold well)
+my $sz = 8;
+
+my $tests = 3;
+my $tests_per_set = 11;
+$tests += @test_sets * $tests_per_set;
+
+my $t = 0;
+my $failed = 0;
+my %ocibug;
+my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');
+
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', {
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests=>$tests;
+} else {
+ plan skip_all => "Unable to connect to oracle\n";
+}
+
+# test simple select statements with [utf8]
+
+my $utf8_test = ($] >= 5.006)
+ && client_ochar_is_utf8() # for correct output (utf8 bind vars should be fine regardless)
+ && ($dbh->ora_can_unicode() & 2);
+diag("Including unicode data in test") if $utf8_test;
+
+unless(create_test_table("str CHAR(10)", 1)) {
+ BAIL_OUT("Unable to create test table ($DBI::errstr)\n");
+ print "1..0\n";
+ exit 0;
+}
+
+my($sth, $p1, $p2, $tmp, @tmp);
+
+foreach (@test_sets) {
+ run_select_tests( @$_ );
+}
+
+my $ora_server_version = $dbh->func("ora_server_version");
+SKIP: {
+ skip "Oracle < 10", 1 if ($ora_server_version->[0] < 10);
+ my $data = $dbh->selectrow_array(q!
+ select to_dsinterval(?) from dual
+ !, {}, "1 07:00:00");
+ ok ((defined $data and $data eq '+000000001 07:00:00.000000000'),
+ "ds_interval");
+ }
+
+if (0) {
+ # UNION ALL causes Oracle 9 (not 8) to describe col1 as zero length
+ # causing "ORA-24345: A Truncation or null fetch error occurred" error
+ # Looks like an Oracle bug
+ $dbh->trace(9);
+ ok 0, $sth = $dbh->prepare(qq{
+ SELECT :HeadCrncy FROM DUAL
+ UNION ALL
+ SELECT :HeadCrncy FROM DUAL});
+ $dbh->trace(0);
+ ok 0, $sth->execute("EUR");
+ ok 0, $tmp = $sth->fetchall_arrayref;
+ use Data::Dumper;
+ die Dumper $tmp;
+}
+
+
+# $dbh->{USER} is just there so it works for old DBI's before Username was added
+my @pk = $dbh->primary_key(undef, $dbh->{USER}||$dbh->{Username}, uc $table);
+ok(@pk, 'primary key on table');
+is(join(",",@pk), 'DT,IDX', 'DT,IDX');
+
+exit 0;
+
+END {
+ $dbh->do(qq{ drop table $table }) if $dbh;
+}
+
+sub run_select_tests {
+ my ($type_name, $field_len) = @_;
+
+ my $data0;
+ if ($utf8_test) {
+ $data0 = eval q{ "0\x{263A}xyX" }; #this includes the smiley from perlunicode (lab) BTW: it is busted
+ } else {
+ $data0 = "0\177x\0X";
+ }
+ my $data1 = "1234567890";
+ my $data2 = "2bcdefabcd";
+
+ SKIP: {
+ if (!create_test_table("lng $type_name", 1)) {
+ # typically OCI 8 client talking to Oracle 7 database
+ diag("Unable to create test table for '$type_name' data ($DBI::err)");
+ skip $tests_per_set;
+ }
+
+ $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)");
+ ok($sth, "prepare for insert of $type_name");
+ ok($sth->execute(40, $data0), "insert 8bit or utf8");
+ ok($sth->execute(Math::BigInt->new(41), $data1), 'bind overloaded value');
+ ok($sth->execute(42, $data2), "insert data2");
+
+ ok(!$sth->execute(43, "12345678901234567890"), 'insert string too long');
+
+ ok($sth = $dbh->prepare("select * from $table order by idx"),
+ "prepare select ordered by idx");
+ ok($sth->execute, "execute");
+ # allow for padded blanks
+ $sth->{ChopBlanks} = 1;
+ ok($tmp = $sth->fetchall_arrayref, 'fetchall');
+ my $dif;
+ if ($utf8_test) {
+ $dif = DBI::data_diff($tmp->[0][1], $data0);
+ ok(!defined($dif) || $dif eq '', 'first row matches');
+ diag($dif) if $dif;
+ } else {
+ is($tmp->[0][1], $data0, 'first row matches');
+ }
+ is($tmp->[1][1], $data1, 'second row matches');
+ is($tmp->[2][1], $data2, 'third row matches');
+
+ }
+} # end of run_select_tests
+
+# end.
+
+
+sub create_test_table {
+ my ($fields, $drop) = @_;
+ my $sql = qq{create table $table (
+ idx integer,
+ $fields,
+ dt date,
+ primary key (dt, idx)
+ )};
+ $dbh->do(qq{ drop table $table }) if $drop;
+ $dbh->do($sql);
+ if ($dbh->err && $dbh->err==955) {
+ $dbh->do(qq{ drop table $table });
+ warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err;
+ $dbh->do($sql);
+ }
+ return 0 if $dbh->err;
+ return 1;
+}
+
+__END__
@@ -0,0 +1,68 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR );
+
+my $dbh;
+$| = 1;
+SKIP: {
+ plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 );
+
+ $dbh = db_handle();
+ # $dbh->{PrintError} = 1;
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+
+ note("testing control and 8 bit chars:\n") ;
+ note(" Database and client versions and character sets:\n");
+ show_db_charsets( $dbh);
+
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+ # get the database NCHARSET before we begin... if it is not UTF, then
+ # use it as the client side ncharset, otherwise, use WE8ISO8859P1
+ my $ncharset = $dbh->ora_nls_parameters()->{'NLS_NCHAR_CHARACTERSET'};
+ $dbh->disconnect(); # we want to start over with the ncharset we select
+ undef $dbh;
+
+ if ( $ncharset =~ m/UTF/i ) {
+ $ncharset = 'WE8ISO8859P1' ; #WE8MSWIN1252
+ }
+ set_nls_nchar( $ncharset ,1 );
+ $dbh = db_handle();
+
+ my $tdata = test_data( 'narrow_nchar' );
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount ;
+ show_test_data( $tdata ,0 );
+
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'nch' ,'descr' );
+ select_rows( $dbh, $tdata );
+# view_with_sqlplus(1,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW};
+# view_with_sqlplus(0,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW};
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
+__END__
+
@@ -0,0 +1,51 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dbh;
+$| = 1;
+SKIP: {
+
+ plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+ set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 );
+ $dbh = db_handle();
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ;
+ print "testing utf8 with nchar columns\n" ;
+
+ show_db_charsets( $dbh );
+ my $tdata = test_data( 'wide_nchar' );
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount;
+ show_test_data( $tdata ,0 );
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'nch' ,'descr' );
+ select_rows( $dbh, $tdata );
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
@@ -0,0 +1,58 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dbh;
+$| = 1;
+SKIP: {
+
+ plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+ set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8' ,1 );
+ $dbh = db_handle();
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ;
+
+ # testing utf8 with nchar columns
+
+ show_db_charsets( $dbh );
+ my $tdata = test_data( 'wide_nchar' );
+
+ if ( $dbh->ora_can_unicode & 1 ) {
+ push( @{$tdata->{rows}} ,extra_wide_rows() ) ;
+ # added 2 rows with extra wide chars to test data
+ }
+
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount;
+ show_test_data( $tdata ,0 );
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'nch' ,'descr' );
+ select_rows( $dbh, $tdata );
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
@@ -0,0 +1,54 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dbh;
+$| = 1;
+SKIP: {
+
+ plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+#! #force Ncharset to NON UTF8! we are testing a wide database where someone
+#! #perversely sets nchar to non utf8, and nls_lang to utf8....
+ set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 );
+#! #set_nls_nchar( 'WE8ISO8859P1' ,1 ); #it breaks and it is stupid to do this... doc it XXX
+ $dbh = db_handle();
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ;
+
+ # testing utf8 with char columns (wide mode database)
+
+ my $tdata = test_data( 'wide_char' );
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount;
+ show_test_data( $tdata ,0 );
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'ch' ,'descr' );
+ select_rows( $dbh, $tdata );
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
@@ -0,0 +1,51 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dbh;
+$| = 1;
+SKIP: {
+
+ plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+ set_nls_lang_charset( 'WE8MSWIN1252' ,1 );
+ $dbh = db_handle();
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ;
+ print "testing utf8 with char columns (wide mode database)\n" ;
+
+ my $tdata = test_data( 'narrow_char' );
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount;
+ show_test_data( $tdata ,0 );
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'ch' ,'descr' );
+ select_rows( $dbh, $tdata );
+}
+
+END {
+ local($?, $!);
+ eval {
+ local $dbh->{PrintError} = 0 if $dbh;
+ drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
@@ -0,0 +1,51 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dbh;
+$| = 1;
+SKIP: {
+
+ plan skip_all => "Unable to run unicode test, perl version is less than 5.6"
+ unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+ set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 );
+ $dbh = db_handle();
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ;
+ # testing utf8 with char columns (wide mode database)
+
+ my $tdata = test_data( 'wide_char' );
+ my $testcount = 0 #create table
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ plan tests => $testcount;
+ show_test_data( $tdata ,0 );
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata ,SQLCS_NCHAR);
+ dump_table( $dbh ,'ch' ,'descr' );
+ select_rows( $dbh, $tdata );
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
@@ -0,0 +1,64 @@
+#!perl -w
+#written by Lincoln A Baxter (lab@lincolnbaxter.com)
+
+use strict;
+#use warnings;
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+use DBI qw(:sql_types);
+use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR );
+
+my $dbh;
+$| = 1;
+SKIP: {
+ plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 );
+ plan skip_all => "Oracle charset tests unreliable for Oracle 8 client"
+ if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+ $dbh = db_handle(); # just to check connection and db NCHAR character set
+
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ;
+ plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh);
+ $dbh->disconnect();
+
+ # testing implicit csform (dbhimp.c sets csform implicitly)
+ my $tdata = test_data( 'wide_nchar' );
+ my $testcount = 0
+ + insert_test_count( $tdata )
+ + select_test_count( $tdata ) * 1;
+ ;
+
+ my @nchar_cset = (ORA_OCI >= 9.2) ? qw(UTF8 AL32UTF8) : qw(UTF8);
+ plan tests => $testcount * @nchar_cset;
+ show_test_data( $tdata ,0 );
+
+ foreach my $nchar_cset (@nchar_cset) {
+ $dbh->disconnect() if $dbh;
+ undef $dbh;
+ # testing with NLS_NCHAR=$nchar_cset
+ SKIP: {
+ set_nls_nchar( $nchar_cset ,1 );
+ $dbh = db_handle();
+ show_db_charsets($dbh);
+ skip "failed to connect to oracle with NLS_NCHAR=$nchar_cset" ,$testcount if not $dbh;
+ drop_table($dbh);
+ create_table( $dbh, $tdata );
+ insert_rows( $dbh, $tdata );
+ dump_table( $dbh ,'nch' ,'descr' );
+ select_rows( $dbh, $tdata );
+ }
+ }
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
+__END__
+
@@ -0,0 +1,339 @@
+#!perl -w
+use Test::More;
+
+use DBI;
+use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
+use strict;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 });
+
+if ($dbh) {
+ # ORA-00900: invalid SQL statement
+ # ORA-06553: PLS-213: package STANDARD not accessible
+ my $tst = $dbh->prepare(q{declare foo char(50); begin RAISE INVALID_NUMBER; end;});
+ if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) {
+ diag("Your Oracle server doesn't support PL/SQL") if $dbh->err== 900;
+ diag("Your Oracle PL/SQL is not properly installed")
+ if $dbh->err==6553||$dbh->err==600;
+ plan skip_all => 'Oracle server either does not support pl/sql or it is not properly installed';
+ }
+ plan tests=>82;
+} else {
+ plan skip_all => "Unable to connect to Oracle \n";
+}
+
+
+my($csr, $p1, $p2, $tmp, @tmp);
+#DBI->trace(4,"trace.log");
+
+
+# --- test raising predefined exception
+ok($csr = $dbh->prepare(q{
+ begin RAISE INVALID_NUMBER; end;}), 'prepare raising predefined exception');
+
+# ORA-01722: invalid number
+ok(! $csr->execute, 'execute predefined exception');
+is($DBI::err, 1722, 'err expected 1722 error');
+is($DBI::err, 1722, 'err does not get cleared');
+
+
+# --- test raising user defined exception
+ok($csr = $dbh->prepare(q{
+ DECLARE FOO EXCEPTION;
+ begin raise FOO; end;}), 'prepare user defined expcetion');
+
+# ORA-06510: PL/SQL: unhandled user-defined exception
+ok(! $csr->execute, 'execute user defined exception');
+is($DBI::err, 6510, 'user exception 6510 error');
+
+
+# --- test raise_application_error with literal values
+ok($csr = $dbh->prepare(q{
+ declare err_num number; err_msg char(510);
+ begin RAISE_APPLICATION_ERROR(-20101,'app error'); end;}),
+ 'prepare raise application error with literal values');
+
+# ORA-20101: app error
+ok(! $csr->execute, 'execite raise application error with literal values');
+is($DBI::err, 20101, 'expected 20101 error');
+like($DBI::errstr, qr/app error/, 'app error');
+
+
+# --- test raise_application_error with 'in' parameters
+ok($csr = $dbh->prepare(q{
+ declare err_num varchar2(555); err_msg varchar2(510);
+ --declare err_num number; err_msg char(510);
+ begin
+ err_num := :1;
+ err_msg := :2;
+ raise_application_error(-20000-err_num, 'msg is '||err_msg);
+ end;
+}), 'prepare raise application error with in params');
+
+ok(! $csr->execute(42, "hello world"),
+ 'execute raise application error with in params');
+is($DBI::err, 20042, 'expected 20042 error');
+like($DBI::errstr, qr/msg is hello world/, 'hello world msg');
+
+# --- test named numeric in/out parameters
+ok($csr = $dbh->prepare(q{
+ begin
+ :arg := :arg * :mult;
+ end;}), 'prepare named numeric in/out params');
+
+$p1 = 3;
+ok($csr->bind_param_inout(':arg', \$p1, 50), 'bind arg');
+ok($csr->bind_param(':mult', 2), 'bind mult');
+ok($csr->execute, 'execute named numeric in/out params');
+is($p1, 6, 'expected 3 * 3 = 6');
+# execute 10 times from $p1=1, 2, 4, 8, ... 1024
+$p1 = 1;
+eval {
+ foreach (1..10) { $csr->execute || die $DBI::errstr; };
+};
+my $ev = $@;
+ok(!$ev, 'execute named numeric in/out params 10 times');
+is($p1, 1024, 'expected p1 = 1024');
+
+# --- test undef parameters
+ok($csr = $dbh->prepare(q{
+ declare foo char(500);
+ begin foo := :arg; end;}), 'prepare undef parameters');
+my $undef;
+ok($csr->bind_param_inout(':arg', \$undef,10), 'bind arg');
+ok($csr->execute, 'execute undef parameters');
+
+# --- test named string in/out parameters
+ok($csr = $dbh->prepare(q{
+ declare str varchar2(1000);
+ begin
+ :arg := nvl(upper(:arg), 'null');
+ :arg := :arg || :append;
+ end;}), 'prepare named string in/out parameters');
+
+undef $p1;
+$p1 = "hello world";
+ok($csr->bind_param_inout(':arg', \$p1, 1000), 'bind arg');
+ok($csr->bind_param(':append', "!"), 'bind append');
+ok($csr->execute, 'execute named string in/out parameters');
+is($p1, "HELLO WORLD!", 'expected HELLO WORLD');
+# execute 10 times growing $p1 to force realloc
+eval {
+ foreach (1..10) {
+ $p1 .= " xxxxxxxxxx";
+ $csr->execute || die $DBI::errstr;
+ };
+};
+$ev = $@;
+ok(!$ev, 'execute named string in/out parameters 1- times');
+my $expect = "HELLO WORLD!" . (" XXXXXXXXXX!" x 10);
+is($p1, $expect, 'p1 as expected');
+
+# --- test binding a null and getting a string back
+undef $p1;
+ok($csr->execute, 'execute binding a null');
+is($p1, 'null!', 'get a null string back');
+
+$csr->finish;
+
+
+ok($csr = $dbh->prepare(q{
+ begin
+ :out := nvl(upper(:in), 'null');
+ end;}), 'prepare nvl');
+#$csr->trace(3);
+my $out;
+ok($csr->bind_param_inout(':out', \$out, 1000), 'bind out');
+ok($csr->bind_param(':in', "foo", DBI::SQL_CHAR()), 'bind in');
+ok($csr->execute, 'execute nvl');
+is($out, "FOO", 'expected FOO');
+
+ok($csr->bind_param(':in', ""), 'bind empty string');
+ok($csr->execute, 'execute empty string');
+is($out, "null", 'returned null string');
+
+# --- test out buffer being too small
+ok($csr = $dbh->prepare(q{
+ begin
+ select rpad('foo',200) into :arg from dual;
+ end;}), 'prepare test output buffer too small');
+#$csr->trace(3);
+undef $p1; # force buffer to be freed
+ok($csr->bind_param_inout(':arg', \$p1, 20), 'bind arg');
+# Execute fails with:
+# ORA-06502: PL/SQL: numeric or value error
+# ORA-06512: at line 3 (DBD ERROR: OCIStmtExecute)
+$tmp = $csr->execute;
+#$tmp = undef if DBD::Oracle::ORA_OCI()>=8; # because BindByName given huge max len
+ok(!defined $tmp, 'output buffer too small');
+# rebind with more space - and it should work
+ok($csr->bind_param_inout(':arg', \$p1, 200), 'rebind arg with more space');
+ok($csr->execute, 'execute rebind with more space');
+is(length($p1), 200, 'expected return length');
+
+
+# --- test plsql_errstr function
+#$csr = $dbh->prepare(q{
+# create or replace procedure perl_dbd_oracle_test as
+# begin
+# procedure filltab( stuff out tab ); asdf
+# end;
+#});
+#ok(0, ! $csr);
+#if ($dbh->err && $dbh->err == 6550) { # PL/SQL error
+# warn "errstr: ".$dbh->errstr;
+# my $msg = $dbh->func('plsql_errstr');
+# warn "plsql_errstr: $msg";
+# ok(0, $msg =~ /Encountered the symbol/, "plsql_errstr: $msg");
+#}
+#else {
+# warn "plsql_errstr test skipped ($DBI::err)\n";
+# ok(0, 1);
+#}
+#die;
+
+# --- test dbms_output_* functions
+$dbh->{PrintError} = 1;
+ok($dbh->func(30000, 'dbms_output_enable'), 'dbms_output_enable');
+
+#$dbh->trace(3);
+my @ary = ("foo", ("bar" x 15), "baz", "boo");
+ok($dbh->func(@ary, 'dbms_output_put'), 'dbms_output_put');
+
+@ary = scalar $dbh->func('dbms_output_get'); # scalar context
+ok(@ary==1 && $ary[0] && $ary[0] eq 'foo', 'dbms_output_get foo');
+
+@ary = scalar $dbh->func('dbms_output_get'); # scalar context
+ok(@ary==1 && $ary[0] && $ary[0] eq 'bar' x 15, 'dbms_output_get bar');
+
+@ary = $dbh->func('dbms_output_get'); # list context
+is(join(':',@ary), 'baz:boo', 'dbms_output_get baz:boo');
+$dbh->{PrintError} = 0;
+#$dbh->trace(0);
+
+# --- test cursor variables
+if (1) {
+ my $cur_query = q{
+ SELECT object_name, owner
+ FROM all_objects
+ WHERE object_name LIKE :p1
+ ORDER BY object_name
+ };
+ my $cur1 = 42;
+ #$dbh->trace(4);
+ my $parent = $dbh->prepare(qq{
+ BEGIN OPEN :cur1 FOR $cur_query; END;
+ });
+ ok($parent, 'prepare cursor');
+ ok($parent->bind_param(":p1", "V%"), 'bind p1');
+ ok($parent->bind_param_inout(
+ ":cur1", \$cur1, 0, { ora_type => ORA_RSET }), 'bind cursor');
+ ok($parent->execute(), 'execute for cursor');
+ my @r;
+ push @r, @tmp while @tmp = $cur1->fetchrow_array;
+ ok(@r>0, "rows: ".@r);
+ #$dbh->trace(0); $parent->trace(0);
+
+ # compare results with normal execution of query
+ my $s1 = $dbh->selectall_arrayref($cur_query, undef, "V%");
+ my @s1 = map { @$_ } @$s1;
+ is("@r", "@s1", "ref = sql");
+
+ # --- test re-bind and re-execute of same 'parent' statement
+ my $cur1_str = "$cur1";
+ #$dbh->trace(4); $parent->trace(4);
+ ok($parent->bind_param(":p1", "U%"), 'bind p1');
+ ok($parent->execute(), 'execute for cursor');
+ # must be ref to new handle object
+ isnt("$cur1", $cur1_str, 'expected ref to new handle');
+ @r = ();
+ push @r, @tmp while @tmp = $cur1->fetchrow_array;
+ #$dbh->trace(0); $parent->trace(0); $cur1->trace(0);
+ my $s2 = $dbh->selectall_arrayref($cur_query, undef, "U%");
+ my @s2 = map { @$_ } @$s2;
+ is("@r", "@s2", "ref = sql");
+}
+
+# test bind_param_inout of param that's not assigned to in executed statement
+# See http://www.mail-archive.com/dbi-users@perl.org/msg18835.html
+my $sth = $dbh->prepare (q(
+ BEGIN
+ -- :p1 := :p1 ;
+ -- :p2 := :p2 ;
+ IF :p2 != :p3 THEN
+ :p1 := 'AAA' ;
+ :p2 := 'Z' ;
+ END IF ;
+END ;));
+
+{
+ my ($p1, $p2, $p3) = ('Hello', 'Y', 'Y') ;
+ $sth->bind_param_inout(':p1', \$p1, 30) ;
+ $sth->bind_param_inout(':p2', \$p2, 1) ;
+ $sth->bind_param_inout(':p3', \$p3, 1) ;
+ note("Before p1=[$p1] p2=[$p2] p3=[$p3]\n");
+ ok($sth->execute, 'test bind_param_inout for non assigned');
+ is($p1, 'Hello', 'p1 ok');
+ is($p2, 'Y', 'p2 ok');
+ is($p3, 'Y', 'p3 ok');
+ note("After p1=[$p1] p2=[$p2] p3=[$p3]\n");
+}
+
+SKIP: {
+ # test nvarchar2 arg passing to functions
+ # http://www.nntp.perl.org/group/perl.dbi.users/24217
+ my $ora_server_version = $dbh->func("ora_server_version");
+ skip "Client/server version < 9.0", 15
+ if DBD::Oracle::ORA_OCI() < 9.0 || $ora_server_version->[0] < 9;
+
+ my $func_name = "dbd_oracle_nvctest".($ENV{DBD_ORACLE_SEQ}||'');
+ $dbh->do(qq{
+ CREATE OR REPLACE FUNCTION $func_name(arg nvarchar2, arg2 nvarchar2)
+ RETURN int IS
+ BEGIN
+ if arg is null or arg2 is null then
+ return -1;
+ else
+ return 1;
+ end if;
+ END;
+ }) or skip "Can't create a function ($DBI::errstr)", 15;
+ my $sth = $dbh->prepare(qq{SELECT $func_name(?, ?) FROM DUAL}, {
+ # Oracle 8 describe fails with ORA-06553: PLS-561: charset mismatch
+ ora_check_sql => 0,
+ });
+ ok($sth, sprintf("Can't prepare select from function (%s)",$DBI::errstr||''));
+ skip "Can't select from function ($DBI::errstr)", 14 unless $sth;
+ for (1..2) {
+ ok($sth->bind_param(1, "foo", { ora_csform => SQLCS_NCHAR }),
+ 'bind foo');
+ ok($sth->bind_param(2, "bar", { ora_csform => SQLCS_NCHAR }),
+ 'bind bar');
+ ok($sth->execute(), 'execute');
+ ok(my($returnVal) = $sth->fetchrow_array, 'fetchrow returns value');
+ is($returnVal, "1", 'expected return value of 1');
+ }
+ ok($sth->execute("baz",undef), 'execute with baz');
+ ok(my($returnVal) = $sth->fetchrow_array, 'fetchrow_returns value');
+ is($returnVal, "-1", 'expected -1 return');
+ ok($dbh->do(qq{drop function $func_name}), "drop $func_name");
+}
+
+
+# --- To do
+ # test NULLs at first bind
+ # NULLs later binds.
+ # returning NULLs
+ # multiple params, mixed types and in only vs inout
+
+
+exit 0;
+
+__END__
@@ -0,0 +1,65 @@
+# $Id$
+# Completely new test for DBD::Oracle which came from DBD::ODBC
+# Author: Martin J. Evans
+#
+# loads of execute_array and execute_for_fetch tests using DBI's methods
+#
+use Test::More;
+use strict;
+use Data::Dumper;
+require 'nchar_test_lib.pl';
+
+use lib 't/lib', 't';
+
+$| = 1;
+
+my $has_test_nowarnings = eval "require Test::NoWarnings; 1";
+
+use DBI qw(:sql_types);
+use ExecuteArray;
+
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+$ENV{NLS_NCHAR} = "US7ASCII";
+$ENV{NLS_LANG} = "AMERICAN";
+
+my $dbh = eval {
+ DBI->connect($dsn, $dbuser, '', {PrintError => 0})
+} or plan skip_all => "Unable to connect to Oracle";
+
+my $ea = ExecuteArray->new($dbh, 1); # set odbc_disable_array_operations
+$dbh = $ea->dbh;
+
+$ea->drop_table($dbh);
+ok($ea->create_table($dbh), "create test table") or exit 1;
+
+$ea->simple($dbh, {array_context => 1, raise => 1});
+$ea->simple($dbh, {array_context => 0, raise => 1});
+$ea->error($dbh, {array_context => 1, raise => 1});
+$ea->error($dbh, {array_context => 0, raise => 1});
+$ea->error($dbh, {array_context => 1, raise => 0});
+$ea->error($dbh, {array_context => 0, raise => 0});
+
+$ea->row_wise($dbh, {array_context => 1, raise => 1});
+
+$ea->update($dbh, {array_context => 1, raise => 1});
+
+for my $raise ( 0..1 ) {
+ for my $context ( 0..1 ) {
+ $ea->error($dbh, {
+ array_context => $context,
+ raise => $raise,
+ notuplestatus => 1
+ });
+ }
+}
+
+if ($dbh && $ea) {
+ $ea->drop_table($dbh);
+ $dbh->disconnect();
+}
+
+Test::NoWarnings::had_no_warnings() if $has_test_nowarnings;
+
+done_testing;
@@ -0,0 +1,300 @@
+#!perl -w
+use strict;
+
+## ----------------------------------------------------------------------------
+## 26array_bind.t
+## By Alexander V Alekseev
+## and John Scoles, The Pythian Group
+##
+## ----------------------------------------------------------------------------
+## Checking bind_param_inout to an varchar2_table and number_table
+## Checking bind_param_inout_array with execute_array
+##
+## ----------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Encode;
+use Devel::Peek;
+
+use DBI;
+use DBD::Oracle qw(:ora_types ORA_OCI);
+
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+use Data::Dumper;
+
+$Data::Dumper::Useqq=1;
+
+my $dbh;
+
+my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8';
+my $eight_bit_charset = 'WE8ISO8859P1';
+
+sub db_connect($) {
+ my $utf8 = shift;
+
+ # Make sure we really are overriding the environment settings.
+ my ($charset, $ncharset);
+ if ($utf8) {
+ set_nls_lang_charset($eight_bit_charset);
+ set_nls_nchar($eight_bit_charset);
+ $charset = $utf8_charset;
+ $ncharset = $utf8_charset;
+ }
+ else {
+ set_nls_lang_charset($utf8_charset);
+ set_nls_nchar($utf8_charset);
+ $charset = $eight_bit_charset;
+ $ncharset = $eight_bit_charset;
+ }
+
+ my $dsn = oracle_test_dsn();
+ my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+ my $p = {
+ AutoCommit => 1,
+ PrintError => 0,
+ FetchHashKeyName => 'NAME_lc',
+ ora_envhp => 0, # force fresh environment (with current NLS env vars)
+ };
+ $p->{ora_charset} = $charset if $charset;
+ $p->{ora_ncharset} = $ncharset if $ncharset;
+
+ my $dbh = DBI->connect($dsn, $dbuser, '', $p);
+ return $dbh;
+}
+
+sub test_varchar2_table_3_tests($){
+ my $dbh=shift;
+ my $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl.count();
+ tbl(1) := \'def\';
+ tbl(2) := \'ijk\';
+ :mytable := tbl;
+ END;
+ ';
+
+ my $sth=$dbh->prepare( $statement );
+
+ if( ! defined($sth) ){
+ BAIL_OUT("Prapare(varchar2) error: ".$dbh->errstr);
+ }
+
+ my @arr=( "abc", "cde","lalala" );
+
+ if( not $sth->bind_param_inout(":mytable", \\@arr, 5, {
+ ora_type => ORA_VARCHAR2_TABLE,
+ ora_maxarray_numentries => 2
+ }
+ ) ){
+ BAIL_OUT("bind :mytable (VARCHAR2) error: ".$dbh->errstr);
+ }
+ my $cc;
+ if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
+ BAIL_OUT("bind :cc (at VARCHAR2) error: ".$dbh->errstr);
+ }
+
+ if( not $sth->execute() ){
+ BAIL_OUT("Execute (at VARCHAR2) failed: ".$dbh->errstr);
+ }
+ # print "Result: cc=",$cc,"\n",
+ # "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+ #Result: cc=2, l=3
+ # arr=$VAR1 = [
+ # 'def',
+ # 'ijk'
+ # ];
+ #
+
+ ok( $cc == 2, "VARCHAR2_TABLE input count correctness");
+ ok( scalar(@arr) == 2,"VARCHAR2_TABLE output count correctness");
+ ok( (($arr[0] eq 'def') and ($arr[1] eq 'ijk')) , "VARCHAR2_TABLE output content") or
+ diag( "arr[0]='",$arr[0],"', arr[1]='",$arr[1],"', arr=", Data::Dumper::Dumper(\@arr));
+}
+sub test_number_table_3_tests($){
+ my $dbh=shift;
+ my $statement='
+ DECLARE
+ tbl SYS.DBMS_SQL.NUMBER_TABLE;
+ BEGIN
+ tbl := :mytable;
+ :cc := tbl.count();
+ tbl(4) := -1;
+ tbl(5) := -2;
+ :mytable := tbl;
+ END;
+ ';
+
+ my $sth=$dbh->prepare( $statement );
+
+ if( ! defined($sth) ){
+ BAIL_OUT("Prapare(NUMBER_TABLE) error: ".$dbh->errstr);
+ }
+
+ my @arr=( 1,"2E0","3.5" );
+
+ # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE .
+
+ if( not $sth->bind_param_inout(":mytable", \\@arr, 10, {
+ ora_type => ORA_NUMBER_TABLE,
+ ora_maxarray_numentries => (scalar(@arr)+2),
+ ora_internal_type => SQLT_INT
+ }
+ ) )
+ {
+ BAIL_OUT("bind(NUMBER_TABLE) :mytable error: ".$dbh->errstr);
+ }
+ my $cc=undef;
+ if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
+ BAIL_OUT("bind(NUMBER_TABLE) :cc error: ".$dbh->errstr);
+ }
+
+ if( not $sth->execute() ){
+ BAIL_OUT("Execute(NUMBER_TABLE) failed: ".$dbh->errstr);
+ }
+ # print "Result: cc=",$cc,"\n",
+ # "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
+
+ #Result: cc=3
+ # arr=$VAR1 = [
+ # '5',
+ # '8',
+ # '3.5',
+ # '-1',
+ # '-2'
+ # ];
+
+ ok( $cc == 3, "NUMBER_TABLE input count correctness");
+ ok( scalar(@arr) == 5,"NUMBER_TABLE output count correctness");
+ my $result=1;
+ my @r=(1, 2, 3, -1, -2);
+ for( my $i=0 ; $i< scalar(@arr) ; $i++){
+ if( $r[$i] != $arr[$i] ){
+ $result=0;
+ last;
+ }
+ }
+ ok( $result , "NUMBER_TABLE output content") or
+ diag( "arr=", Data::Dumper::Dumper(\@arr),"\nThough must be: ",Data::Dumper::Dumper(\@r));
+}
+
+sub test_inout_array_tests($){
+ my $dbh=shift;
+ $dbh->do("create table array_in_out_test (id number(12,0), name varchar2(20), value varchar2(2000))");
+ $dbh->do("create sequence seq_array_in_out_test start with 1");
+ $dbh->do("
+ create or replace trigger trg_array_in_out_testst
+ before insert
+ on array_in_out_test
+ for each row
+ DECLARE
+ iCounter array_in_out_test.id%TYPE;
+ BEGIN
+ if INSERTING THEN
+ Select seq_array_in_out_test.nextval INTO iCounter FROM Dual;
+ :new.id := iCounter;
+ END IF;
+ END;
+ ");
+
+ my @in_array1=('one','two','three','four','five');
+ my @in_array2=('5','4','3','2','1');
+ my @out_array;
+ my @tuple_status;
+
+ my $sql = "insert into array_in_out_test (name, value) values (?,?) returning id into ?" ;
+
+ my $sth = $dbh->prepare($sql);
+
+ $sth->bind_param_array(1,\@in_array1 );
+ $sth->bind_param_array(2,\@in_array2);
+ ok ( $sth->bind_param_inout_array(3,\@out_array,0,{ora_type => ORA_VARCHAR2}),'... bind_param_inout_array should return false');
+
+ ok ( $sth->execute_array({ArrayTupleStatus=>\@tuple_status}),'... execute_array should return false');
+
+ cmp_ok(scalar (@tuple_status), '==',5 , '... we should have 19 tuple_status');
+ cmp_ok(scalar (@out_array), '==',5 , '... we should have 5 out_array');
+ cmp_ok($out_array[0], '==', 1,'... out values should match 1');
+ cmp_ok($out_array[1], '==', 2,'... out values should match 2');
+ cmp_ok($out_array[2], '==', 3,'... out values should match 3');
+ cmp_ok($out_array[3], '==', 4,'... out values should match 3');
+ cmp_ok($out_array[4], '==', 5,'... out values should match 5');
+
+ $dbh->do("drop table array_in_out_test") or warn $dbh->errstr;
+ $dbh->do("drop sequence seq_array_in_out_test") or die $dbh->errstr;
+
+}
+
+sub test_number_SP($){
+ my $dbh=shift;
+ $dbh->do("
+ create or replace procedure tox_test_proc0(
+ result in out varchar2,
+ ids in SYS.dbms_sql.number_table
+ )
+ as
+ begin
+ result := '';
+ for i in 1..ids.count loop
+ result := result || to_char(ids(i));
+ end loop;
+ end;
+
+
+
+ ");
+
+ my $sth = $dbh->prepare("begin tox_test_proc0( ?, ?); end;");
+
+
+ my $result = "";
+ my @array = (1, 2, 3, 4, 7);
+
+ $sth->bind_param_inout(1, \$result, 5);
+ ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 12345');
+ $sth->execute() ;
+ cmp_ok($result, '==','12347' , '... we should have 12347 out string');
+
+ @array = (3, 4, 5);
+
+ $sth->bind_param_inout(1, \$result, 3);
+ ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 345');
+ $sth->execute() ;
+ cmp_ok($result, '==','345' , '... we should have 345 out string');
+
+ $dbh->do("drop procedure tox_test_proc0") or warn $dbh->errstr;
+
+}
+SKIP: {
+ $dbh = db_connect(0);
+
+ if ($dbh) {
+ plan tests => 15;
+ } else {
+ plan skip_all => "Unable to connect to Oracle" if not $dbh;
+ }
+
+ test_varchar2_table_3_tests($dbh);
+ test_number_table_3_tests($dbh);
+ test_inout_array_tests($dbh);
+
+};
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ };
+}
+
+
++1;
@@ -0,0 +1,493 @@
+#!perl -w
+# vim:ts=8:sw=4
+
+use DBI;
+use DBD::Oracle qw(:ora_types SQLCS_NCHAR SQLCS_IMPLICIT ORA_OCI);
+use strict;
+use Test::More;
+
+*BAILOUT = sub { die "@_\n" } unless defined &BAILOUT;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my @test_sets;
+push @test_sets, [ "LONG", 0, 0 ];
+push @test_sets, [ "LONG RAW", ORA_LONGRAW, 0 ];
+push @test_sets, [ "NCLOB", ORA_CLOB, 0 ] unless ORA_OCI() < 9.0 or $ENV{DBD_ALL_TESTS};
+push @test_sets, [ "CLOB", ORA_CLOB, 0 ] ;
+push @test_sets, [ "BLOB", ORA_BLOB, 0 ] ;
+
+my $tests_per_set = 96;
+my $tests = @test_sets * $tests_per_set-1;
+#very odd little thing that took a while to figure out.
+#Seems I now have 479 tests which is 9 more so 96 test then -1 to round it off
+
+$| = 1;
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $table = table();
+my $use_utf8_data; # set per test_set below
+my %warnings;
+
+my @skip_unicode;
+push @skip_unicode, "Perl < 5.6 " if $] < 5.006;
+push @skip_unicode, "Oracle client < 9.0 " if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS};
+
+# Set size of test data (in 10KB units)
+# Minimum value 3 (else tests fail because of assumptions)
+# Normal value 8 (to test old 64KB threshold well)
+my $sz = 8;
+
+my($p1, $p2, $tmp, @tmp);
+
+#my $dbh = db_handle();
+
+
+ $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+ my $dsn = oracle_test_dsn();
+ my $dbh = DBI->connect($dsn, $dbuser, '',{
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => $tests;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+my $ora_server_version = $dbh->func("ora_server_version");
+note("ora_server_version: @$ora_server_version\n");
+show_db_charsets($dbh) if $dbh;
+
+foreach (@test_sets) {
+ my ($type_name, $type_num, $test_no_type) = @$_;
+ $use_utf8_data = use_utf8_data($dbh,$type_name);
+ note( qq(
+ =========================================================================
+ Running long test for $type_name ($type_num) use_utf8_data=$use_utf8_data
+));
+ run_long_tests($dbh, $type_name, $type_num);
+ run_long_tests($dbh, $type_name, 0) if $test_no_type;
+}
+
+exit 0;
+
+# end.
+
+
+END {
+ drop_table( $dbh ) if not $ENV{DBD_SKIP_TABLE_DROP};
+ $dbh->disconnect if $dbh;
+}
+
+
+sub use_utf8_data
+{
+ my ( $dbh, $type_name ) = @_;
+ if ( ($type_name =~ m/^CLOB/i and db_ochar_is_utf($dbh) && client_ochar_is_utf8())
+ or ($type_name =~ m/^NCLOB/i and db_nchar_is_utf($dbh) && client_nchar_is_utf8()) ) {
+ return 1 unless @skip_unicode;
+ warn "Skipping Unicode data tests: @skip_unicode\n" if !$warnings{use_utf8_data}++;
+ }
+ return 0;
+}
+
+sub run_long_tests
+{
+ my ($dbh, $type_name, $type_num) = @_;
+ my ($sth);
+ my $append_len;
+ SKIP:
+ { #it all
+
+ # relationships between these lengths are important # e.g.
+ my %long_data;
+ my @long_data;
+ $long_data[2] = ("2bcdefabcd" x 1024) x ($sz-1); # 70KB > 64KB && < long_data1
+ $long_data[1] = ("1234567890" x 1024) x ($sz ); # 80KB >> 64KB && > long_data2
+ $long_data[0] = ("0\177x\0X" x 2048) x (1 ); # 10KB < 64KB
+
+ if ( $use_utf8_data ) { # make $long_data0 be UTF8
+ my $utf_x = "0\x{263A}xyX"; #lab: the ubiquitous smiley face
+ $long_data[0] = ($utf_x x 2048) x (1 ); # 10KB < 64KB
+ if (length($long_data[0]) > 10240) {
+ note "known bug in perl5.6.0 utf8 support, applying workaround\n";
+ my $utf_z = "0\x{263A}xyZ" ;
+ $long_data[0] = $utf_z;
+ $long_data[0] .= $utf_z foreach (1..2047);
+ }
+ if ($type_name eq 'BLOB') {
+ # convert string from utf-8 to byte encoding XXX
+ $long_data[0] = pack "C*", (unpack "C*", $long_data[0]);
+ }
+ }
+ my $be_utf8 = ($type_name eq 'BLOB') ? 0
+ : ($type_name eq 'CLOB') ? client_ochar_is_utf8()
+ : ($type_name eq 'NCLOB') ? client_nchar_is_utf8()
+ : 0; # XXX umm, what about LONGs?
+
+ # special hack for long_data[0] since RAW types need pairs of HEX
+ $long_data[0] = "00FF" x (length($long_data[0]) / 2) if $type_name =~ /RAW/i;
+
+ my $len_data0 = length($long_data[0]);
+ my $len_data1 = length($long_data[1]);
+ my $len_data2 = length($long_data[2]);
+
+ # warn if some of the key aspects of the data sizing are tampered with
+ warn "long_data[0] is > 64KB: $len_data0\n"
+ if $len_data0 > 65535;
+ warn "long_data[1] is < 64KB: $len_data1\n"
+ if $len_data1 < 65535;
+ warn "long_data[2] is not smaller than $long_data[1] ($len_data2 > $len_data1)\n"
+ if $len_data2 >= $len_data1;
+
+ my $tdata = {
+ cols => long_test_cols( $type_name ),
+ rows => []
+ };
+
+
+ skip "Unable to create test table for '$type_name' data ($DBI::err)." ,$tests_per_set
+ if (!create_table($dbh, $tdata, 1));
+ # typically OCI 8 client talking to Oracle 7 database
+
+ note("long_data[0] length $len_data0\n");
+ note("long_data[1] length $len_data1\n");
+ note("long_data[2] length $len_data2\n");
+
+ note(" --- insert some $type_name data (ora_type $type_num)\n");
+ my $sqlstr = "insert into $table values (?, ?, SYSDATE)" ;
+ ok( $sth = $dbh->prepare( $sqlstr ), "prepare: $sqlstr" );
+ my $bind_attr = { ora_type => $type_num };
+ # The explicit SQLCS_IMPLICIT is needed in some odd cases
+ $bind_attr->{ora_csform} = ($type_name =~ /^NCLOB/) ? SQLCS_NCHAR : SQLCS_IMPLICIT;
+
+ $sth->bind_param(2, undef, $bind_attr )
+ or die "$type_name: $DBI::errstr" if $type_num;
+
+ ok($sth->execute(40, $long_data{40} = $long_data[0] ), "insert long data 40" );
+ ok($sth->execute(41, $long_data{41} = $long_data[1] ), "insert long data 41" );
+ ok($sth->execute(42, $long_data{42} = $long_data[2] ), "insert long data 42" );
+ ok($sth->execute(43, $long_data{43} = undef), "insert long data undef 43" ); # NULL
+
+ array_test($dbh);
+
+ note(" --- fetch $type_name data back again -- truncated - LongTruncOk == 1\n");
+ $dbh->{LongReadLen} = 20;
+ $dbh->{LongTruncOk} = 1;
+ note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n");
+
+ # This behaviour isn't specified anywhere, sigh:
+ my $out_len = $dbh->{LongReadLen};
+ $out_len *= 2 if ($type_name =~ /RAW/i);
+
+ $sqlstr = "select * from $table order by idx";
+ ok($sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" );
+ $sth->trace(0);
+ ok($sth->execute, "execute: $sqlstr" );
+ ok($tmp = $sth->fetchall_arrayref, "fetch_arrayref for $sqlstr" );
+ $sth->trace(0);
+ SKIP: {
+ if ($DBI::err && $DBI::errstr =~ /ORA-01801:/) {
+ # ORA-01801: date format is too long for internal buffer
+ skip " If you're using Oracle <= 8.1.7 then this error is probably\n"
+ ." due to an Oracle bug and not a DBD::Oracle problem.\n" , 5 ;
+ }
+ cmp_ok(@$tmp ,'==' ,4 ,'four rows' );
+ #print "tmp->[0][1] = " .$tmp->[0][1] ."\n" ;
+ for my $i (0..2) {
+ my $v = $tmp->[$i][1];
+ cmp_ok_byte_nice($v, substr($long_data[$i],0,$out_len), "truncated to LongReadLen $out_len");
+ if ($type_name eq 'BLOB') {
+ ok( !utf8::is_utf8($v), "BLOB non-UTF8");
+ }
+ else {
+ # allow result to have UTF8 flag even if source data didn't
+ # (not ideal but would need better test data)
+ ok( utf8::is_utf8($v) >= utf8::is_utf8($long_data[$i]),
+ "$type_name UTF8 setting");
+ }
+ }
+ # use Data::Dumper; print Dumper($tmp->[3]);
+ ok(!defined $tmp->[3][1], "last row undefined"); # NULL # known bug in DBD::Oracle <= 1.13
+ }
+
+ note(" --- fetch $type_name data back again -- truncated - LongTruncOk == 0\n");
+ $dbh->{LongReadLen} = $len_data1 - 10; # so $long_data[0] fits but long_data[1] doesn't
+ $dbh->{LongReadLen} = $dbh->{LongReadLen} / 2 if $type_name =~ /RAW/i;
+ my $LongReadLen = $dbh->{LongReadLen};
+ $dbh->{LongTruncOk} = 0;
+ note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n");
+
+ $sqlstr = "select * from $table order by idx";
+ ok($sth = $dbh->prepare($sqlstr), "prepare $sqlstr" );
+ ok($sth->execute, "execute $sqlstr" );
+ ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref $sqlstr" );
+ ok($tmp->[1] eq $long_data[0], "length tmp->[1] ".length($tmp->[1]) );
+
+ {
+ local $sth->{PrintError} = 0;
+ ok(!defined $sth->fetchrow_arrayref,
+ "truncation error not triggered "
+ ."(LongReadLen $LongReadLen, data ".length($tmp->[1]||0).")");
+ $tmp = $sth->err || 0;
+ ok( ($tmp == 1406 || $tmp == 24345) ,"tmp==1406 || tmp==24345 tmp actually=$tmp" );
+ }
+ $sth->finish;
+
+ note(" --- fetch $type_name data back again -- complete - LongTruncOk == 0\n");
+ $dbh->{LongReadLen} = $len_data1 +1000;
+ $dbh->{LongTruncOk} = 0;
+ note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n");
+
+ $sqlstr = "select * from $table order by idx";
+ ok($sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" );
+ ok($sth->execute, "execute $sqlstr" );
+
+ for my $i (0..2) {
+ ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref $sqlstr" );
+ ok($tmp->[1] eq $long_data[$i],
+ cdif($tmp->[1],$long_data[$i], "Len ".length($tmp->[1])) );
+ }
+ $sth->finish;
+
+
+ SKIP: {
+ skip( "blob_read tests for LONGs - not currently supported", 15 )
+ if ($type_name =~ /LONG/i) ;
+
+ #$dbh->trace(4);
+ note(" --- fetch $type_name data back again -- via blob_read\n\n");
+
+ $dbh->{LongReadLen} = 1024 * 90;
+ $dbh->{LongTruncOk} = 1;
+ $sqlstr = "select idx, lng, dt from $table order by idx";
+ ok($sth = $dbh->prepare($sqlstr) ,"prepare $sqlstr" );
+ ok($sth->execute, "execute $sqlstr" );
+
+
+ note("fetch via fetchrow_arrayref\n");
+ ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 1: $sqlstr" );
+ cmp_ok_byte_nice($tmp->[1], $long_data[0], "truncated to LongReadLen $out_len");
+
+ note("read via blob_read_all\n");
+ cmp_ok(blob_read_all($sth, 1, \$p1, 4096) ,'==', length($long_data[0]),
+ "blob_read_all = length(\$long_data[0])" );
+ ok($p1 eq $long_data[0], cdif($p1, $long_data[0]) );
+ $sth->trace(0);
+
+
+ ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 2: $sqlstr" );
+ cmp_ok(blob_read_all($sth, 1, \$p1, 12345) ,'==', length($long_data[1]),
+ "blob_read_all = length(long_data[1])" );
+ ok($p1 eq $long_data[1], cdif($p1, $long_data[1]) );
+
+
+ ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 3: $sqlstr" );
+ my $len = blob_read_all($sth, 1, \$p1, 34567);
+
+ cmp_ok($len,'==', length($long_data[2]), "length of long_data[2] = $len" );
+ cmp_ok_byte_nice($p1, $long_data[2], "3rd row via blob_read_all");
+
+ note("result is ".(utf8::is_utf8($p1) ? "UTF8" : "non-UTF8")."\n");
+ if ($be_utf8) {
+ ok( utf8::is_utf8($p1), "result should be utf8");
+ }
+ else {
+ ok( !utf8::is_utf8($p1), "result should not be utf8");
+ }
+ } #skip
+
+
+ SKIP: {
+ skip( "ora_auto_lob tests for $type_name" ."s - not supported", 7+(13*3) )
+ if not ( $type_name =~ /LOB/i );
+
+ note(" --- testing ora_auto_lob to access $type_name LobLocator\n\n");
+ my $data_fmt = "%03d foo!";
+
+ $sqlstr = qq{
+ SELECT lng, idx FROM $table ORDER BY idx
+ FOR UPDATE -- needed so lob locator is writable
+ };
+ my $ll_sth = $dbh->prepare($sqlstr, { ora_auto_lob => 0 } ); # 0: get lob locator instead of lob contents
+ ok($ll_sth ,"prepare $sqlstr" );
+
+ ok($ll_sth->execute ,"execute $sqlstr" );
+ while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) {
+ note("$idx: ".DBI::neat($lob_locator)."\n");
+ last if !defined($lob_locator) && $idx == 43;
+
+ ok($lob_locator, '$lob_locator is true' );
+ is(ref $lob_locator , 'OCILobLocatorPtr', '$lob_locator is a OCILobLocatorPtr' );
+ ok( (ref $lob_locator and $$lob_locator), '$lob_locator deref ptr is true' ) ;
+
+ # check ora_lob_chunk_size:
+ my $chunk_size = $dbh->func($lob_locator, 'ora_lob_chunk_size');
+ ok(!$DBI::err, "DBI::errstr");
+
+ my $data = sprintf $data_fmt, $idx; #create a little data
+ note("length of data to be written at offset 1: " .length($data) ."\n" );
+ ok($dbh->func($lob_locator, 1, $data, 'ora_lob_write') ,"ora_lob_write" );
+ }
+ is($ll_sth->rows, 4);
+
+ note(" --- round again to check contents after $type_name write updates...\n");
+ ok($ll_sth->execute,"execute (again 1) $sqlstr" );
+ while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) {
+ note("$idx locator: ".DBI::neat($lob_locator)."\n");
+ next if !defined($lob_locator) && $idx == 43;
+ diag("DBI::errstr=$DBI::errstr\n") if $DBI::err ;
+
+ my $content = $dbh->func($lob_locator, 1, 20, 'ora_lob_read');
+ diag("DBI::errstr=$DBI::errstr\n") if $DBI::err ;
+ ok($content,"content is true" );
+ note("$idx content: ".nice_string($content)."\n"); #.DBI::neat($content)."\n";
+ cmp_ok(length($content) ,'==', 20 ,"lenth(content)" );
+
+ # but prefix has been overwritten:
+ my $data = sprintf $data_fmt, $idx;
+ ok(substr($content,0,length($data)) eq $data ,"length(content)=length(data)" );
+
+ # ora_lob_length agrees:
+ my $len = $dbh->func($lob_locator, 'ora_lob_length');
+ ok(!$DBI::err ,"DBI::errstr" );
+ cmp_ok($len ,'==', length($long_data{$idx}) ,"length(long_data{idx}) = length of locator data" );
+
+ # now trim the length
+ $dbh->func($lob_locator, $idx, 'ora_lob_trim');
+ ok(!$DBI::err, "DBI::errstr" );
+
+ # and append some text
+ SKIP: {
+ $append_len = 0;
+ skip( "ora_lob_append() not reliable in Oracle 8 (Oracle bug #886191)", 1 )
+ if ORA_OCI() < 9 or $ora_server_version->[0] < 9;
+
+ my $append_data = "12345";
+ $append_len = length($append_data);
+ $dbh->func($lob_locator, $append_data, 'ora_lob_append');
+ ok(!$DBI::err ,"ora_lob_append DBI::errstr" );
+ # XXX ought to test data was actually appended
+ }
+
+ } #while fetchrow
+ is($ll_sth->rows, 4);
+
+ note(" --- round again to check the $type_name length...\n");
+ ok($ll_sth->execute ,"execute (again 2) $sqlstr" );
+ while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) {
+ note("$idx locator: ".DBI::neat($lob_locator)."\n");
+ next if !defined($lob_locator) && $idx == 43;
+ my $len = $dbh->func($lob_locator, 'ora_lob_length');
+ #lab: possible logic error here w/resp. to len
+ ok(!$DBI::err ,"DBI::errstr" );
+ cmp_ok( $len ,'==', $idx + $append_len ,"len == idx+5" );
+ }
+ is($ll_sth->rows, 4);
+
+ } #skip for LONG types
+
+ } #skip it all (tests_per_set)
+
+ $sth->finish if $sth;
+ drop_table( $dbh )
+
+} # end of run_long_tests
+
+
+
+sub array_test {
+ my ($dbh) = @_;
+ return 0; # XXX disabled
+ eval {
+ $dbh->{RaiseError}=1;
+ $dbh->trace(0);
+ my $sth = $dbh->prepare(qq{
+ UPDATE $table set idx=idx+1 RETURNING idx INTO ?
+ });
+ my ($a,$b);
+ $a = [];
+ $sth->bind_param_inout(1,\$a, 2);
+ $sth->execute;
+ note("a=$a\n");
+ note("a=@$a\n");
+ };
+ die "RETURNING array: $@";
+}
+
+
+sub print_substrs
+{
+ my ($dbh,$len) = @_;
+ my $tsql = "select substr(lng,1,$len),idx from $table order by idx" ;
+ diag("-- prepare: $tsql\n") ;
+ my $tsth = $dbh->prepare( $tsql );
+ $tsth->execute();
+ while ( my ( $d,$i ) = $tsth->fetchrow_array() )
+ {
+ last if not defined $d;
+ diag("$i: $d\n");
+ }
+}
+
+sub print_lengths
+{
+ my ($dbh) = @_;
+ my $tsql = "select length(lng),idx from $table order by idx" ;
+ diag("-- prepare: $tsql\n");
+ my $tsth = $dbh->prepare( $tsql );
+ $tsth->execute();
+ while ( my ( $l,$i ) = $tsth->fetchrow_array() )
+ {
+ last if not defined $l;
+ diag("$i: $l\n");
+ }
+}
+
+
+sub blob_read_all {
+ my ($sth, $field_idx, $blob_ref, $lump) = @_;
+
+ $lump ||= 4096; # use benchmarks to get best value for you
+ my $offset = 0;
+ my @frags;
+ while (1) {
+ my $frag = $sth->blob_read($field_idx, $offset, $lump);
+ last unless defined $frag;
+ my $len = length $frag;
+ last unless $len;
+ push @frags, $frag;
+ $offset += $len;
+ #print "blob_read_all: offset $offset, len $len\n";
+ }
+ $$blob_ref = join "", @frags;
+ return length($$blob_ref);
+}
+
+sub unc {
+ my @str = @_;
+ foreach (@str) { s/([\000-\037\177-\377])/ sprintf "\\%03o", ord($_) /eg; }
+ return join "", @str unless wantarray;
+ return @str;
+}
+
+sub cdif {
+ my ($s1, $s2, $msg) = @_;
+ $msg = ($msg) ? ", $msg" : "";
+ my ($l1, $l2) = (length($s1), length($s2));
+ return "Strings are identical$msg" if $s1 eq $s2;
+ return "Strings are of different lengths ($l1 vs $l2)$msg" # check substr matches?
+ if $l1 != $l2;
+ my $i;
+ for($i=0; $i < $l1; ++$i) {
+ my ($c1,$c2) = (ord(substr($s1,$i,1)), ord(substr($s2,$i,1)));
+ next if $c1 == $c2;
+ return sprintf "Strings differ at position %d (\\%03o vs \\%03o)$msg",
+ $i,$c1,$c2;
+ }
+ return "(cdif error $l1/$l2/$i)";
+}
+
+
+__END__
@@ -0,0 +1,218 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More;
+use DBD::Oracle qw(:ora_types ORA_OCI );
+use DBI;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, });
+
+plan $dbh ? ( tests => 12 )
+ : ( skip_all => "Unable to connect to Oracle" );
+
+my $table = table();
+drop_table($dbh);
+
+$dbh->do( <<"END_SQL" );
+ CREATE TABLE $table (
+ id INTEGER NOT NULL,
+ data BLOB
+ )
+END_SQL
+
+my ($stmt, $sth, $id, $loc);
+## test with insert empty blob and select locator.
+$stmt = "INSERT INTO $table (id,data) VALUES (1, EMPTY_BLOB())";
+$dbh->do($stmt);
+
+$stmt = "SELECT data FROM $table WHERE id = ?";
+$sth = $dbh->prepare($stmt, {ora_auto_lob => 0});
+$id = 1;
+$sth->bind_param(1, $id);
+$sth->execute;
+($loc) = $sth->fetchrow;
+is (ref $loc, "OCILobLocatorPtr", "returned valid locator");
+
+## test inserting a large value
+
+$stmt = "INSERT INTO $table (id,data) VALUES (666, ?)";
+$sth = $dbh->prepare($stmt);
+my $content = join(q{}, map { chr } ( 32 .. 64 )) x 16384;
+$sth->bind_param(1, $content, { ora_type => ORA_BLOB, ora_field => 'data' });
+eval { $sth->execute($content) };
+is $@, '', 'inserted into BLOB successfully';
+{
+ local $dbh->{LongReadLen} = 1_000_000;
+ my ($fetched) = $dbh->selectrow_array("select data from $table where id = 666");
+ is $fetched, $content, 'got back what we put in';
+}
+
+
+## test with insert empty blob returning blob to a var.
+($id, $loc) = (2, undef);
+$stmt = "INSERT INTO $table (id,data) VALUES (?, EMPTY_BLOB()) RETURNING data INTO ?";
+$sth = $dbh->prepare($stmt, {ora_auto_lob => 0});
+$sth->bind_param(1, $id);
+$sth->bind_param_inout(2, \$loc, 0, {ora_type => ORA_BLOB});
+$sth->execute;
+is (ref $loc, "OCILobLocatorPtr", "returned valid locator");
+
+sub temp_lob_count {
+ my $dbh = shift;
+ return $dbh->selectrow_array(<<'END_SQL');
+ SELECT cache_lobs + nocache_lobs AS temp_lob_count
+ FROM v$temporary_lobs templob,
+ v$session sess
+ WHERE sess.sid = templob.sid
+ AND sess.audsid = userenv('sessionid')
+END_SQL
+}
+
+sub have_v_session {
+ $dbh->do('select * from v$session where 0=1');
+ return defined($dbh->err) ? $dbh->err != 942 : 1;
+}
+
+
+
+## test writing / reading large data
+{
+ # LOB locators cannot span transactions - turn off AutoCommit
+ local $dbh->{AutoCommit} = 0;
+ my ( $large_value, $len );
+
+ # get a new locator
+ $stmt = "INSERT INTO $table (id,data) VALUES (3, EMPTY_BLOB())";
+ $dbh->do($stmt);
+ $stmt = "SELECT data FROM $table WHERE id = ?";
+ $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } );
+ $id = 3;
+ $sth->bind_param( 1, $id );
+ $sth->execute;
+ ($loc) = $sth->fetchrow;
+
+ is( ref $loc, "OCILobLocatorPtr", "returned valid locator" );
+
+ is( $dbh->ora_lob_is_init($loc), 1, "returned initialized locator" );
+
+ # write string > 32k
+ $large_value = 'ABCD' x 10_000;
+
+ $dbh->ora_lob_write( $loc, 1, $large_value );
+ eval {
+ $len = $dbh->ora_lob_length($loc);
+ };
+ if ($@) {
+ note ("It appears your Oracle or Oracle client has problems with ora_lob_length(lob_locator). We have seen this before - see RT 69350. The test is not going to fail because of this because we have seen it before but if you are using lob locators you might want to consider upgrading your Oracle client to 11.2 where we know this test works");
+ done_testing();
+ } else {
+ is( $len, length($large_value), "returned length" );
+
+ }
+ is( $dbh->ora_lob_read( $loc, 1, length($large_value) ),
+ $large_value, "returned written value" );
+
+ ## PL/SQL TESTS
+ SKIP: {
+ ## test calling PL/SQL with LOB placeholder
+ my $plsql_testcount = 4;
+
+ my $sth = $dbh->prepare(
+ 'BEGIN ? := DBMS_LOB.GETLENGTH( ? ); END;',
+ { ora_auto_lob => 0 }
+ );
+ $sth->bind_param_inout( 1, \$len, 16 );
+ $sth->bind_param( 2, $loc, { ora_type => ORA_BLOB } );
+ $sth->execute;
+
+ # ORA-00600: internal error code
+ # ORA-00900: invalid SQL statement
+ # ORA-06550: PLS-00201: identifier 'DBMS_LOB.GETLENGTH' must be declared
+ # ORA-06553: PLS-00213: package STANDARD not accessible
+
+ if ( $dbh->err && grep { $dbh->err == $_ } ( 600, 900, 6550, 6553 ) ) {
+ skip "Your Oracle server doesn't support PL/SQL", $plsql_testcount
+ if $dbh->err == 900;
+ skip
+ "Your Oracle PL/SQL package DBMS_LOB is not properly installed", $plsql_testcount
+ if $dbh->err == 6550;
+ skip "Your Oracle PL/SQL is not properly installed", $plsql_testcount
+ if $dbh->err == 6553 || $dbh->err == 600;
+ }
+
+ TODO: {
+ local $TODO = "problem reported w/ lobs and Oracle 11.2.*, see RT#69350"
+ if ORA_OCI() =~ /^11\.2\./;
+
+ is( $len, length($large_value), "returned length via PL/SQL" );
+ }
+
+ $dbh->{LongReadLen} = length($large_value) * 2;
+
+ my $out;
+ my $inout = lc $large_value;
+
+ eval {
+ $sth = $dbh->prepare( <<'END_SQL', { ora_auto_lob => 1 } );
+ DECLARE
+ -- testing IN, OUT, and IN OUT:
+ -- p_out will be set to LOWER(p_in)
+ -- p_inout will be set to p_inout || p_in
+
+ PROCEDURE lower_lob(p_in BLOB, p_out OUT BLOB, p_inout IN OUT BLOB) IS
+ pos INT;
+ buffer RAW(1024);
+ BEGIN
+ DBMS_LOB.CREATETEMPORARY(p_out, TRUE);
+ pos := 1;
+ WHILE pos <= DBMS_LOB.GETLENGTH(p_in)
+ LOOP
+ buffer := DBMS_LOB.SUBSTR(p_in, 1024, pos);
+
+ DBMS_LOB.WRITEAPPEND(p_out, UTL_RAW.LENGTH(buffer),
+ UTL_RAW.CAST_TO_RAW(LOWER(UTL_RAW.CAST_TO_VARCHAR2(buffer))));
+
+ DBMS_LOB.WRITEAPPEND(p_inout, UTL_RAW.LENGTH(buffer), buffer);
+
+ pos := pos + 1024;
+ END LOOP;
+ END;
+ BEGIN
+ lower_lob(:in, :out, :inout);
+ END;
+END_SQL
+
+ $sth->bind_param( ':in', $large_value, { ora_type => ORA_BLOB });
+
+ $sth->bind_param_inout( ':out', \$out, 100, { ora_type => ORA_BLOB } );
+ $sth->bind_param_inout( ':inout', \$inout, 100, { ora_type => ORA_BLOB } );
+ $sth->execute;
+
+ };
+
+ local $TODO = "problem reported w/ lobs and Oracle 11.2.*, see RT#69350"
+ if ORA_OCI() =~ /^11\.2\./;
+
+ skip "Your Oracle PL/SQL installation does not implement temporary LOBS", 3
+ if $dbh->err && $dbh->err == 6550;
+
+ is($out, lc($large_value), "returned LOB as string");
+ is($inout, lc($large_value).$large_value, "returned IN/OUT LOB as string");
+
+ undef $sth;
+ # lobs are freed with statement handle
+ skip q{can't check num of temp lobs, no access to v$session}, 1, unless have_v_session();
+ is(temp_lob_count($dbh), 0, "no temp lobs left");
+ }
+}
+
+$dbh->do("DROP TABLE $table");
+$dbh->disconnect;
+
+1;
@@ -0,0 +1,175 @@
+#!perl -w
+
+## ----------------------------------------------------------------------------
+## 31lob_extended.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## This run through some bugs that have been found in earlier versions of DBD::Oracle
+## Checks to ensure that these bugs no longer come up
+## Basically this is testing the use of LOBs when returned via stored procedures with bind_param_inout
+## ----------------------------------------------------------------------------
+
+use Test::More;
+
+use DBI;
+use Config;
+use DBD::Oracle qw(:ora_types);
+use strict;
+use warnings;
+use Data::Dumper;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '',{
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => 30;
+ $dbh->{LongReadLen} = 7000;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+ diag('Test reported bugs');
+}
+
+my ($table, $data0, $data1) = setup_test($dbh);
+
+my $PLSQL = <<"PLSQL";
+BEGIN
+ OPEN ? FOR SELECT x FROM $table;
+END;
+PLSQL
+
+$dbh->{RaiseError} = 1;
+
+#
+# bug in DBD::Oracle 1.21 where if ora_auto_lobs is not set and we attempt to
+# fetch from a table containing lobs which has more than one row
+# we get a segfault. This was due to prefetching more than one row.
+#
+{
+ my $testname = "ora_auto_lobs prefetch";
+
+ my ($sth1, $ev);
+
+ eval {$sth1 = $dbh->prepare($PLSQL, {ora_auto_lob => 0});};
+ ok(!$@, "$testname - prepare call proc");
+ my $sth2;
+ ok($sth1->bind_param_inout(1, \$sth2, 500, {ora_type => ORA_RSET}),
+ "$testname - bind out cursor");
+ ok($sth1->execute, "$testname - execute to get out cursor");
+
+ my ($lobl);
+
+ ($lobl) = $sth2->fetchrow;
+ test_lob($dbh, $lobl, $testname, 6000, $data0);
+ ($lobl) = $sth2->fetchrow;
+ test_lob($dbh, $lobl, $testname, 6000, $data1);
+
+
+ ok($sth2->finish, "$testname - finished returned sth");
+ ok($sth1->finish, "$testname - finished sth");
+}
+
+#
+# prior to DBD::Oracle 1.22 if ora_auto_lob was set on a statement which
+# was used to return a cursor on a result-set containing lobs, the lobs
+# were not automatically fetched.
+#
+{
+ my $testname = "ora_auto_lobs not fetching";
+
+ my ($sth1, $ev, $lob);
+
+ # ora_auto_lobs is supposed to default to set
+ eval {$sth1 = $dbh->prepare($PLSQL);};
+ ok(!$@, "$testname prepare call proc");
+ my $sth2;
+ ok($sth1->bind_param_inout(1, \$sth2, 500, {ora_type => ORA_RSET}),
+ "$testname - bind out cursor");
+ ok($sth1->execute, "$testname - execute to get out cursor");
+
+ ($lob) = $sth2->fetchrow;
+ ok($lob, "$testname - fetch returns something");
+ isnt(ref $lob, 'OCILobLocatorPtr', "$testname - not a lob locator");
+ is($lob, $data0, "$testname, first lob matches");
+
+ ($lob) = $sth2->fetchrow;
+ ok($lob, "$testname - fetch returns something");
+ isnt(ref $lob, 'OCILobLocatorPtr', "$testname - not a lob locator");
+ is($lob, $data1, "$testname, second lob matches");
+
+ ok($sth2->finish, "$testname - finished returned sth");
+ ok($sth1->finish, "$testname - finished sth");
+}
+
+sub test_lob
+{
+ my ($h, $lobl, $testname, $size, $data) = @_;
+
+ ok($lobl, "$testname - lob locator retrieved");
+ is(ref($lobl), 'OCILobLocatorPtr', "$testname - is a lob locator");
+
+ SKIP: {
+ skip "did not receive a lob locator", 4
+ unless ref($lobl) eq 'OCILobLocatorPtr';
+
+ my ($lob_length, $lob, $ev);
+
+ eval {$lob_length = $h->ora_lob_length($lobl);};
+ $ev = $@;
+ diag($ev) if $ev;
+ ok(!$ev, "$testname - first lob length $lob_length");
+ is($lob_length, $size, "$testname - correct lob length");
+ eval {$lob = $h->ora_lob_read($lobl, 1, $lob_length);};
+ $ev = $@;
+ diag($ev) if ($ev);
+ ok(!$ev, "$testname - read lob");
+
+ is($lob, $data, "$testname - lob returned matches lob inserted");
+ }
+}
+
+sub setup_test
+{
+ my ($h) = @_;
+ my ($table, $sth, $ev);
+
+ eval {$table = create_table($h, {cols => [['x', 'clob']]}, 1)};
+ BAIL_OUT("test table not created- $@") if $@;
+ ok(!$ev, "created test table");
+
+ eval {
+ $sth = $h->prepare(qq/insert into $table (idx, x) values(?,?)/);
+ };
+ BAIL_OUT("Failed to prepare insert into $table - $@") if $@;
+ my $data0 = 'x' x 6000;
+ my $data1 = 'y' x 6000;
+ eval {
+ $sth->execute(1, $data0);
+ $sth->execute(2, $data1);
+ };
+ BAIL_OUT("Failed to insert test data into $table - $@") if $@;
+ ok(!$ev, "created test data");
+
+ return ($table, $data0, $data1);
+}
+
+END {
+ return unless $dbh;
+
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 1;
+
+ eval {drop_table($dbh);};
+ if ($@) {
+ diag("table $table possibly not dropped - check - $@\n")
+ if $dbh->err ne '942';
+ }
+}
+
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More;
+use DBD::Oracle qw(:ora_types);
+use DBI;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+## ----------------------------------------------------------------------------
+## 03xmlype.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## Just a few checks to see if one can insert small and large xml files
+## Nothing fancy.
+## ----------------------------------------------------------------------------
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+
+eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0 })};
+
+if ($dbh) {
+ plan skip_all => "XMLTYPE new in Oracle 9"
+ if $dbh->func('ora_server_version')->[0] < 9;
+ plan tests => 3;
+} else {
+ plan skip_all => "Unable to connect to Oracle"
+}
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+
+
+my $table = table();
+eval { $dbh->do("DROP TABLE $table") };
+
+$dbh->do(qq{
+ CREATE TABLE $table (
+ id INTEGER NOT NULL,
+ XML_DATA XMLTYPE
+ )
+ });
+
+my ($stmt, $sth);
+my $small_xml="<books>";
+my $large_xml="<books>";
+my $i=0;
+
+for ($i=0;$i<=10;$i++){
+ $small_xml=$small_xml."<book id='".$i."'><title>the book ".$i." title</title></book>";
+}
+
+$small_xml=$small_xml."</books>";
+
+for ($i=0;$i<=10000;$i++){
+ $large_xml=$large_xml."<book id='".$i."'><title>the book ".$i." title</title></book>";
+}
+
+$large_xml=$large_xml."</books>";
+
+$stmt = "INSERT INTO ".$table." VALUES (1,?)";
+
+$sth =$dbh-> prepare($stmt);
+
+$sth-> bind_param(1, $small_xml, { ora_type => ORA_XMLTYPE });
+
+ok ($sth->execute(), '... execute for small XML return true');
+
+$sth-> bind_param(1, $large_xml, { ora_type => ORA_XMLTYPE });
+
+ok ($sth->execute(), '... execute for large XML return true');
+
+
+drop_table($dbh);
+
+$dbh->disconnect;
+
+1;
+
@@ -0,0 +1,123 @@
+#!perl -w
+
+use Test::More;
+
+use DBI;
+use Config;
+use DBD::Oracle qw(:ora_types);
+
+
+
+## ----------------------------------------------------------------------------
+## 33pres_lobs.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## Checks to see if the Interface for Persistent LOBs is working
+## Nothing fancy. Just an insert and a select if they fail this there is something up in OCI or the version
+## of oci being used
+## ----------------------------------------------------------------------------
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '',
+ { RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0 ,LongReadLen=>10000000})};
+if ($dbh) {
+ plan skip_all => "Data Interface for Persistent LOBs new in Oracle 9"
+ if $dbh->func('ora_server_version')->[0] < 9;
+ plan tests => 28;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+# check that our db handle is good
+my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar
+
+SKIP: {
+ skip "OCI version less than 9.2\n Persistent LOBs Tests skiped.", 29 unless $ora_oci >= 9.2;
+
+
+my $table = table();
+
+eval { $dbh->do("DROP TABLE $table") };
+
+ok($dbh->do(qq{
+ CREATE TABLE $table (
+ id NUMBER,
+ clob1 CLOB,
+ clob2 CLOB,
+ blob1 BLOB,
+ blob2 BLOB)
+ }), 'create test table');
+
+
+my $in_clob='ABCD' x 10_000;
+my $in_blob=("0\177x\0X"x 2048) x (1);
+my ($sql, $sth,$value);
+
+$sql = "insert into ".$table."
+ (id,clob1,clob2, blob1,blob2)
+ values(?,?,?,?,?)";
+ok($sth=$dbh->prepare($sql ), 'prepare for insert into lobs');
+$sth->bind_param(1,3);
+ok($sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}), 'bind p2');
+ok($sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}), 'bind p3');
+ok($sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}), 'bind p4');
+ok($sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}), 'bind p5');
+ok($sth->execute(), 'execute');
+
+$sql='select * from '.$table;
+
+ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1}), 'prepare with ora_pers_lob');
+
+ok($sth->execute(), 'execute with ora_pers_lob');
+my ($p_id,$log,$log2,$log3,$log4);
+
+ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(),
+ 'fetcheow for ora_pers_lob');
+
+is($log, $in_clob, 'clob1 = in_clob');
+is($log2, $in_clob, 'clob2 = in_clob');
+is($log3, $in_blob, 'clob1 = in_blob');
+is($log4, $in_blob, 'clob2 = in_blob');
+
+ok($sth=$dbh->prepare($sql,{ora_clbk_lob=>1,ora_piece_size=>.5*1024*1024}),
+ 'prepare for ora_piece_size');
+
+ok($sth->execute(), 'execute for ora_piece_size');
+
+ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetchrow');
+ok($log eq $in_clob, 'clob1 = in_clob');
+ok($log2 eq $in_clob, 'clob2 = in_clob');
+ok($log3 eq $in_blob, 'clob1 = in_clob');
+ok($log4 eq $in_blob, 'clob2 = in_clob');
+
+ok($sth=$dbh->prepare($sql,{ora_piece_lob=>1,ora_piece_size=>.5*1024*1024}),
+ 'prepare with ora_piece_lob/ora_piece_size');
+
+ok($sth->execute(), 'execute');
+ok( ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(),
+ 'fetchrow');
+
+ok($log eq $in_clob, 'clob1 = in_clob');
+ok($log2 eq $in_clob, 'clob2 = in_clob');
+ok($log3 eq $in_blob, 'clob1 = in_clob');
+ok($log4 eq $in_blob, 'clob2 = in_clob');
+
+#no neeed to look at the data is should be ok
+
+$sth->finish();
+drop_table($dbh);
+}
+
+
+$dbh->disconnect;
+
+1;
@@ -0,0 +1,167 @@
+#!perl -w
+
+##----------------------------------------------------------------------------
+## 36lob_leak.pl
+## By Martin Evans, Easysoft Limited
+##----------------------------------------------------------------------------
+## Test we are not leaking temporary lobs
+##----------------------------------------------------------------------------
+
+use Test::More;
+
+use DBI;
+use Config;
+use DBD::Oracle qw(:ora_types);
+use strict;
+use warnings;
+use Data::Dumper;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '',,{
+ PrintError => 0,
+ });
+
+if ($dbh) {
+ plan tests => 7;
+} else {
+ $dbh->{PrintError}=1;
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+# get SID and cached lobs
+# if sid not passed in we run 2 tests, get the sid and the cached lobs
+# if sid passed in we run 1 test which is to get the cached lobs
+sub get_cached_lobs
+{
+ my ($dbh, $sid) = @_;
+ my $cached_lobs;
+
+ if (!defined($sid)) {
+ SKIP: {
+ eval {
+ ($sid) = $dbh->selectrow_array(
+ q/select sid from v$session where audsid =
+SYS_CONTEXT('userenv', 'sessionid')/);
+ };
+ skip 'unable to find sid', 2 if ($@ || !defined($sid));
+
+ pass("found sid $sid");
+ };
+ }
+ if (defined($sid)) {
+ SKIP: {
+ eval {
+ $cached_lobs = $dbh->selectrow_array(
+ q/select CACHE_LOBS from V$TEMPORARY_LOBS where sid
+= ?/, undef, $sid);
+ };
+ skip 'unable to find cached lobs', 1
+ if ($@ || !defined($cached_lobs));
+ pass("found $cached_lobs cached lobs");
+ };
+ }
+ return ($sid, $cached_lobs);
+}
+
+sub setup_test
+{
+ my ($h) = @_;
+ my ($sth, $ev);
+
+ my $fn = 'p_DBD_Oracle_drop_me';
+
+ my $createproc = << "EOT";
+CREATE OR REPLACE FUNCTION $fn(pc IN CLOB) RETURN NUMBER AS
+BEGIN
+ NULL;
+ RETURN 0;
+END;
+EOT
+
+ eval {$h->do($createproc);};
+ BAIL_OUT("Failed to create test function - $@") if $@;
+ pass("created test function");
+
+ return $fn;
+}
+
+sub call_func
+{
+ my ($dbh, $function, $how) = @_;
+
+ eval {
+ my $sth;
+ my $sql = qq/BEGIN ? := $function(?); END;/;
+ if ($how eq 'prepare') {
+ $sth = $dbh->prepare($sql) or die($dbh->errstr);
+ } elsif ($how eq 'prepare_cached') {
+ $sth = $dbh->prepare_cached($sql) or die($dbh->errstr);
+ } else {
+ BAIL_OUT("Unknown prepare type $how");
+ }
+ $sth->{RaiseError} = 1;
+
+ BAIL_OUT("Cannot prepare a call to $function") if !$sth;
+
+ my ($return, $clob);
+ $clob = 'x' x 1000;
+ $sth->bind_param_inout(1, \$return, 10);
+ $sth->bind_param(2, $clob, {ora_type => ORA_CLOB});
+ $sth->execute;
+ };
+ BAIL_OUT("Cannot call $function successfully") if $@;
+}
+
+
+my ($sid, $cached_lobs);
+my ($function);
+SKIP: {
+ ($sid, $cached_lobs) = get_cached_lobs($dbh); # 1 2
+ skip 'Cannot find sid/cached lobs', 5 if !defined($cached_lobs);
+
+ $function = setup_test($dbh); # 3
+ my $new_cached_lobs;
+
+ foreach my $type (qw(prepare prepare_cached)) {
+ for my $count(1..100) {
+ call_func($dbh, $function, $type);
+ };
+ ($sid, $new_cached_lobs) = get_cached_lobs($dbh, $sid);
+
+ # we expect to leak 1 temporary lob as the last statement is
+ # cached and the temp lob is not thrown away until you next
+ # execute
+ if ($new_cached_lobs > ($cached_lobs + 1)) {
+ diag("Looks like we might be leaking temporary lobs from
+$type");
+ fail("old cached lobs: $cached_lobs " .
+ "new cached lobs: $new_cached_lobs");
+ } else {
+ pass("Not leaking temporary lobs on $type");
+ }
+ $cached_lobs = $new_cached_lobs;
+ }
+
+};
+
+END {
+ if ($dbh) {
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 1;
+ if ($function){
+ eval {$dbh->do(qq/drop function $function/);};
+ if ($@) {
+ diag("function p_DBD_Oracle_drop_me possibly not dropped" .
+ "- check - $@\n") if $dbh->err ne '4043';
+ } else {
+ note("function p_DBD_Oracle_drop_me dropped");
+ }
+ }
+ }
+}
@@ -0,0 +1,51 @@
+#!perl -w
+# $Id$
+
+use DBI;
+use DBD::Oracle(qw(:ora_fail_over));
+use strict;
+#use Devel::Peek qw(SvREFCNT Dump);
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+my $dbh = eval { DBI->connect($dsn, $dbuser, '',) }
+ or plan skip_all => "Unable to connect to Oracle";
+
+$dbh->disconnect;
+
+if ( !$dbh->ora_can_taf ){
+
+ eval {
+ $dbh = DBI->connect(
+ $dsn, $dbuser, '',
+ {ora_taf_function => 'taf'})
+ };
+ my $ev = $@;
+ like($ev, qr/You are attempting to enable TAF/, "'$ev' (expected)");
+}
+else {
+ ok $dbh = DBI->connect($dsn, $dbuser, '',
+ {ora_taf_function=>'taf'});
+
+ is($dbh->{ora_taf_function}, 'taf', 'TAF callback');
+
+ my $x = sub {};
+# diag(SvREFCNT($x));
+# diag(Dump($x));
+ $dbh->{ora_taf_function} = $x;
+ is(ref($dbh->{ora_taf_function}), 'CODE', 'TAF code ref');
+
+# diag(SvREFCNT($x));
+}
+
+$dbh->disconnect;
+
+done_testing();
@@ -0,0 +1,75 @@
+#!perl -w
+# $Id$
+#
+# Test you can set and retrieve some attributes after connect
+# MJE wrote this after discovering the code to set these attributes
+# was duplicated in connect/login6 and STORE and it did not need to be
+# because DBI passes attributes to STORE for you.
+#
+use DBI;
+use DBD::Oracle(qw(ORA_OCI));
+use strict;
+#use Devel::Peek qw(SvREFCNT Dump);
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+#use Devel::Leak;
+#use Test::LeakTrace;
+
+#no_leaks_ok {
+ do_it();
+#} -verbose;
+
+sub do_it {
+ #my $handle;
+ #my $count = Devel::Leak::NoteSV($handle);
+
+ my $dbh = eval { DBI->connect($dsn, $dbuser, '',) }
+ or plan skip_all => "Unable to connect to Oracle";
+
+ diag("Oracle version: " . join(".", @{$dbh->func('ora_server_version')}));
+ diag("client version: " . ORA_OCI());
+
+ SKIP: {
+ my @attrs = (qw(ora_module_name
+ ora_client_info
+ ora_client_identifier
+ ora_action));
+ my @attrs112 = (qw(ora_driver_name));
+
+ skip('Oracle OCI too old', 1 + @attrs + @attrs112) if ORA_OCI() < 11;
+
+ foreach my $attr (@attrs) {
+ $dbh->{$attr} = 'fred';
+ is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved");
+ }
+
+ SKIP: {
+ skip 'Oracle OCI too old', 1 + @attrs112 if ORA_OCI() < 11.2;
+
+ like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name');
+
+ foreach my $attr (@attrs) {
+ $dbh->{$attr} = 'fred';
+ is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved");
+ }
+ }
+ };
+
+ foreach my $attr (qw(ora_oci_success_warn
+ ora_objects)) {
+ $dbh->{$attr} = 1;
+ is($dbh->{$attr}, 1, "attribute $attr set and retrieved");
+ }
+
+ $dbh->disconnect;
+ #Devel::Leak::CheckSV($handle);
+}
+
+done_testing();
@@ -0,0 +1,131 @@
+#!perl -w
+use Test::More;
+
+use strict;
+use DBI qw(neat);
+use DBD::Oracle qw(ORA_OCI);
+use vars qw($tests);
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+$^W = 1;
+
+# XXX ought to extend tests to check 'blank padded comparision semantics'
+my @tests = (
+ # type: oracle internal type to use for placeholder values
+ # name: oracle name for type above
+ # chops_space: set true if type trims trailing space characters
+ # embed_nul: set true if type allows embedded nul characters
+ # (also SKIP=1 to skip test, ti=N to trace insert, ts=N to trace select)
+ { type=> 1, name=>"VARCHAR2", chops_space=>1, embed_nul=>1, }, # current DBD::Oracle
+ { type=> 5, name=>"STRING", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 }, # old Oraperl
+ { type=>96, name=>"CHAR", chops_space=>0, embed_nul=>1, },
+ { type=>97, name=>"CHARZ", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 },
+);
+
+$tests = 3;
+$_->{SKIP} or $tests+=8 for @tests;
+
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dsn = oracle_test_dsn();
+my $dbh = DBI->connect($dsn, $dbuser, '', {
+ AutoCommit => 0,
+ PrintError => 0,
+ FetchHashKeyName => 'NAME_lc',
+});
+
+if ($dbh) {
+ plan tests => $tests;
+} else {
+ plan skip_all =>
+ "Unable to connect to Oracle";
+}
+
+eval {
+ require Data::Dumper;
+ $Data::Dumper::Useqq = $Data::Dumper::Useqq =1;
+ $Data::Dumper::Terse = $Data::Dumper::Terse =1;
+ $Data::Dumper::Indent= $Data::Dumper::Indent=1;
+};
+
+my ($sth,$tmp);
+my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');
+
+# drop table but don't warn if not there
+eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do("DROP TABLE $table");
+};
+
+ok($dbh->do("CREATE TABLE $table (name VARCHAR2(2), vc VARCHAR2(20), c CHAR(20))"), 'create test table');
+
+my $val_with_trailing_space = "trailing ";
+my $val_with_embedded_nul = "embedded\0nul";
+
+for my $test_info (@tests) {
+ next if $test_info->{SKIP};
+
+ my $ph_type = $test_info->{type} || die;
+ my $name = $test_info->{name} || die;
+ note("\ntesting @{[ %$test_info ]} ...\n\n");
+
+ SKIP: {
+ skip "skipping tests", 12 if ($test_info->{SKIP});
+
+ $dbh->{ora_ph_type} = $ph_type;
+ ok($dbh->{ora_ph_type} == $ph_type, 'set ora_ph_type');
+
+ $sth = $dbh->prepare("INSERT INTO $table(name,vc,c) VALUES (?,?,?)");
+ $sth->trace($test_info->{ti}) if $test_info->{ti};
+ $sth->execute("ts", $val_with_trailing_space, $val_with_trailing_space);
+ $sth->execute("en", $val_with_embedded_nul, $val_with_embedded_nul);
+ $sth->execute("es", '', ''); # empty string
+ $sth->trace(0) if $test_info->{ti};
+
+ $dbh->trace($test_info->{ts}) if $test_info->{ts};
+ $tmp = $dbh->selectall_hashref(qq{
+ SELECT name, vc, length(vc) as len, nvl(vc,'ISNULL') as isnull, c
+ FROM $table}, "name");
+ ok(keys(%$tmp) == 3, 'right keys');
+ $dbh->trace(0) if $test_info->{ts};
+ $dbh->rollback;
+
+ delete $_->{name} foreach values %$tmp;
+ note(Data::Dumper::Dumper($tmp));
+
+ # check trailing_space behaviour
+ my $expect = $val_with_trailing_space;
+ $expect =~ s/\s+$// if $test_info->{chops_space};
+ my $ok = ($tmp->{ts}->{vc} eq $expect);
+ if (!$ok && $ph_type==1 && $name eq 'VARCHAR2') {
+ note " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies with Oracle version.\n"
+ . " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n"
+ . " Your system doesn't. If that seems odd, let us know.\n";
+ $ok = 1;
+ }
+ ok($ok, sprintf(" using ora_type %d expected %s but got %s for $name",
+ $ph_type, neat($expect), neat($tmp->{ts}->{vc})) );
+
+ # check embedded nul char behaviour
+ $expect = $val_with_embedded_nul;
+ $expect =~ s/\0.*// unless $test_info->{embed_nul};
+ is($tmp->{en}->{vc}, $expect, sprintf(" expected %s but got %s for $name",
+ neat($expect),neat($tmp->{en}->{vc})) );
+
+ # check empty string is NULL (irritating Oracle behaviour)
+ ok(!defined $tmp->{es}->{vc}, 'vc defined');
+ ok(!defined $tmp->{es}->{c}, 'c defined');
+ ok(!defined $tmp->{es}->{len}, 'len defined');
+ is($tmp->{es}->{isnull}, 'ISNULL', 'ISNULL');
+
+ exit 1 if $test_info->{ti} || $test_info->{ts};
+ }
+}
+
+ok($dbh->do("DROP TABLE $table"), 'drop table');
+ok($dbh->disconnect, 'disconnect');
+
+
+__END__
@@ -0,0 +1,107 @@
+#!perl -w
+# From: Jeffrey Horn <horn@cs.wisc.edu>
+use Test::More;
+use DBI;
+use DBD::Oracle qw(ORA_RSET);
+use strict;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my ($limit, $tests);
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 });
+
+if ($dbh) {
+ # ORA-00900: invalid SQL statement
+ # ORA-06553: PLS-213: package STANDARD not accessible
+ my $tst = $dbh->prepare(
+ q{declare foo char(50); begin RAISE INVALID_NUMBER; end;});
+ if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) {
+ warn "Your Oracle server doesn't support PL/SQL" if $dbh->err== 900;
+ warn "Your Oracle PL/SQL is not properly installed"
+ if $dbh->err==6553||$dbh->err==600;
+ plan skip_all => 'server does not support pl/sql or not installed';
+ }
+
+ $limit = $dbh->selectrow_array(
+ q{SELECT value-2 FROM v$parameter WHERE name = 'open_cursors'});
+ # allow for our open and close cursor 'cursors'
+ $limit -= 2 if $limit && $limit >= 2;
+ unless (defined $limit) { # v$parameter open_cursors could be 0 :)
+ warn("Can't determine open_cursors from v\$parameter, so using default\n");
+ $limit = 1;
+ }
+ $limit = 100 if $limit > 100; # lets not be greedy or upset DBA's
+ $tests = 2 + 10 * $limit + 6;
+
+ plan tests => $tests;
+
+ note "Max cursors: $limit";
+
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+my @cursors;
+my @row;
+
+note("opening cursors\n");
+my $open_cursor = $dbh->prepare( qq{
+ BEGIN OPEN :kursor FOR
+ SELECT * FROM all_objects WHERE rownum < 5;
+ END;
+} );
+ok($open_cursor, 'open cursor' );
+
+foreach ( 1 .. $limit ) {
+ note("opening cursor $_\n");
+ ok( $open_cursor->bind_param_inout( ":kursor", \my $cursor, 0, { ora_type => ORA_RSET } ), 'open cursor bind param inout' );
+ ok( $open_cursor->execute, 'open cursor execute' );
+ ok(!$open_cursor->{Active}, 'open cursor Active');
+
+ ok($cursor->{Active}, 'cursor Active' );
+ ok($cursor->fetchrow_arrayref, 'cursor fetcharray');
+ ok($cursor->fetchrow_arrayref, 'cursor fetcharray');
+ ok($cursor->finish, 'cursor finish' ); # finish early
+ ok(!$cursor->{Active}, 'cursor not Active');
+
+ push @cursors, $cursor;
+}
+
+note("closing cursors\n");
+my $close_cursor = $dbh->prepare( qq{ BEGIN CLOSE :kursor; END; } );
+ok($close_cursor, 'close cursor');
+foreach ( 1 .. @cursors ) {
+ print "closing cursor $_\n";
+ my $cursor = $cursors[$_-1];
+ ok($close_cursor->bind_param( ":kursor", $cursor, { ora_type => ORA_RSET }), 'close cursor bind param');
+ ok($close_cursor->execute, 'close cursor execute');
+}
+
+my $PLSQL = <<"PLSQL";
+DECLARE
+ TYPE t IS REF CURSOR;
+ c t;
+BEGIN
+ ? := c;
+END;
+PLSQL
+
+ok(my $sth1 = $dbh->prepare($PLSQL),
+ 'prepare exec of proc for null cursor');
+ok($sth1->bind_param_inout(1, \my $cursor, 100, {ora_type => ORA_RSET}),
+ 'binding cursor for null cursor');
+ok($sth1->execute, 'execute for null cursor');
+is($cursor, undef, 'undef returned for null cursor');
+ok($sth1->execute, 'execute 2 for null cursor');
+is($cursor, undef, 'undef 2 returned for null cursor');
+
+$dbh->disconnect;
+
+exit 0;
+
@@ -0,0 +1,141 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More;
+use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes);
+use DBI;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+## ----------------------------------------------------------------------------
+## 51scroll.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## Just a few checks to see if one can use a scrolling cursor
+## Nothing fancy.
+## ----------------------------------------------------------------------------
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0 })};
+if ($dbh) {
+ plan skip_all => "Scrollable cursors new in Oracle 9"
+ if $dbh->func('ora_server_version')->[0] < 9;
+ plan tests => 37;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+ok ($dbh->{RowCacheSize} = 10);
+
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+my $table = table();
+
+
+$dbh->do(qq{
+ CREATE TABLE $table (
+ id INTEGER )
+ });
+
+
+my ($sql, $sth,$value);
+my $i=0;
+$sql = "INSERT INTO ".$table." VALUES (?)";
+
+$sth =$dbh-> prepare($sql);
+
+$sth->execute($_) foreach (1..10);
+
+$sql="select * from ".$table;
+ok($sth=$dbh->prepare($sql,
+ {ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,
+ ora_prefetch_memory=>200}));
+ok ($sth->execute());
+
+#first loop all the way forward with OCI_FETCH_NEXT
+foreach (1..10) {
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ is($value->[0], $_, '... we should get the next record');
+}
+$value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+cmp_ok($value->[0], '==', 10, '... we should get the 10th record');
+
+# fetch off the end of the result-set
+$value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT, 0);
+is($value, undef, "end of result-set");
+
+#now loop all the way back
+for($i=1;$i<=9;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ cmp_ok($value->[0], '==', 10-$i, '... we should get the prior record');
+}
+
+#now +4 records relative from the present position of 0;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,4);
+cmp_ok($value->[0], '==', 5, '... we should get the 5th record');
+
+#now +2 records relative from the present position of 4;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2);
+cmp_ok($value->[0], '==', 7, '... we should get the 7th record');
+
+#now -3 records relative from the present position of 6;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-3);
+
+cmp_ok($value->[0], '==', 4, '... we should get the 4th record');
+
+#now get the 9th record from the start
+$value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,9);
+
+cmp_ok($value->[0], '==', 9, '... we should get the 9th record');
+
+#now get the last record
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+
+cmp_ok($value->[0], '==', 10, '... we should get the 10th record');
+
+#now get the ora_scroll_position
+
+cmp_ok($sth->ora_scroll_position(), '==', 10, '... we should get the 10 for the ora_scroll_position');
+
+#now back to the first
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+cmp_ok($value->[0], '==', 1, '... we should get the 1st record');
+
+#check the ora_scroll_position one more time
+
+cmp_ok($sth->ora_scroll_position(), '==', 1, '... we should get the 1 for the ora_scroll_position');
+
+# rt 76695 - fetch after fetch scroll maintains offset
+# now fetch forward 2 places then just call fetch
+# it should give us the 4th rcord and not the 5th
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2);
+is($value->[0], 3, '... we should get the 3rd record rt76695');
+($value) = $sth->fetchrow;
+is($value, 4, '... we should get the 4th record rt 76695');
+
+# rt 76410 - fetch after fetch absolute always returns the same row
+$value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE, 2);
+is($value->[0], 2, "... we should get the 2nd row rt76410_2");
+($value) = $sth->fetchrow;
+is($value, 3, "... we should get the 3rd row rt76410_2");
+
+$sth->finish();
+drop_table($dbh);
+
+
+$dbh->disconnect;
+
+1;
+
@@ -0,0 +1,123 @@
+#!perl -w
+use Test::More;
+
+use DBI;
+use DBD::Oracle qw(ORA_RSET);
+use strict;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 });
+
+if ($dbh) {
+ plan tests=> 29;
+} else {
+ plan skip_all =>"Unable to connect to Oracle";
+}
+
+# ref cursors may be slow due to oracle bug 3735785
+# believed fixed in
+# 9.2.0.6 (Server Patch Set)
+# 10.1.0.4 (Server Patch Set)
+# 10.2.0.1 (Base Release)
+
+my $outer = $dbh->prepare(q{
+ SELECT object_name, CURSOR(SELECT object_name FROM dual)
+ FROM all_objects WHERE rownum <= 5});
+ok($outer, 'prepare select');
+
+ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET');
+ok( $outer->execute, 'outer execute');
+ok( my @row1 = $outer->fetchrow_array, 'outer fetchrow');
+my $inner1 = $row1[1];
+is( ref $inner1, 'DBI::st', 'inner DBI::st');
+ok( $inner1->{Active}, 'inner Active');
+ok( my @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array');
+is( $row1[0], $row1_1[0], 'rows equal');
+ok( $inner1->{Active}, 'inner Active');
+ok(my @row2 = $outer->fetchrow_array, 'outer fetchrow_array');
+ok(!$inner1->{Active}, 'inner not Active');
+ok(!$inner1->fetch, 'inner fetch finished');
+is($dbh->err, -1, 'err = -1');
+like($dbh->errstr, qr/ defunct /, 'defunct');
+ok($outer->finish, 'outer finish');
+is($dbh->{ActiveKids}, 0, 'ActiveKids');
+
+#########################################################################
+# Same test again but this time with 2 cursors
+#########################################################################
+
+$outer = $dbh->prepare(q{
+ SELECT object_name,
+ CURSOR(SELECT object_name FROM dual),
+ CURSOR(SELECT object_name FROM dual)
+ FROM all_objects WHERE rownum <= 5});
+ok($outer, 'prepare select');
+
+ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET');
+ok( $outer->{ora_types}[2] == ORA_RSET, 'set ORA_RSET');
+ok( $outer->execute, 'outer execute');
+ok( @row1 = $outer->fetchrow_array, 'outer fetchrow');
+$inner1 = $row1[1];
+my $inner2 = $row1[2];
+is( ref $inner1, 'DBI::st', 'inner DBI::st');
+is( ref $inner2, 'DBI::st', 'inner DBI::st');
+
+ok( $inner1->{Active}, 'inner Active');
+ok( $inner2->{Active}, 'inner Active');
+ok( @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array');
+ok( my @row2_1 = $inner2->fetchrow_array, 'inner fetchrow_array');
+is( $row1[0], $row1_1[0], 'rows equal');
+is( $row1[0], $row2_1[0], 'rows equal');
+
+
+
+#########################################################################
+# Fetch speed test: START
+#########################################################################
+
+$dbh->{RaiseError} = 1;
+
+sub timed_fetch {
+ my ($rs,$caption) = @_;
+ my $row_count = 0;
+ my $tm_start = DBI::dbi_time();
+ $row_count++ while $rs->fetch;
+ my $elapsed = DBI::dbi_time() - $tm_start;
+
+ note "Fetched $row_count rows ($caption): $elapsed secs.";
+
+ return $elapsed;
+}
+
+##################################################
+# regular select
+##################################################
+my $sql1 = q{
+ SELECT object_name
+ FROM (SELECT object_name FROM all_objects WHERE ROWNUM<=70),
+ (SELECT 1 FROM all_objects WHERE ROWNUM<=70)
+};
+$outer = $dbh->prepare($sql1);
+$outer->execute();
+my $dur_std = timed_fetch($outer,'select');
+
+##################################################
+# nested cursor
+##################################################
+$outer = $dbh->prepare("SELECT CURSOR($sql1) FROM DUAL");
+$outer->execute();
+my $ref_csr = $outer->fetchrow_arrayref->[0];
+my $dur_ref = timed_fetch($ref_csr,'nested cursor');
+
+#########################################################################
+# Fetch speed test: END
+#########################################################################
+
+exit 0;
+
@@ -0,0 +1,81 @@
+#!perl -w
+
+use DBI;
+use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
+use strict;
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+## ----------------------------------------------------------------------------
+## 56embbeded.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## Just a few checks to see if I can select embedded objectes with Oracle::DBD
+## Nothing fancy.
+## ----------------------------------------------------------------------------
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0 })};
+if ($dbh) {
+ plan tests => 4;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+my $table = "table_embed";
+my $type = $table.'a_type';
+
+#do not warn if already there
+eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do(qq{drop TABLE $table });
+};
+eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do(qq{drop TYPE $type });
+};
+$dbh->do(qq{CREATE or replace TYPE $type as varray(10) of varchar(30) });
+
+$dbh->do(qq{
+ CREATE TABLE $table
+ ( aa_type $type)
+ });
+
+$dbh->do("insert into $table values ($type('1','2','3','4','5'))");
+
+
+
+# simple execute
+my $sth;
+ok ($sth = $dbh->prepare("select * from $table"), '... Prepare should return true');
+my $problems;
+ok ($sth->execute(), '... Select should return true');
+
+while (my ($a)=$sth->fetchrow()){
+ $problems= scalar(@$a);
+}
+
+cmp_ok(scalar($problems), '==',5, '... we should have 5 items');
+
+
+$dbh->do("drop table $table");
+
+$dbh->do("drop type $type");
+
+$dbh->disconnect;
+
+1;
+
@@ -0,0 +1,273 @@
+#!perl -w
+
+use DBI;
+use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
+use strict;
+use Data::Dumper;
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+$ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD"T"HH24:MI:SS';
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '',{ RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0,
+ ora_objects => 1 })};
+
+plan skip_all => "Unable to connect to Oracle" unless $dbh;
+
+plan tests => 65;
+
+my ($schema) = $dbuser =~ m{^([^/]*)};
+
+# Test ora_objects flag
+is $dbh->{ora_objects} => 1, 'ora_objects flag is set to 1';
+
+$dbh->{ora_objects} = 0;
+is $dbh->{ora_objects} => 0, 'ora_objects flag is set to 0';
+
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+
+ok( $schema = $dbh->selectrow_array(
+ "select sys_context('userenv', 'current_schema') from dual"
+), 'Fetch current schema name');
+
+
+my $obj_prefix = "dbd_test_";
+my $super_type = "${obj_prefix}_type_A";
+my $sub_type = "${obj_prefix}_type_B";
+my $table = "${obj_prefix}_obj_table";
+my $outer_type = "${obj_prefix}_outer_type";
+my $inner_type = "${obj_prefix}_inner_type";
+my $list_type = "${obj_prefix}_list_type";
+my $nest_table = "${obj_prefix}_nest_table";
+my $list_table = "${obj_prefix}_list_table";
+
+sub drop_test_objects {
+ for my $obj ("TABLE $list_table", "TABLE $nest_table",
+ "TYPE $list_type", "TYPE $outer_type", "TYPE $inner_type",
+ "TABLE $table", "TYPE $sub_type", "TYPE $super_type") {
+ #do not warn if already there
+ eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do(qq{drop $obj});
+ };
+ }
+}
+
+&drop_test_objects;
+
+# get the user's privileges
+my $privs_sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' );
+$privs_sth->execute;
+my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref };
+
+my $ora8 = $dbh->func('ora_server_version')->[0] < 9;
+my $final = $ora8 ? '':'FINAL';
+my $not_final = $ora8 ? '':'NOT FINAL';
+
+SKIP: {
+ skip q{don't have permission to create type} => 61
+ unless grep { $_ eq 'CREATE TYPE' } @privileges;
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $super_type AS OBJECT (
+ num INTEGER,
+ name VARCHAR2(20)
+ ) $not_final } );
+
+SKIP: {
+ skip 'Subtypes new in Oracle 9' => 1 if $ora8;
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type (
+ datetime DATE,
+ amount NUMERIC(10,5)
+ ) $not_final } );
+}
+sql_do_ok( $dbh, qq{ CREATE TABLE $table (id INTEGER, obj $super_type) });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) });
+SKIP: {
+ skip 'Subtypes new in Oracle 9' => 2 if $ora8;
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2',
+ TO_DATE('2004-11-30 14:27:18', 'YYYY-MM-DD HH24:MI:SS'),
+ 12345.6789)) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL,
+ 777.666)) } );
+}
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
+ num INTEGER,
+ name VARCHAR2(20)
+ ) $final });
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT (
+ num INTEGER,
+ obj $inner_type
+ ) $final });
+
+sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $list_type AS
+ TABLE OF $inner_type });
+
+sql_do_ok( $dbh, qq{ CREATE TABLE $nest_table(obj $outer_type) });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(91, $inner_type(1, 'one'))) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(92, $inner_type(0, null))) }
+ );
+
+sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(93, null)) }
+);
+
+sql_do_ok( $dbh, qq{ CREATE TABLE $list_table ( id INTEGER, list $list_type )
+ NESTED TABLE list STORE AS ${list_table}_list });
+
+sql_do_ok( $dbh, qq{ INSERT INTO $list_table VALUES(81,$list_type($inner_type(null, 'listed'))) } );
+# Test old (backward compatible) interface
+
+# test select testing objects
+my $sth = $dbh->prepare("select * from $table order by id");
+ok ($sth, 'old: Prepare select');
+ok ($sth->execute(), 'old: Execute select');
+
+my ( @row1, @row2, @row3 );
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'old: Fetch first row');
+cmp_ok(ref $row1[1], 'eq', 'ARRAY', 'old: Row 1 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row1[1]}), '==', 2, 'old: Row 1 column 2 is has 2 elements');
+SKIP: {
+ skip 'Subtypes new in Oracle 9' => 6 if $ora8;
+@row2 = $sth->fetchrow();
+ok (scalar @row2, 'old: Fetch second row');
+cmp_ok(ref $row2[1], 'eq', 'ARRAY', 'old: Row 2 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row2[1]}), '==', 2, 'old: Row 2 column 2 is has 2 elements');
+
+@row3 = $sth->fetchrow();
+ok (scalar @row3, 'old: Fetch third row');
+cmp_ok(ref $row3[1], 'eq', 'ARRAY', 'old: Row 3 column 2 is an ARRAY');
+cmp_ok(scalar(@{$row3[1]}), '==', 2, 'old: Row 3 column 2 is has 2 elements');
+}
+ok (!$sth->fetchrow(), 'old: No more rows expected');
+
+#print STDERR Dumper(\@row1, \@row2, \@row3);
+
+# Test new (extended) object interface
+
+# enable extended object support
+$dbh->{ora_objects} = 1;
+
+# test select testing objects - in extended mode
+$sth = $dbh->prepare("select * from $table order by id");
+ok ($sth, 'new: Prepare select');
+ok ($sth->execute(), 'new: Execute select');
+
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row');
+cmp_ok(ref $row1[1], 'eq', 'DBD::Oracle::Object', 'new: Row 1 column 2 is an DBD:Oracle::Object');
+cmp_ok(uc $row1[1]->type_name, "eq", uc "$schema.$super_type", "new: Row 1 column 2 object type");
+is_deeply([$row1[1]->attributes], ['NUM', 13, 'NAME', 'obj1'], "new: Row 1 column 2 object attributes");
+SKIP: {
+ skip 'Subtypes new in Oracle 9' => 8 if $ora8;
+@row2 = $sth->fetchrow();
+ok (scalar @row2, 'new: Fetch second row');
+cmp_ok(ref $row2[1], 'eq', 'DBD::Oracle::Object', 'new: Row 2 column 2 is an DBD::Oracle::Object');
+cmp_ok(uc $row2[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 2 column 2 object type");
+
+my %attrs = $row2[1]->attributes;
+
+$attrs{AMOUNT} = sprintf "%9.4f", $attrs{AMOUNT};
+
+is_deeply( \%attrs, {'NUM', undef, 'NAME', 'obj2',
+ 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', '12345.6789'}, "new: Row 1 column 2 object attributes");
+
+@row3 = $sth->fetchrow();
+ok (scalar @row3, 'new: Fetch third row');
+cmp_ok(ref $row3[1], 'eq', 'DBD::Oracle::Object', 'new: Row 3 column 2 is an DBD::Oracle::Object');
+cmp_ok(uc $row3[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 3 column 2 object type");
+
+%attrs = $row3[1]->attributes;
+$attrs{AMOUNT} = sprintf "%6.3f", $attrs{AMOUNT};
+
+is_deeply( \%attrs, {'NUM', 5, 'NAME', 'obj3',
+ 'DATETIME', undef, 'AMOUNT', '777.666'}, "new: Row 1 column 2 object attributes");
+}
+ok (!$sth->fetchrow(), 'new: No more rows expected');
+
+#print STDERR Dumper(\@row1, \@row2, \@row3);
+
+SKIP: {
+ skip 'Subtypes new in Oracle 9' => 3 if $ora8;
+# Test DBD::Oracle::Object
+my $obj = $row3[1];
+my $expected_hash = {
+ NUM => 5,
+ NAME => 'obj3',
+ DATETIME => undef,
+ AMOUNT => 777.666,
+ };
+my $attrs = $obj->attr_hash;
+$attrs->{AMOUNT} = sprintf "%6.3f", $attrs->{AMOUNT};
+
+is_deeply($attrs, $expected_hash, 'DBD::Oracle::Object->attr_hash');
+is_deeply($obj->attr, $expected_hash, 'DBD::Oracle::Object->attr');
+is($obj->attr("NAME"), 'obj3', 'DBD::Oracle::Object->attr("NAME")');
+}
+# try the list table
+$sth = $dbh->prepare("select * from $list_table");
+ok ($sth, 'new: Prepare select with nested table of objects');
+ok ($sth->execute(), 'new: Execute (nested table)');
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row (nested table)');
+is_deeply($row1[1]->[0]->attr, {NUM=>undef, NAME=>'listed'},
+ 'Check propertes of first (and only) item in nested table');
+
+ok (!$sth->fetchrow(), 'new: No more rows expected (nested table)');
+
+#try the nested table
+$sth = $dbh->prepare("select * from $nest_table");
+ok ($sth, 'new: Prepare select with nested object');
+ok ($sth->execute(), 'new: Execute (nested object)');
+
+@row1 = $sth->fetchrow();
+ok (scalar @row1, 'new: Fetch first row (nested object)');
+is($row1[0]->attr->{NUM}, '91', 'Check obj.num');
+is_deeply($row1[0]->attr->{OBJ}->attr, {NUM=>'1', NAME=>'one'}, 'Check obj.obj');
+
+@row2 = $sth->fetchrow();
+ok (scalar @row2, 'new: Fetch second row (nested object)');
+is($row2[0]->attr->{NUM}, '92', 'Check obj.num');
+is_deeply($row2[0]->attr->{OBJ}->attr, {NUM=>'0', NAME=>undef}, 'Check obj.obj');
+
+@row3 = $sth->fetchrow();
+ok (scalar @row3, 'new: Fetch third row (nested object)');
+is_deeply($row3[0]->attr, {NUM=>'93', OBJ=>undef}, 'Check obj');
+
+ok (!$sth->fetchrow(), 'new: No more rows expected (nested object)');
+
+}
+
+#cleanup
+&drop_test_objects;
+$dbh->disconnect;
+
+1;
+
+
+sub sql_do_ok {
+ my ( $dbh, $sql, $title ) = @_;
+ $title = $sql unless defined $title;
+ ok( $dbh->do( $sql ), $title ) or diag $dbh->errstr;
+}
+
@@ -0,0 +1,37 @@
+#!perl -w
+use Test::More;
+
+use DBI;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbuser_2 = $ENV{ORACLE_USERID_2} || '';
+
+if ($dbuser_2 eq '') {
+ plan skip_all => "ORACLE_USERID_2 not defined.\n";
+}
+# strip off @ on userid_2, as the reauth presumes current server
+$dbuser_2 =~ s/@.*//;
+(my $uid1 = uc $dbuser) =~ s:/.*::;
+(my $uid2 = uc $dbuser_2) =~ s:/.*::;
+if ($uid1 eq $uid2) {
+ plan skip_all => "ORACLE_USERID_2 not unique.\n";
+}
+
+my $dsn = oracle_test_dsn();
+my $dbh = DBI->connect($dsn, $dbuser, '');
+
+if ($dbh) {
+ plan tests => 3;
+} else {
+ plan skip_all => "Unable to connect to Oracle\n";
+}
+
+is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid1, 'uid1' );
+ok($dbh->func($dbuser_2, '', 'reauthenticate'), 'reauthenticate');
+is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid2, 'uid2' );
+
+$dbh->disconnect;
@@ -0,0 +1,88 @@
+#!perl -w
+use Test::More;
+
+use strict;
+use DBI qw(:sql_types);
+use Data::Dumper;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0 });
+
+if ($dbh) {
+ plan tests=>21;
+ $dbh->{RaiseError} = 1;
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+note("type_info_all\n");
+my @types = $dbh->type_info(SQL_ALL_TYPES);
+ok(@types >= 8, 'more than 8 types');
+note(Dumper( @types ));
+
+note("tables():\n");
+my @tables = $dbh->tables;
+note(@tables." tables\n");
+ok(scalar @tables, 'tables');
+
+my @table_info_params = (
+ [ 'schema list', undef, '%', undef, undef ],
+ [ 'type list', undef, undef, undef, '%' ],
+ [ 'table list', undef, undef, undef, undef ],
+);
+foreach my $table_info_params (@table_info_params) {
+ my ($name) = shift @$table_info_params;
+ my $start = time;
+ note("$name: table_info(".DBI::neat_list($table_info_params).")\n");
+ my $table_info_sth = $dbh->table_info(@$table_info_params);
+ ok($table_info_sth, 'table_info');
+ my $data = $table_info_sth->fetchall_arrayref;
+ ok($data, 'table_info fetch');
+ ok(scalar @$data, 'table_info data returned');
+ my $dur = time - $start;
+ note("$name: ".@$data." rows, $dur seconds\n");
+}
+
+my $sql_dbms_version = $dbh->get_info(18);
+ok($sql_dbms_version, 'dbms_version');
+note "sql_dbms_version=$sql_dbms_version";
+like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched');
+
+# test long DEFAULT from column_info
+SKIP: {
+ my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');
+
+ eval { $dbh->do("DROP TABLE $table") };
+
+ my $created = eval { $dbh->do("CREATE TABLE $table (testcol NUMBER(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10))))") };
+
+ skip 'could not create test table', 8 unless $created;
+
+ is $dbh->{LongReadLen}, 80, 'LongReadLen is at default';
+
+ ok((my $sth = $dbh->column_info(undef, '%', uc($table), '%')), 'column_info sth');
+
+ is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
+
+ ok((my $info = eval { $sth->fetchrow_hashref }), 'sth->fetchrow_hashref lived')
+ or diag $@;
+
+ is $info->{COLUMN_DEF}, "to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10)))", 'long DEFAULT matched';
+
+ ok($sth->finish, 'sth->finish');
+
+ is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
+
+ ok($dbh->do("DROP TABLE $table"), 'drop table');
+}
+
+$dbh->disconnect;
+
+exit 0;
+
@@ -0,0 +1,133 @@
+#!perl -w
+use strict;
+
+use Encode;
+use Devel::Peek;
+
+use DBI;
+use DBD::Oracle qw(ORA_OCI);
+
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $tdata = {
+ cols => [
+ [ 'ch', 'varchar2(20)', ],
+ [ 'nch', 'nvarchar2(20)', ],
+ [ 'descr', 'varchar2(50)', ],
+ ],
+ 'dump' => 'DUMP(%s)',
+ rows => [
+ [
+ "\xb0",
+ "\xb0",
+ 'DEGREE SIGN',
+ ],
+ ],
+};
+
+my $table = table();
+
+my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8';
+my $eight_bit_charset = 'WE8ISO8859P1';
+
+my $dbh_utf8;
+my $dbh;
+SKIP: {
+ plan skip_all => "Oracle 9.2 or newer required" unless ORA_OCI >= 9.2;
+
+ if ($ENV{ORA_CHARSET_FAIL}) {
+ # Connecting up here breaks because of the charset and ncharset
+ # global variables defined in dbdimp.c
+ $dbh_utf8 = db_connect(1);
+ }
+ my $testcount = 8 + insert_test_count( $tdata );
+
+ $dbh = db_connect(0);
+ if ($dbh) {
+ $dbh->ora_nls_parameters ()->{NLS_CHARACTERSET} =~ m/US7ASCII/ and plan skip_all => "Database is set up as US7ASCII";
+
+ plan tests => $testcount;
+ } else {
+ plan skip_all => "Unable to connect to Oracle";
+ }
+
+ show_test_data( $tdata ,0 );
+
+ drop_table($dbh);
+ create_table($dbh, $tdata);
+ insert_rows( $dbh, $tdata);
+
+ my ($ch, $nch) = $dbh->selectrow_array("select ch, nch from $table");
+ check($ch, $nch, 0);
+
+ unless ($ENV{ORA_CHARSET_FAIL}) {
+ $dbh_utf8 = db_connect(1);
+ }
+ ($ch, $nch) = $dbh_utf8->selectrow_array("select ch, nch from $table");
+ check($ch, $nch, 1);
+};
+
+sub check {
+ my $ch = shift;
+ my $nch = shift;
+ my $is_utf8 = shift;
+
+ if ($is_utf8) {
+ ok(Encode::is_utf8($ch));
+ ok(Encode::is_utf8($nch));
+ }
+ else {
+ ok(!Encode::is_utf8($ch));
+ ok(!Encode::is_utf8($nch));
+ }
+
+ is($ch, "\xb0", "match char");
+ is($nch, "\xb0", "match char");
+}
+
+sub db_connect
+{
+ my $utf8 = shift;
+
+ # Make sure we really are overriding the environment settings.
+ my ($charset, $ncharset);
+ if ($utf8) {
+ set_nls_lang_charset($eight_bit_charset);
+ set_nls_nchar($eight_bit_charset);
+ $charset = $utf8_charset;
+ $ncharset = $utf8_charset;
+ }
+ else {
+ set_nls_lang_charset($utf8_charset);
+ set_nls_nchar($utf8_charset);
+ $charset = $eight_bit_charset;
+ $ncharset = $eight_bit_charset;
+ }
+
+ my $dsn = oracle_test_dsn();
+ my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+ my $p = {
+ AutoCommit => 1,
+ PrintError => 0,
+ FetchHashKeyName => 'NAME_lc',
+ ora_envhp => 0, # force fresh environment (with current NLS env vars)
+ };
+ $p->{ora_charset} = $charset if $charset;
+ $p->{ora_ncharset} = $ncharset if $ncharset;
+
+ my $dbh = DBI->connect($dsn, $dbuser, '', $p);
+ return $dbh;
+}
+
+END {
+ eval {
+ local $dbh->{PrintError} = 0;
+ drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'};
+ };
+}
+
+1;
@@ -1,48 +0,0 @@
-#!perl -w
-
-# Base DBD Driver Test
-
-print "1..$tests\n";
-
-require DBI;
-print "ok 1\n";
-
-import DBI;
-print "ok 2\n";
-
-$switch = DBI->internal;
-(ref $switch eq 'DBI::dr') ? print "ok 3\n" : print "not ok 3\n";
-
-eval {
-
-# This is a special case. install_driver should not normally be used.
-$drh = DBI->install_driver('Oracle');
-(ref $drh eq 'DBI::dr') ? print "ok 4\n" : print "not ok 4\n";
-
-};
-if ($@) {
- $@ =~ s/\n\n+/\n/g if $@;
- warn "Failed to load Oracle extension and/or shared libraries:\n$@" if $@;
- warn "The remaining tests will probably also fail with the same error.\a\n\n";
- # try to provide some useful pointers for some cases
- if ($@ =~ /Solaris patch.*Java/i) {
- warn "*** Please read the README.java file for help. ***\n";
- }
- else {
- warn "*** Please read the README and README.help files for help. ***\n";
- }
- warn "\n";
- sleep 5;
-}
-
-print "ok 5\n" if $drh->{Version};
-
-BEGIN { $tests = 5 }
-exit 0;
-# end.
-
-__END__
-
-You must install a Solaris patch to run this version of
-the Java runtime.
-Please see the README and release notes for more information.
@@ -1,104 +0,0 @@
-#!perl -w
-# From: Jeffrey Horn <horn@cs.wisc.edu>
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use DBI;
-use DBD::Oracle qw(ORA_RSET);
-use strict;
-
-$| = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '', { PrintError => 0 });
-
-unless ($dbh) {
- warn "Unable to connect to Oracle as $dbuser ($DBI::errstr)\nTests skipped.\n";
- print "1..0\n";
- exit 0;
-}
-
-# ORA-00900: invalid SQL statement
-# ORA-06553: PLS-213: package STANDARD not accessible
-my $tst = $dbh->prepare(q{declare foo char(50); begin RAISE INVALID_NUMBER; end;});
-if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) {
- warn "Your Oracle server doesn't support PL/SQL" if $dbh->err== 900;
- warn "Your Oracle PL/SQL is not properly installed" if $dbh->err==6553||$dbh->err==600;
- warn "Tests skipped\n";
- print "1..0\n";
- exit 0;
-}
-
-my $limit = $dbh->selectrow_array(q{
- SELECT value-2 FROM v$parameter WHERE name = 'open_cursors'
-});
-$limit -= 2 if $limit && $limit >= 2; # allow for our open and close cursor 'cursors'
-unless (defined $limit) { # v$parameter open_cursors could be 0 :)
- print "Can't determine open_cursors from v\$parameter, so using default\n";
- $limit = 1;
-}
-print "Max cursors: $limit\n";
-
-my $tests = 2 + 10 * $limit;
-
-print "1..$tests\n";
-
-
-my @cursors;
-my @row;
-
-print "opening cursors\n";
-my $open_cursor = $dbh->prepare( qq{
- BEGIN OPEN :kursor FOR
- SELECT * FROM all_objects WHERE rownum < 5;
- END;
-} );
-ok( 0, $open_cursor );
-
-foreach ( 1 .. $limit ) {
- print "opening cursor $_\n";
- ok( 0, $open_cursor->bind_param_inout( ":kursor", \my $cursor, 0, { ora_type => ORA_RSET } ) );
- ok( 0, $open_cursor->execute );
- ok( 0, !$open_cursor->{Active} );
-
- ok( 0, $cursor->{Active} );
- ok( 0, $cursor->fetchrow_arrayref);
- ok( 0, $cursor->fetchrow_arrayref);
- ok( 0, $cursor->finish ); # finish early
- ok( 0, !$cursor->{Active} );
-
- push @cursors, $cursor;
-}
-
-if (DBD::Oracle::ORA_OCI() == 8 ) {
- print "closing cursors\n";
- my $close_cursor = $dbh->prepare( qq{ BEGIN CLOSE :kursor; END; } );
- ok(0, $close_cursor);
- foreach ( 1 .. @cursors ) {
- print "closing cursor $_\n";
- my $cursor = $cursors[$_-1];
- ok(0, $close_cursor->bind_param( ":kursor", $cursor, { ora_type => ORA_RSET }));
- ok(0, $close_cursor->execute);
- }
-}
-else {
- warn " explicit cursor closing skipped due to known DBD::Oracle bug with OCI7\n";
- ok(0,1);
- foreach ( 1 .. @cursors ) { ok(0,1); ok(0,1); }
-}
-
-$dbh->disconnect;
-
-exit 0;
-
@@ -1,88 +0,0 @@
-#!perl -w
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use DBI;
-$| = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '');
-
-unless($dbh) {
- warn "Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-print "1..$tests\n";
-
-my($sth, $p1, $p2, $tmp);
-
-$sth = $dbh->prepare(q{
- /* also test preparse doesn't get confused by ? :1 */
- select * from user_tables -- ? :1
-});
-ok(0, $sth->{ParamValues});
-ok(0, keys %{$sth->{ParamValues}} == 0);
-ok(0, $sth->execute);
-ok(0, $sth->{NUM_OF_FIELDS});
-eval { $p1=$sth->{NUM_OFFIELDS_typo} };
-ok(0, $@ =~ /attribute/);
-ok(0, $sth->{Active});
-ok(0, $sth->finish);
-ok(0, !$sth->{Active});
-
-$sth = $dbh->prepare("select * from user_tables");
-ok(0, $sth->execute);
-ok(0, $sth->{Active});
-1 while ($sth->fetch); # fetch through to end
-ok(0, !$sth->{Active});
-
-# so following test works with other NLS settings/locations
-ok(0, $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"), 1);
-
-ok(0, $tmp = $dbh->selectall_arrayref(q{
- select 1 * power(10,-130) "smallest?",
- 9.9999999999 * power(10,125) "biggest?"
- from dual
-}));
-my @tmp = @{$tmp->[0]};
-#warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp";
-ok(0, $tmp[0] <= 1.0000000000000000000000000000000001e-130, $tmp[0]);
-ok(0, $tmp[1] >= 9.99e+125, $tmp[1]);
-
-
-my $warn='';
-eval {
- $SIG{__WARN__} = sub { $warn = $_[0] };
- $dbh->{RaiseError} = 1;
- $dbh->do("some invalid sql statement");
-};
-ok(0, $@ =~ /DBD::Oracle::db do failed:/, "eval error: ``$@'' expected 'do failed:'");
-#print "''$warn''";
-ok(0, $warn =~ /DBD::Oracle::db do failed:/, "warn error: ``$warn'' expected 'do failed:'");
-$dbh->{RaiseError} = 0;
-
-# ---
-
-ok(0, $dbh->ping);
-$dbh->disconnect;
-$dbh->{PrintError} = 0;
-ok(0, !$dbh->ping);
-
-exit 0;
-BEGIN { $tests = 19 }
-# end.
-
-__END__
@@ -0,0 +1,519 @@
+# $Id$
+# Author: Martin J. Evans
+# This should be an exact copy of the same file in DBD::ODBC
+# If you change this file please let me know.
+package ExecuteArray;
+use Test::More;
+use Data::Dumper;
+use DBI;
+our $VERSION = '0.01';
+
+my $table = 'PERL_DBD_execute_array';
+my $table2 = 'PERL_DBD_execute_array2';
+my @p1 = (1,2,3,4,5);
+my @p2 = qw(one two three four five);
+my $fetch_row = 0;
+my @captured_error; # values captured in error handler
+
+sub error_handler
+{
+ @captured_error = @_;
+ note("***** error handler called *****");
+ 0; # pass errors on
+}
+
+sub new {
+ my ($class, $dbh, $dbi_version) = @_;
+ my $self = {};
+
+ $dbh = setup($dbh, $dbi_version);
+ $self->{_dbh} = $dbh;
+
+ # find out how the driver supports row counts and parameter status
+ $self->{_param_array_row_counts} = $dbh->get_info(153);
+ # a return of 1 is SQL_PARC_BATCH which means:
+ # Individual row counts are available for each set of parameters. This is
+ # conceptually equivalent to the driver generating a batch of SQL
+ # statements, one for each parameter set in the array. Extended error
+ # information can be retrieved by using the SQL_PARAM_STATUS_PTR
+ # descriptor field.
+ # a return of 2 is SQL_PARC_NO_BATCH which means:
+ # There is only one row count available, which is the cumulative row
+ # count resulting from the execution of the statement for the entire
+ # array of parameters. This is conceptually equivalent to treating
+ # the statement together with the complete parameter array as one
+ # atomic unit. Errors are handled the same as if one statement
+ # were executed.
+ return bless ($self, $class);
+}
+
+sub dbh {
+ my $self = shift;
+ return $self->{_dbh};
+}
+
+sub setup {
+ my ($dbh, $dbi_version) = @_;
+
+ $dbh = enable_mars($dbh, $native);
+ $dbh->{HandleError} = \&error_handler;
+ if ($dbi_version) {
+ $dbh->{odbc_disable_array_operations} = 1;
+ }
+ #$dbh->{ora_verbose} = 5;
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 0;
+ $dbh->{ChopBlanks} = 1;
+ $dbh->{AutoCommit} = 1;
+
+ return $dbh;
+}
+
+sub create_table
+{
+ my ($self, $dbh) = @_;
+
+ eval {
+ $dbh->do(qq/create table $table (a integer not null primary key, b char(20))/);
+ };
+ if ($@) {
+ diag("Failed to create test table $table - $@");
+ return 0;
+ }
+ eval {
+ $dbh->do(qq/create table $table2 (a integer not null primary key, b char(20))/);
+ };
+ if ($@) {
+ diag("Failed to create test table $table2 - $@");
+ return 0;
+ }
+ my $sth = $dbh->prepare(qq/insert into $table2 values(?,?)/);
+ for (my $row = 0; $row < @p1; $row++) {
+ $sth->execute($p1[$row], $p2[$row]);
+ }
+ 1;
+}
+
+sub drop_table
+{
+ my ($self, $dbh) = @_;
+
+ eval {
+ local $dbh->{PrintError} = 0;
+ local $dbh->{PrintWarn} = 0;
+ $dbh->do(qq/drop table $table/);
+ $dbh->do(qq/drop table $table2/);
+ };
+ note("Table dropped");
+}
+
+# clear the named table of rows
+sub clear_table
+{
+ $_[0]->do(qq/delete from $_[1]/);
+}
+
+# check $table contains the data in $c1, $c2 which are arrayrefs of values
+sub check_data
+{
+ my ($dbh, $c1, $c2) = @_;
+
+ my $data = $dbh->selectall_arrayref(qq/select * from $table order by a/);
+ my $row = 0;
+ foreach (@$data) {
+ is($_->[0], $c1->[$row], "row $row p1 data");
+ is($_->[1], $c2->[$row], "row $row p2 data");
+ $row++;
+ }
+}
+
+sub check_tuple_status
+{
+ my ($self, $tsts, $expected) = @_;
+
+ note(Data::Dumper->Dump([$tsts], [qw(ArrayTupleStatus)]));
+
+ BAIL_OUT('expected data must be specified')
+ if (!$expected || (ref($expected) ne 'ARRAY'));
+
+ is(ref($tsts), 'ARRAY', 'tuple status is an array') or return;
+ if (!is(scalar(@$tsts), scalar(@$expected), 'status arrays same size')) {
+ diag(Dumper($tsts));
+ diag(Dumper($expected));
+ return;
+ }
+
+ my $row = 0;
+ foreach my $s (@$expected) {
+ if (ref($s)) {
+ unless ($self->{_param_array_row_counts} == 2) {
+ is(ref($tsts->[$row]), 'ARRAY', 'array in array tuple status');
+ is(scalar(@{$tsts->[$row]}), 3, '3 elements in array tuple status error');
+ }
+ } else {
+ if ($tsts->[$row] == -1) {
+ pass("row $row tuple status unknown");
+ } else {
+ is($tsts->[$row], $s, "row $row tuple status");
+ }
+ }
+ $row++;
+ }
+ return;
+}
+
+# insert might return 'mas' which means the caller said the test
+# required Multiple Active Statements and the driver appeared to not
+# support MAS.
+#
+# ref is a hash ref:
+# error (0|1) whether we expect an error
+# raise (0|1) means set RaiseError to this
+# commit (0|1) do the inserts in a txn
+# tuple arrayref of what we expect in the tuple status
+# e.g., [1,1,1,1,[]]
+# where the empty [] signifies we expect an error for this row
+# where 1 signifies we the expect row count for this row
+# affected - the total number of rows affected for insert/update
+#
+sub insert
+{
+ my ($self, $dbh, $sth, $ref) = @_;
+
+ die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH'));
+ note("insert " . join(", ", map {"$_ = ". DBI::neat($ref->{$_})} keys %$ref ));
+ # DBD::Oracle supports MAS don't compensate for it not
+ if ($ref->{requires_mas} && $dbh->{Driver}->{Name} eq 'Oracle') {
+ delete $ref->{requires_mas};
+ }
+ @captured_error = ();
+
+ if ($ref->{raise}) {
+ $sth->{RaiseError} = 1;
+ } else {
+ $sth->{RaiseError} = 0;
+ }
+
+ my (@tuple_status, $sts, $total_affected);
+ my $tuple_status_arg = {};
+ $tuple_status_arg->{ArrayTupleStatus} = \@tuple_status unless $ref->{notuplestatus};
+
+ $sts = 999999; # to ensure it is overwritten
+ $total_affected = 999998;
+ if ($ref->{array_context}) {
+ eval {
+ if ($ref->{params}) {
+ ($sts, $total_affected) =
+ $sth->execute_array($tuple_status_arg,
+ @{$ref->{params}});
+ } elsif ($ref->{fetch}) {
+ ($sts, $total_affected) =
+ $sth->execute_array(
+ {%{$tuple_status_arg},
+ ArrayTupleFetch => $ref->{fetch}});
+ } else {
+ ($sts, $total_affected) =
+ $sth->execute_array($tuple_status_arg);
+ }
+ };
+ } else {
+ eval {
+ if ($ref->{params}) {
+ $sts =
+ $sth->execute_array($tuple_status_arg,
+ @{$ref->{params}});
+ } else {
+ $sts =
+ $sth->execute_array($tuple_status_arg);
+ }
+ };
+ }
+ if ($ref->{error} && $ref->{raise}) {
+ ok($@, 'error in execute_array eval');
+ } else {
+ if ($ref->{requires_mas} && $@) {
+ diag("\nThis test died with $@");
+ diag("It requires multiple active statement support in the driver and I cannot easily determine if your driver supports MAS. Ignoring the rest of this test.");
+ foreach (@tuple_status) {
+ if (ref($_)) {
+ diag(join(",", @$_));
+ }
+ }
+ return 'mas';
+ }
+ ok(!$@, 'no error in execute_array eval') or note($@);
+ }
+ $dbh->commit if $ref->{commit};
+
+ if (!$ref->{raise} || ($ref->{error} == 0)) {
+ if (exists($ref->{sts})) {
+ is($sts, $ref->{sts},
+ "execute_array returned " . DBI::neat($sts) . " rows executed");
+ }
+ if (exists($ref->{affected}) && $ref->{array_context}) {
+ is($total_affected, $ref->{affected},
+ "total affected " . DBI::neat($total_affected))
+ }
+ }
+ if ($ref->{raise}) {
+ if ($ref->{error}) {
+ ok(scalar(@captured_error) > 0, "error captured");
+ } else {
+ is(scalar(@captured_error), 0, "no error captured");
+ }
+ }
+ if ($ref->{sts}) {
+ is(scalar(@tuple_status), (($ref->{sts} eq '0E0') ? 0 : $ref->{sts}),
+ "$ref->{sts} rows in tuple_status");
+ }
+ if ($ref->{tuple} && !exists($ref->{notuplestatus})) {
+ $self->check_tuple_status(\@tuple_status, $ref->{tuple});
+ }
+ return;
+}
+# simple test on ensure execute_array with no errors:
+# o checks returned status and affected is correct
+# o checks ArrayTupleStatus is correct
+# o checks no error is raised
+# o checks rows are inserted
+# o run twice with AutoCommit on/off
+# o checks if less values are specified for one parameter the right number
+# of rows are still inserted and NULLs are placed in the missing rows
+# checks binding via bind_param_array and adding params to execute_array
+# checks binding no parameters at all
+sub simple
+{
+ my ($self, $dbh, $ref) = @_;
+
+ note('simple tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref ));
+
+ note(" all param arrays the same size");
+ foreach my $commit (1,0) {
+ note(" Autocommit: $commit");
+ clear_table($dbh, $table);
+ $dbh->begin_work if !$commit;
+
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ $sth->bind_param_array(1, \@p1);
+ $sth->bind_param_array(2, \@p2);
+ $self->insert($dbh, $sth,
+ { commit => !$commit, error => 0, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref});
+ check_data($dbh, \@p1, \@p2);
+ }
+
+ note " Not all param arrays the same size";
+ clear_table($dbh, $table);
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+
+ $sth->bind_param_array(1, \@p1);
+ $sth->bind_param_array(2, [qw(one)]);
+ $self->insert($dbh, $sth, {commit => 0, error => 0,
+ raise => 1, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref});
+ check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);
+
+ note " Not all param arrays the same size with bind on execute_array";
+ clear_table($dbh, $table);
+ $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+
+ $self->insert($dbh, $sth, {commit => 0, error => 0,
+ raise => 1, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref,
+ params => [\@p1, [qw(one)]]});
+ check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);
+
+ note " no parameters";
+ clear_table($dbh, $table);
+ $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+
+ $self->insert($dbh, $sth, {commit => 0, error => 0,
+ raise => 1, sts => '0E0', affected => 0,
+ tuple => [], %$ref,
+ params => [[], []]});
+ check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);
+}
+
+# error test to ensure correct behavior for execute_array when it errors:
+# o execute_array of 5 inserts with last one failing
+# o check it raises an error
+# o check caught error is passed on from handler for eval
+# o check returned status and affected rows
+# o check ArrayTupleStatus
+# o check valid inserts are inserted
+# o execute_array of 5 inserts with 2nd last one failing
+# o check it raises an error
+# o check caught error is passed on from handler for eval
+# o check returned status and affected rows
+# o check ArrayTupleStatus
+# o check valid inserts are inserted
+sub error
+{
+ my ($self, $dbh, $ref) = @_;
+
+ die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH'));
+
+ note('error tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref ));
+ {
+ note("Last row in error");
+
+ clear_table($dbh, $table);
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ my @pe1 = @p1;
+ $pe1[-1] = 1;
+ $sth->bind_param_array(1, \@pe1);
+ $sth->bind_param_array(2, \@p2);
+ $self->insert($dbh, $sth, {commit => 0, error => 1, sts => undef,
+ affected => undef, tuple => [1, 1, 1, 1, []],
+ %$ref});
+ check_data($dbh, [@pe1[0..4]], [@p2[0..4]]);
+ }
+
+ {
+ note("2nd last row in error");
+ clear_table($dbh, $table);
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ my @pe1 = @p1;
+ $pe1[-2] = 1;
+ $sth->bind_param_array(1, \@pe1);
+ $sth->bind_param_array(2, \@p2);
+ $self->insert($dbh, $sth, {commit => 0, error => 1, sts => undef,
+ affected => undef, tuple => [1, 1, 1, [], 1], %$ref});
+ check_data($dbh, [@pe1[0..2],$pe1[4]], [@p2[0..2], $p2[4]]);
+ }
+}
+
+sub fetch_sub
+{
+ note("fetch_sub $fetch_row");
+ if ($fetch_row == @p1) {
+ note('returning undef');
+ $fetch_row = 0;
+ return;
+ }
+
+ return [$p1[$fetch_row], $p2[$fetch_row++]];
+}
+
+# test insertion via execute_array and ArrayTupleFetch
+sub row_wise
+{
+ my ($self, $dbh, $ref) = @_;
+
+ note("row_size via execute_for_fetch");
+
+ # Populate the first table via a ArrayTupleFetch which points to a sub
+ # returning rows
+ $fetch_row = 0; # reset fetch_sub to start with first row
+ clear_table($dbh, $table);
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref,
+ fetch => \&fetch_sub});
+
+ # NOTE: The following test requires Multiple Active Statements. Although
+ # I can find ODBC drivers which do this it is not easy (if at all possible)
+ # to know if an ODBC driver can handle MAS or not. If it errors the
+ # driver probably does not have MAS so the error is ignored and a
+ # diagnostic is output. Exceptions are DBD::Oracle which definitely does
+ # support MAS.
+ # The data pushed into the first table is retrieved via ArrayTupleFetch
+ # from the second table by passing an executed select statement handle into
+ # execute_array.
+ note("row_size via select");
+ clear_table($dbh, $table);
+ $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ my $sth2 = $dbh->prepare(qq/select * from $table2/);
+ # some drivers issue warnings when mas fails and this causes
+ # Test::NoWarnings to output something when we already found
+ # the test failed and captured it.
+ # e.g., some ODBC drivers cannot do MAS and this test is then expected to
+ # fail but we ignore the failure. Unfortunately in failing DBD::ODBC will
+ # issue a warning in addition to the fail
+ $sth->{Warn} = 0;
+ $sth->{Warn} = 0;
+ ok($sth2->execute, 'execute on second table') or diag($sth2->errstr);
+ ok($sth2->{Executed}, 'second statement is in executed state');
+ my $res = $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref,
+ fetch => $sth2, requires_mas => 1});
+ return if $res && $res eq 'mas'; # aborted , does not seem to support MAS
+ check_data($dbh, \@p1, \@p2);
+}
+
+# test updates
+# updates are special as you can update more rows than there are parameter rows
+sub update
+{
+ my ($self, $dbh, $ref) = @_;
+
+ note("update test");
+
+ # populate the first table with the default 5 rows using a ArrayTupleFetch
+ $fetch_row = 0;
+ clear_table($dbh, $table);
+ my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
+ $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref,
+ fetch => \&fetch_sub});
+ check_data($dbh, \@p1, \@p2);
+
+ # update all rows b column to 'fred' checking rows affected is 5
+ $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/);
+ # NOTE, this also checks you can pass a scalar to bind_param_array
+ $sth->bind_param_array(1, 'fred');
+ $sth->bind_param_array(2, \@p1);
+ $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 5, affected => 5,
+ tuple => [1, 1, 1, 1, 1], %$ref});
+ check_data($dbh, \@p1, [qw(fred fred fred fred fred)]);
+
+ # update 4 rows column b to 'dave' checking rows affected is 4
+ $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/);
+ # NOTE, this also checks you can pass a scalar to bind_param_array
+ $sth->bind_param_array(1, 'dave');
+ my @pe1 = @p1;
+ $pe1[-1] = 10; # non-existant row
+ $sth->bind_param_array(2, \@pe1);
+ $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 5, affected => 4,
+ tuple => [1, 1, 1, 1, '0E0'], %$ref});
+ check_data($dbh, \@p1, [qw(dave dave dave dave fred)]);
+
+ # now change all rows b column to 'pete' - this will change all 5
+ # rows even though we have 2 rows of parameters so we can see if
+ # the rows affected is > parameter rows
+ $sth = $dbh->prepare(qq/update $table set b = ? where b like ?/);
+ # NOTE, this also checks you can pass a scalar to bind_param_array
+ $sth->bind_param_array(1, 'pete');
+ $sth->bind_param_array(2, ['dave%', 'fred%']);
+ $self->insert($dbh, $sth,
+ {commit => 0, error => 0, sts => 2, affected => 5,
+ tuple => [4, 1], %$ref});
+ check_data($dbh, \@p1, [qw(pete pete pete pete pete)]);
+}
+
+sub enable_mars {
+ my $dbh = shift;
+
+ # this test uses multiple active statements
+ # if we recognise the driver and it supports MAS enable it
+ my $driver_name = $dbh->get_info(6) || '';
+ if (($driver_name eq 'libessqlsrv.so') ||
+ ($driver_name =~ /libsqlncli/)) {
+ my $dsn = $ENV{DBI_DSN};
+ if ($dsn !~ /^dbi:ODBC:DSN=/ && $dsn !~ /DRIVER=/i) {
+ my @a = split(q/:/, $ENV{DBI_DSN});
+ $dsn = join(q/:/, @a[0..($#a - 1)]) . ":DSN=" . $a[-1];
+ }
+ $dsn .= ";MARS_Connection=yes";
+ $dbh->disconnect;
+ $dbh = DBI->connect($dsn, $ENV{DBI_USER}, $ENV{DBI_PASS});
+ }
+ return $dbh;
+}
+
+1;
@@ -1,407 +0,0 @@
-#!perl -w
-
-use DBI;
-use DBD::Oracle qw(:ora_types ORA_OCI);
-use strict;
-
-#
-# Search for 'ocibug' to find code related to OCI LONG bugs.
-#
-
-sub ok ($$;$);
-
-$| = 1;
-my $t = 0;
-my $failed = 0;
-my %ocibug;
-my $table = "dbd_ora__drop_me";
-
-my $utf8_test = ($] >= 5.006) && ($ENV{NLS_LANG} && $ENV{NLS_LANG} =~ m/utf8$/i);
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '', {
- AutoCommit => 1,
- PrintError => 0,
-});
-
-unless($dbh) {
- warn "Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-unless(create_table("lng LONG")) {
- warn "Unable to create test table ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-sub array_test {
- return 0;
- eval {
- $dbh->{RaiseError}=1;
- $dbh->trace(3);
- my $sth = $dbh->prepare_cached(qq{
- UPDATE $table set idx=idx+1 RETURNING idx INTO ?
- });
- my ($a,$b);
- $a=[];
- $sth->bind_param_inout(1,\$a, 2);
- $sth->execute;
- print "a=$a\n";
- print "a=@$a\n";
- };
- die "RETURNING array: $@";
-}
-
-my @test_sets = (
- [ "LONG", 0 , 0 ],
- [ "LONG RAW", ORA_LONGRAW, 0 ]
-);
-push @test_sets,
- [ "CLOB", ORA_CLOB, 0 ],
- [ "BLOB", ORA_BLOB, 0 ]
- if ORA_OCI >= 8;
-
-# Set size of test data (in 10KB units)
-# Minimum value 3 (else tests fail because of assumptions)
-# Normal value 8 (to test 64KB threshold well)
-my $sz = 8;
-
-my $tests;
-my $tests_per_set = 37;
-$tests = @test_sets * $tests_per_set + 3;
-print "1..$tests\n";
-
-my($sth, $p1, $p2, $tmp, @tmp);
-#$dbh->trace(4);
-
-foreach (@test_sets) {
- my ($type_name, $type_num, $test_no_type) = @$_;
- run_long_tests($type_name, $type_num);
- run_long_tests($type_name, 0) if $test_no_type;
-}
-
-if (ORA_OCI >= 8) {
- print " --- testing ora_auto_lob to access raw LobLocator\n";
- # reuse the current test table, which has a BLOB field
- # for a quick test of auto_lob...
- my $lob_locator = $dbh->selectrow_array("select lng from $table", { ora_auto_lob=>0 });
- ok(0, $lob_locator, "lob_locator false");
- ok(0, ref $lob_locator eq 'OCILobLocatorPtr', ref $lob_locator);
- ok(0, $$lob_locator, "lob_locator deref ptr false");
-}
-else {
- for (1..3) { ok(0, 1) }
-}
-
-
-sub run_long_tests {
- my ($type_name, $type_num) = @_;
-
-# relationships between these lengths are important # e.g.
-
- my $long_data0;
- if ($utf8_test) {
- my $utf_x = eval q{ "0\x{263A}xyX" };
- my $utf_z = eval q{ "0\x{263A}xyZ" };
- $long_data0 = ($utf_x x 2048) x (1 ); # 10KB < 64KB
- if (length($long_data0) > 10240) {
- print "known bug in Perl5.6.0, applying workaround\n";
- $long_data0 = $utf_z;
- foreach my $i (1..2047) {
- $long_data0 .= $utf_z;
- }
- }
- if ($type_name =~ /BLOB/) {
- # convert string from utf-8 to byte encoding
- $long_data0 = pack "C*", (unpack "C*", $long_data0);
- }
- }
- else {
- $long_data0 = ("0\177x\0X" x 2048) x (1 ); # 10KB < 64KB
- }
-
-my $long_data1 = ("1234567890" x 1024) x ($sz ); # 80KB >> 64KB && > long_data2
-my $long_data2 = ("2bcdefabcd" x 1024) x ($sz-1); # 70KB > 64KB && < long_data1
-
-# special hack for long_data0 since RAW types need pairs of HEX
-$long_data0 = "00FF" x (length($long_data0) / 2) if $type_name =~ /RAW/i;
-
-my $len_data0 = length($long_data0);
-my $len_data1 = length($long_data1);
-my $len_data2 = length($long_data2);
-print "long_data0 length $len_data0\n";
-print "long_data1 length $len_data1\n";
-print "long_data2 length $len_data2\n";
-
-# warn if some of the key aspects of the data sizing are tampered with
-warn "long_data0 is > 64KB: $len_data0\n"
- if $len_data0 > 65535;
-warn "long_data1 is < 64KB: $len_data1\n"
- if $len_data1 < 65535;
-warn "long_data2 is not smaller than $long_data1 ($len_data2 > $len_data1)\n"
- if $len_data2 >= $len_data1;
-
-
-if (!create_table("lng $type_name", 1)) {
- # typically OCI 8 client talking to Oracle 7 database
- warn "Unable to create test table for '$type_name' data ($DBI::err). Tests skipped.\n";
- foreach (1..$tests_per_set) { ok(0, 1) }
- return;
-}
-
-print " --- insert some $type_name data (ora_type $type_num)\n";
-ok(0, $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)"), 1);
-$sth->bind_param(2, undef, { ora_type => $type_num }) or die "$type_name: $DBI::errstr"
- if $type_num;
-ok(0, $sth->execute(40, $long_data0), 1);
-ok(0, $sth->execute(41, $long_data1), 1);
-ok(0, $sth->execute(42, $long_data2), 1);
-ok(0, $sth->execute(42, undef), 1); # NULL
-
-array_test();
-
-print " --- fetch $type_name data back again -- truncated - LongTruncOk == 1\n";
-$dbh->{LongReadLen} = 20;
-$dbh->{LongTruncOk} = 1;
-print "LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n";
-
-# This behaviour isn't specified anywhere, sigh:
-my $out_len = $dbh->{LongReadLen};
-$out_len *= 2 if ($type_name =~ /RAW/i);
-
-ok(0, $sth = $dbh->prepare("select * from $table order by idx"), 1);
-ok(0, $sth->execute, 1);
-ok(0, $tmp = $sth->fetchall_arrayref, 1);
-ok(0, @$tmp == 4);
-ok(0, $tmp->[0][1] eq substr($long_data0,0,$out_len),
- cdif($tmp->[0][1], substr($long_data0,0,$out_len), "Len ".length($tmp->[0][1])) );
-ok(0, $tmp->[1][1] eq substr($long_data1,0,$out_len),
- cdif($tmp->[1][1], substr($long_data1,0,$out_len), "Len ".length($tmp->[1][1])) );
-ok(0, $tmp->[2][1] eq substr($long_data2,0,$out_len),
- cdif($tmp->[2][1], substr($long_data2,0,$out_len), "Len ".length($tmp->[2][1])) );
-#use Data::Dumper; print Dumper($tmp->[3]);
-#ok(0, !defined $tmp->[3][1], 1); # NULL # known bug in DBD::Oracle <= 1.13
-
-
-print " --- fetch $type_name data back again -- truncated - LongTruncOk == 0\n";
-$dbh->{LongReadLen} = $len_data1 - 10; # so $long_data0 fits but long_data1 doesn't
-$dbh->{LongReadLen} = $dbh->{LongReadLen} / 2 if $type_name =~ /RAW/i;
-my $LongReadLen = $dbh->{LongReadLen};
-$dbh->{LongTruncOk} = 0;
-print "LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n";
-
-ok(0, $sth = $dbh->prepare("select * from $table order by idx"), 1);
-ok(0, $sth->execute, 1);
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-ok(0, $tmp->[1] eq $long_data0, length($tmp->[1]));
-
-ok(0, !defined $sth->fetchrow_arrayref,
- "truncation error not triggered "
- ."(LongReadLen $LongReadLen, data ".length($tmp->[1]||0).")");
-$tmp = $sth->err || 0;
-ok(0, $tmp == 1406 || $tmp == 24345, 1);
-
-
-print " --- fetch $type_name data back again -- complete - LongTruncOk == 0\n";
-$dbh->{LongReadLen} = $len_data1 +1000;
-$dbh->{LongTruncOk} = 0;
-print "LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n";
-
-ok(0, $sth = $dbh->prepare("select * from $table order by idx"), 1);
-#$sth->trace(4);
-ok(0, $sth->execute, 1);
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-ok(0, $tmp->[1] eq $long_data0, length($tmp->[1]));
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-ok(0, $tmp->[1] eq $long_data1, length($tmp->[1]));
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-if ($tmp->[1] eq $long_data2) {
- ok(0, 1);
-}
-elsif (length($tmp->[1]) == length($long_data1)
- && DBD::Oracle::ORA_OCI() == 7
- && substr($tmp->[1], 0, length($long_data2)) eq $long_data2
-) {
- print "OCI7 buffer overwite bug detected\n";
- $ocibug{LongReadLen} = __LINE__; # see also blob_read tests below
- # The bug:
- # If you fetch a LONG field and then fetch another row
- # which has a LONG field shorter than the previous
- # then the second long will appear to have the
- # longer portion of first appended to it!
- ok(0, 1);
-}
-else {
- ok(0, $tmp->[1] eq $long_data2,
- cdif($tmp->[1],$long_data2, "Len ".length($tmp->[1])) );
-}
-$sth->trace(0);
-
-
-print " --- fetch $type_name data back again -- via blob_read\n";
-if (ORA_OCI >= 8 && $type_name =~ /LONG/i) {
- print "Skipped blob_read tests for LONGs with OCI8 - not currently supported.\n";
- foreach (1..11) { ok(0,1) }
- return;
-}
-#$dbh->trace(4);
-$dbh->{LongReadLen} = 1024 * 90;
-$dbh->{LongTruncOk} = 1;
-ok(0, $sth = $dbh->prepare("select * from $table order by idx"), 1);
-ok(0, $sth->execute, 1);
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-
-ok(0, blob_read_all($sth, 1, \$p1, 4096) == length($long_data0), 1);
-ok(0, $p1 eq $long_data0, cdif($p1, $long_data0));
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-ok(0, blob_read_all($sth, 1, \$p1, 12345) == length($long_data1), 1);
-ok(0, $p1 eq $long_data1, cdif($p1, $long_data1));
-
-ok(0, $tmp = $sth->fetchrow_arrayref, 1);
-my $len = blob_read_all($sth, 1, \$p1, 34567);
-
-if ($len == length($long_data2)) {
- ok(0, $len == length($long_data2), $len);
- # Oracle may return the right length but corrupt the string.
- ok(0, $p1 eq $long_data2, cdif($p1, $long_data2) );
-}
-elsif ($len == length($long_data1)
- && DBD::Oracle::ORA_OCI() == 7
- && substr($p1, 0, length($long_data2)) eq $long_data2
-) {
- print "OCI7 buffer overwite bug detected\n";
- $ocibug{blob_read} = __LINE__; # see also blob_read tests below
- # The bug:
- # If you use blob_read to read a LONG field
- # and then fetch another row
- # and use blob_read to read that LONG field
- # If the second LONG is shorter than the first
- # then the second long will appear to have the
- # longer portion of first appended to it.
- ok(0, 1);
- ok(0, 1, 0);
-}
-else {
- ok(0, 0, "Fetched length $len, expected ".length($long_data2));
- ok(0, 0, 0);
-}
-
-} # end of run_long_tests
-
-if (%ocibug) {
- my @lines = sort values %ocibug;
- warn "\n\aYour version of Oracle 7 OCI has a bug that affects fetching LONG data.\n";
- warn "See the t/long.t script near lines @lines for more information.\n";
- warn "You can safely ignore this if: You don't fetch data from LONG fields;\n";
- warn "Or the LONG data you fetch is never longer than 65535 bytes long;\n";
- warn "Or you only fetch one LONG record in the life of a statement handle.\n";
-}
-
-if ($failed) {
- warn "\nSome tests for LONG data type handling failed. These are generally Oracle bugs.\n";
- warn "Please report this to the dbi-users mailing list, and include the\n";
- warn "Oracle version number of both the client and the server.\n";
- warn "Please also include the output of the 'perl -V' command.\n";
- warn "(If you can, please study t/long.t to investigate the cause.\n";
- warn "Feel free to edit the tests to see what's happening in more detail.\n";
- warn "Especially by adding trace() calls around the failing tests.\n";
- warn "Run the tests manually using the command \"perl -Mblib t/long.t\")\n";
- warn "Meanwhile, if the other tests have passed you can use DBD::Oracle.\n\n";
-}
-
-sleep 6 if $failed || %ocibug;
-
-exit 0;
-BEGIN { $tests = 27 }
-END {
- $dbh->do(qq{ drop table $table }) if $dbh;
-}
-# end.
-
-
-# ----
-
-sub create_table {
- my ($fields, $drop) = @_;
- my $sql = "create table $table ( idx integer, $fields, dt date )";
- $dbh->do(qq{ drop table $table }) if $drop;
- $dbh->do($sql);
- if ($dbh->err && $dbh->err==955) {
- $dbh->do(qq{ drop table $table });
- warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err;
- $dbh->do($sql);
- }
- return 0 if $dbh->err;
- print "$sql\n";
- return 1;
-}
-
-sub blob_read_all {
- my ($sth, $field_idx, $blob_ref, $lump) = @_;
-
- $lump ||= 4096; # use benchmarks to get best value for you
- my $offset = 0;
- my @frags;
- while (1) {
- my $frag = $sth->blob_read($field_idx, $offset, $lump);
- return unless defined $frag;
- my $len = length $frag;
- last unless $len;
- push @frags, $frag;
- $offset += $len;
- #warn "offset $offset, len $len\n";
- }
- $$blob_ref = join "", @frags;
- return length($$blob_ref);
-}
-
-sub unc {
- my @str = @_;
- foreach (@str) { s/([\000-\037\177-\377])/ sprintf "\\%03o", ord($_) /eg; }
- return join "", @str unless wantarray;
- return @str;
-}
-
-sub cdif {
- my ($s1, $s2, $msg) = @_;
- $msg = ($msg) ? ", $msg" : "";
- my ($l1, $l2) = (length($s1), length($s2));
- return "Strings are identical$msg" if $s1 eq $s2;
- return "Strings are of different lengths ($l1 vs $l2)$msg" # check substr matches?
- if $l1 != $l2;
- my $i;
- for($i=0; $i < $l1; ++$i) {
- my ($c1,$c2) = (ord(substr($s1,$i,1)), ord(substr($s2,$i,1)));
- next if $c1 == $c2;
- return sprintf "Strings differ at position %d (\\%03o vs \\%03o)$msg",
- $i,$c1,$c2;
- }
- return "(cdif error $l1/$l2/$i)";
-}
-
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- $warn ||= '';
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- if ($ok) {
- print "ok $t\n";
- }
- else {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "# failed test $t at line ".(caller)[2].". $warn\n";
- print "not ok $t\n";
- ++$failed;
- }
-}
-
-__END__
@@ -1,59 +0,0 @@
-#!perl -w
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use strict;
-use DBI;
-use Data::Dumper;
-
-$| = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '', { PrintError => 0 });
-
-unless ($dbh) {
- warn "Unable to connect to Oracle as $dbuser ($DBI::errstr)\nTests skipped.\n";
- print "1..0\n";
- exit 0;
-}
-
-print "1..10\n";
-
-my @tables = $dbh->tables;
-print @tables." tables\n";
-ok(0, scalar @tables);
-
-my @table_info_params = (
- [ 'schema list', undef, '%', undef, undef ],
- [ 'type list', undef, undef, undef, '%' ],
- [ 'table list', undef, undef, undef, undef ],
-);
-foreach my $table_info_params (@table_info_params) {
- my ($name) = shift @$table_info_params;
- my $start = time;
- print "$name: table_info(".DBI::neat_list($table_info_params).")\n";
- my $table_info_sth = $dbh->table_info(@$table_info_params);
- ok(0, $table_info_sth);
- my $data = $table_info_sth->fetchall_arrayref;
- ok(0, $data);
- ok(0, scalar @$data);
- my $dur = time - $start;
- print "$name: ".@$data." rows, $dur seconds\n";
-# print Dumper($data);
-}
-
-$dbh->disconnect;
-
-exit 0;
-
@@ -0,0 +1,523 @@
+use strict;
+use warnings;
+use Carp;
+use Data::Dumper;
+use DBI;
+use DBD::Oracle qw(ORA_OCI ora_env_var);
+
+require utf8;
+
+# perl 5.6 doesn't define utf8::is_utf8()
+unless (defined &{"utf8::is_utf8"}) {
+ die "Can't run this test using Perl $] without DBI >= 1.38"
+ unless $DBI::VERSION >= 1.38;
+ *utf8::is_utf8 = sub {
+ my $raw = shift;
+ return 0 if !defined $raw;
+ my $v = DBI::neat($raw);
+ return 1 if $v =~ /^"/; # XXX ugly hack, sufficient here
+ return 0 if $v =~ /^'/; # XXX ugly hack, sufficient here
+ carp "Emulated utf8::is_utf8 is unreliable for $v ($raw)";
+ return 0;
+ }
+}
+
+=head binmode STDOUT, ':utf8'
+
+ Wide character in print at t/nchar_test_lib.pl line 134 (#1)
+ (W utf8) Perl met a wide character (>255) when it wasn't expecting
+ one. This warning is by default on for I/O (like print). The easiest
+ way to quiet this warning is simply to add the :utf8 layer to the
+ output, e.g. binmode STDOUT, ':utf8'. Another way to turn off the
+ warning is to add no warnings 'utf8'; but that is often closer to
+ cheating. In general, you are supposed to explicitly mark the
+ filehandle with an encoding, see open and perlfunc/binmode.
+=cut
+eval { binmode STDOUT, ':utf8' }; # Fails for perl 5.6
+diag("Can't set binmode(STDOUT, ':utf8'): $@") if $@;
+eval { binmode STDERR, ':utf8' }; # Fails for perl 5.6
+diag("Can't set binmode(STDERR, ':utf8'): $@") if $@;
+
+# Test::More duplicates STDOUT/STDERR at the start but does not copy the IO
+# layers from our STDOUT/STDERR. As a result any calls to Test::More::diag
+# with utf8 data will show warnings. Similarly, if we pass utf8 into
+# Test::More::pass, ok, etc etc. To get around this we specifically tell
+# Test::More to use our newly changed STDOUT and STDERR for failure_output
+# and output.
+my $tb = Test::More->builder;
+binmode($tb->failure_output, ':utf8');
+binmode($tb->output, ':utf8');
+
+sub long_test_cols
+{
+ my ($type) = @_ ;
+ return
+ [
+ [ lng => $type ],
+ ];
+}
+sub char_cols
+{
+ [
+ [ ch => 'varchar2(20)' ],
+ [ descr => 'varchar2(50)' ],
+ ];
+}
+sub nchar_cols
+{
+ [
+ [ nch => 'nvarchar2(20)' ],
+ [ descr => 'varchar2(50)' ],
+ ];
+}
+sub wide_data
+{
+ [
+ [ "\x{03}", "control-C" ],
+ [ "a", "lowercase a" ],
+ [ "b", "lowercase b" ],
+ [ "\x{263A}", "smiley face" ],
+# These are not safe for db's with US7ASCII
+# [ "\x{A1}", "upside down bang" ],
+# [ "\x{A2}", "cent char" ],
+# [ "\x{A3}", "british pound" ],
+ ];
+}
+sub extra_wide_rows
+{
+ # Non-BMP characters require use of surrogates with UTF-16
+ # So U+10304 becomes U+D800 followed by U+DF04 (I think) in UTF-16.
+ #
+ # When encoded as standard UTF-8, which Oracle calls AL32UTF8, it should
+ # be a single UTF-8 code point (that happens to occupy 4 bytes).
+ #
+ # When encoded as "CESU-8", which Oracle calls "UTF8", each surrogate
+ # is treated as a code point so you get 2 UTF-8 code points
+ # (that happen to occupy 3 bytes each). That is not valid UTF-8.
+ # See http://www.unicode.org/reports/tr26/ for more information.
+ return unless ORA_OCI >= 9.2; # need AL32UTF8 for these to work
+ return (
+ [ "\x{10304}", "SMP Plane 1 wide char" ], # OLD ITALIC LETTER E
+ [ "\x{20301}", "SIP Plane 2 wide char" ], # CJK Unified Ideographs Extension B
+ );
+}
+sub narrow_data # Assuming WE8ISO8859P1 or WE8MSWIN1252 character set
+{
+ my $highbitset = [
+ # These non-unicode strings are not safe if client charset is utf8
+ # because we have to let oracle assume they're utf8 but they're not
+ [ chr(161), "upside down bang" ],
+ [ chr(162), "cent char" ],
+ [ chr(163), "british pound" ],
+ ];
+ [
+ [ "a", "lowercase a" ],
+ [ "b", "lowercase b" ],
+ [ chr(3), "control-C" ],
+ (nls_local_has_utf8()) ? () : @$highbitset
+ ];
+}
+
+my $tdata_hr = {
+ narrow_char => {
+ cols => char_cols(),
+ rows => narrow_data()
+ }
+ ,
+ narrow_nchar => {
+ cols => nchar_cols(),
+ rows => narrow_data()
+ }
+ ,
+ wide_char => {
+ cols => char_cols(),
+ rows => wide_data()
+ }
+ ,
+ wide_nchar => {
+ cols => nchar_cols(),
+ rows => wide_data()
+ }
+ ,
+};
+sub test_data
+{
+ my ($which) = @_;
+ my $test_data = $tdata_hr->{$which} or die;
+ $test_data->{dump} = "DUMP(%s)";
+ if ($ENV{DBD_ORACLE_TESTLOB}) { # XXX temp. needs reworking
+ # Nvarchar -> Nclob and varchar -> clob
+ $test_data->{cols}[0][1] =~ s/varchar.*/CLOB/;
+ $test_data->{dump} = "DUMP(DBMS_LOB.SUBSTR(%s))";
+ }
+ return $test_data;
+}
+
+sub oracle_test_dsn
+{
+ my( $default, $dsn ) = ( 'dbi:Oracle:', $ENV{ORACLE_DSN} );
+
+
+ $dsn ||= $ENV{DBI_DSN} if $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ /^$default/io);
+ $dsn ||= $default;
+
+ return $dsn;
+}
+
+sub db_handle
+{
+ my $dsn = oracle_test_dsn();
+ my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+ my $dbh = DBI->connect($dsn, $dbuser, '', {
+ AutoCommit => 1,
+ PrintError => 0,
+ ora_envhp => 0, # force fresh environment (with current NLS env vars)
+ });
+ return $dbh;
+}
+sub show_test_data
+{
+ my ($tdata) = @_;
+ my $rowsR = $tdata->{rows};
+ my $cnt = 0;
+ my $vcnt = 0;
+ foreach my $recR ( @$rowsR )
+ {
+ $cnt++;
+ my $v = $$recR[0];
+ my $byte_string = byte_string($v);
+ my $nice_string = nice_string($v);
+ my $out = sprintf( "row: %3d: nice_string=%s byte_string=%s (%s, %s)\n",
+ $cnt, $nice_string, $byte_string, $v, DBI::neat($v));
+ note($out);
+ }
+ return $cnt;
+}
+
+sub table { 'dbd_ora__drop_me'.($ENV{DBD_ORACLE_SEQ}||''); }
+sub drop_table
+{
+ my ($dbh) = @_;
+ my $table = table();
+ local $dbh->{PrintError} = 0;
+ $dbh->do(qq{ drop table $table }) if $dbh->{Active};
+}
+
+sub insert_handle
+{
+ my ($dbh,$tcols) = @_;
+ my $table = table();
+ my $sql = "insert into $table ( idx, ";
+ my $cnt = 1;
+ foreach my $col ( @$tcols )
+ {
+ $sql .= $$col[0] . ", ";
+ $cnt++;
+ }
+ $sql .= "dt ) values( " . "?, " x $cnt ."sysdate )";
+ my $h = $dbh->prepare( $sql );
+ ok( $h ,"prepared: $sql" );
+ return $h;
+}
+sub insert_test_count
+{
+ my ( $tdata ) = @_;
+ my $rcnt = @{$tdata->{rows}};
+ my $ccnt = @{$tdata->{cols}};
+ return 1 + $rcnt*2 + $rcnt * $ccnt;
+}
+sub insert_rows #1 + rows*2 +rows*ncols tests
+{
+ my ($dbh, $tdata ,$csform) = @_;
+ my $trows = $tdata->{rows};
+ my $tcols = $tdata->{cols};
+ my $table = table();
+ # local $dbh->{TraceLevel} = 4;
+ my $sth = insert_handle($dbh, $tcols);
+
+ my $cnt = 0;
+ foreach my $rowR ( @$trows )
+ {
+ my $colnum = 1;
+ my $attrR = $csform ? { ora_csform => $csform } : {};
+ ok( $sth->bind_param( $colnum++ ,$cnt ) ,"bind_param idx" );
+ for( my $i = 0; $i < @$rowR; $i++ )
+ {
+ my $note = 'withOUT attribute ora_csform';
+ my $val = $$rowR[$i];
+ my $type = $$tcols[$i][1];
+ #print "type=$type\n";
+ my $attr = {};
+ if ( $type =~ m/^nchar|^nvar|^nclob/i )
+ {
+ $attr = $attrR;
+ $note = $attr && $csform ? "with attribute { ora_csform => $csform }" : "";
+ }
+ ok( $sth->bind_param( $colnum++ ,$val ,$attr ) ,"bind_param " . $$tcols[$i][0] ." $note" );
+ }
+ $cnt++;
+ ok( $sth->execute ,"insert row $cnt: $rowR->[-1]" );
+ }
+}
+sub dump_table
+{
+ my ( $dbh ,@cols ) = @_;
+return; # not needed now select_handle() includes a DUMP column
+ my $table = table();
+ my $colstr = '';
+ foreach my $col ( @cols ) {
+ $colstr .= ", " if $colstr;
+ $colstr .= "dump($col)"
+ }
+ my $sql = "select $colstr from $table order by idx" ;
+ print "dumping $table\nprepared: $sql\n" ;
+ my $colnum = 0;
+ my $data = eval { $dbh->selectall_arrayref( $sql ) } || [];
+ my $cnt = 0;
+ while ( my $aref = shift @$data ) {
+ $cnt++;
+ my $colnum = 0;
+ foreach my $col ( @cols ) {
+ print "row $cnt: " ;
+ print "$col=" .$$aref[$colnum] ."\n";
+ $colnum++;
+ }
+ }
+}
+sub select_handle #1 test
+{
+ my ($dbh,$tdata) = @_;
+ my $table = table();
+ my $sql = "select ";
+ foreach my $col ( @{$tdata->{cols}} )
+ {
+ $sql .= $$col[0] . ", ";
+ }
+ $sql .= sprintf "$tdata->{dump}, ", $tdata->{cols}[0][0];
+ $sql .= "dt from $table order by idx" ;
+ my $h = $dbh->prepare( $sql );
+ ok( $h ,"prepared: $sql" );
+ return $h;
+}
+sub select_test_count
+{
+ my ( $tdata ) = @_;
+ my $rcnt = @{$tdata->{rows}};
+ my $ccnt = @{$tdata->{cols}};
+ return 2 + $ccnt + $rcnt * $ccnt * 2;
+}
+sub select_rows # 1 + numcols + rows * cols * 2
+{
+ my ($dbh,$tdata,$csform) = @_;
+ my $table = table();
+ my $trows = $tdata->{rows};
+ my $tcols = $tdata->{cols};
+ my $sth = select_handle($dbh,$tdata)
+ or do { fail(); return };
+ my @data = ();
+ my $colnum = 0;
+ foreach my $col ( @$tcols )
+ {
+ ok( $sth->bind_col( $colnum+1 ,\$data[$colnum] ), "bind column " .$$tcols[$colnum][0] );
+ $colnum++;
+ }
+ my $dumpcol = sprintf $tdata->{dump}, $tdata->{cols}[0][0];
+ #ok( $sth->bind_col( $colnum+1 ,\$data[$colnum] ), "bind column DUMP(" .$tdata->{cols}[0][0] .")" );
+ $sth->bind_col( $colnum+1 ,\$data[$colnum] );
+ my $cnt = 0;
+ $sth->execute();
+ while ( $sth->fetch() )
+ {
+ my $row = $cnt + 1;
+ my $error = 0;
+ my $i = 0;
+ for( $i = 0 ; $i < @$tcols; $i++ )
+ {
+ my $res = $data[$i];
+ my $charname = $trows->[$cnt][1] || '';
+ my $is_utf8 = utf8::is_utf8( $res ) ? " (uft8)" : "";
+ my $description = "row $row: column: $tcols->[$i][0] $is_utf8 $charname";
+
+ $error += not cmp_ok_byte_nice($res, $$trows[$cnt][$i], $description);
+ #$sth->trace(0) if $cnt >= 3 ;
+ }
+ if ( $error )
+ {
+ warn "# row $row: $dumpcol = " .$data[$i]. "\n" ;
+ }
+ $cnt++;
+ }
+ #$sth->trace(0);
+ my $trow_cnt = @$trows;
+ cmp_ok( $cnt, '==', $trow_cnt, "number of rows fetched" );
+}
+
+sub cmp_ok_byte_nice {
+ my ($got, $expected, $description) = @_;
+ my $ok1 = cmp_ok( byte_string($got), 'eq', byte_string($expected),
+ "byte_string test of $description"
+ );
+ my $ok2 = cmp_ok( nice_string($got), 'eq', nice_string($expected),
+ "nice_string test of $description"
+ );
+ return $ok1 && $ok2;
+}
+
+sub create_table
+{
+ my ($dbh,$tdata,$drop) = @_;
+ my $tcols = $tdata->{cols};
+ my $table = table();
+ my $sql = "create table $table ( idx integer, ";
+ foreach my $col ( @$tcols )
+ {
+ $sql .= $$col[0] . " " .$$col[1] .", ";
+ }
+ $sql .= " dt date )";
+
+ drop_table( $dbh ) if $drop;
+ #$dbh->do(qq{ drop table $table }) if $drop;
+ $dbh->do($sql);
+ if ($dbh->err && $dbh->err==955) {
+ $dbh->do(qq{ drop table $table });
+ warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err;
+ $dbh->do($sql);
+ } elsif ($dbh->err) {
+ return;
+ } else {
+ #$sql =~ s/ \( */(\n\t/g;
+ #$sql =~ s/, */,\n\t/g;
+ note("$sql\n") ;
+ }
+ return $table;
+# ok( not $dbh->err, "create table $table..." );
+}
+
+
+
+sub show_db_charsets
+{
+ my ( $dbh) = @_;
+ my $out;
+ my $ora_server_version = join ".", @{$dbh->func("ora_server_version")||[]};
+ my $paramsH = $dbh->ora_nls_parameters();
+ $out = sprintf "Database $ora_server_version CHAR set is %s (%s), NCHAR set is %s (%s)\n",
+ $paramsH->{NLS_CHARACTERSET},
+ db_ochar_is_utf($dbh) ? "Unicode" : "Non-Unicode",
+ $paramsH->{NLS_NCHAR_CHARACTERSET},
+ db_nchar_is_utf($dbh) ? "Unicode" : "Non-Unicode";
+ note($out);
+ my $ora_client_version = ORA_OCI();
+ $out = sprintf "Client $ora_client_version NLS_LANG is '%s', NLS_NCHAR is '%s'\n",
+ ora_env_var("NLS_LANG") || "<unset>", ora_env_var("NLS_NCHAR") || "<unset>";
+ note($out);
+}
+sub db_ochar_is_utf { return shift->ora_can_unicode & 2 }
+sub db_nchar_is_utf { return shift->ora_can_unicode & 1 }
+
+sub client_ochar_is_utf8 {
+ my $NLS_LANG = ora_env_var("NLS_LANG") || '';
+ $NLS_LANG =~ s/.*\.//;
+ return $NLS_LANG =~ m/utf8/i;
+}
+sub client_nchar_is_utf8 {
+ my $NLS_LANG = ora_env_var("NLS_LANG") || '';
+ $NLS_LANG =~ s/.*\.//;
+ my $NLS_NCHAR = ora_env_var("NLS_NCHAR") || $NLS_LANG;
+ return $NLS_NCHAR =~ m/utf8/i;
+}
+
+sub nls_local_has_utf8
+{
+ return client_ochar_is_utf8() || client_nchar_is_utf8();
+}
+
+sub set_nls_nchar
+{
+ my ($cset,$verbose) = @_;
+ if ( defined $cset ) {
+ $ENV{NLS_NCHAR} = "$cset"
+ } else {
+ undef $ENV{NLS_NCHAR}; # XXX windows? (perhaps $ENV{NLS_NCHAR}=""?)
+ }
+ # Special treatment for environment variables under Cygwin -
+ # see comments in dbdimp.c for details.
+ DBD::Oracle::ora_cygwin_set_env('NLS_NCHAR', $ENV{NLS_NCHAR}||'')
+ if $^O eq 'cygwin';
+ note(defined ora_env_var("NLS_NCHAR") ? # defined?
+ "set \$ENV{NLS_NCHAR}=$cset\n" :
+ "set \$ENV{NLS_LANG}=undef\n") # XXX ?
+ if defined $verbose;
+}
+
+sub set_nls_lang_charset
+{
+ my ($lang,$verbose) = @_;
+
+ $ENV{NLS_LANG} = $lang ? "AMERICAN_AMERICA.$lang" : '';
+
+ note "set \$ENV{NLS_LANG='$ENV{NLS_LANG}'";
+
+ # Special treatment for environment variables under Cygwin -
+ # see comments in dbdimp.c for details.
+ DBD::Oracle::ora_cygwin_set_env('NLS_LANG', $ENV{NLS_LANG}||'')
+ if $^O eq 'cygwin';
+}
+
+sub byte_string {
+ my $ret = join( "|" ,unpack( "C*" ,$_[0] ) );
+ return $ret;
+}
+sub nice_string {
+ my @raw_chars = (utf8::is_utf8($_[0]))
+ ? unpack("U*", $_[0]) # unpack unicode characters
+ : unpack("C*", $_[0]); # not unicode, so unpack as bytes
+ my @chars = map {
+ $_ > 255 ? # if wide character...
+ sprintf("\\x{%04X}", $_) : # \x{...}
+ chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
+ sprintf("\\x%02X", $_) : # \x..
+ chr($_) # else as themselves
+ } @raw_chars;
+
+ foreach my $c ( @chars )
+ {
+ if ( $c =~ m/\\x\{08(..)}/ ) {
+ $c .= "='" .chr(hex($1)) ."'";
+ }
+ }
+ my $ret = join("",@chars);
+
+}
+
+
+sub view_with_sqlplus
+{
+ my ( $use_nls_lang ,$tdata ) = @_ ;
+ my $table = table();
+ my $tcols = $tdata->{cols};
+ my $sqlfile = "sql.txt" ;
+ my $cols = 'idx,nch_col' ;
+ open F , ">$sqlfile" or die "could open $sqlfile";
+ print F $ENV{ORACLE_USERID} ."\n";
+ my $str = qq(
+col idx form 99
+col ch_col form a8
+col nch_col form a16
+select $cols from $table;
+) ;
+ print F $str;
+ print F "exit;\n" ;
+ close F;
+
+ my $nls='unset';
+ $nls = ora_env_var("NLS_LANG") if ora_env_var("NLS_LANG");
+ local $ENV{NLS_LANG} = '' if not $use_nls_lang;
+ print "From sqlplus...$str\n ...with NLS_LANG = $nls\n" ;
+ system( "sqlplus -s \@$sqlfile" );
+ unlink $sqlfile;
+}
+
+
+
+1;
@@ -1,138 +0,0 @@
-#!perl -w
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use strict;
-use DBI qw(neat);
-use DBD::Oracle qw(ORA_OCI);
-use vars qw($tests);
-
-$| = 1;
-$^W = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dsn = $ENV{ORACLE_DSN} || 'dbi:Oracle:';
-my $dbh = DBI->connect($dsn, $dbuser, '', {
- AutoCommit => 0,
- PrintError => 1,
- FetchHashKeyName => 'NAME_lc',
-});
-
-unless($dbh) {
- warn "Unable to connect to Oracle ($DBI::errstr)\nTests skipped.\n";
- print "1..0\n";
- exit 0;
-}
-
-eval {
- require Data::Dumper;
- $Data::Dumper::Useqq = $Data::Dumper::Useqq =1;
- $Data::Dumper::Terse = $Data::Dumper::Terse =1;
- $Data::Dumper::Indent= $Data::Dumper::Indent=1;
-};
-
-# XXX ought to extend test to check 'blank padded comparision semantics'
-my @tests = ( # skip=1 to skip, ti=N to trace insert, ts=N to trace select
- { type=>97, name=>"CHARZ", chops_space=>0, embed_nul=>0, skip=>1, ti=>8 },
- { type=> 5, name=>"STRING", chops_space=>0, embed_nul=>0, skip=>1, ti=>8 }, # old Oraperl
- { type=>96, name=>"CHAR", chops_space=>0, embed_nul=>1, skip=>0 },
- { type=> 1, name=>"VARCHAR2", chops_space=>1, embed_nul=>1, skip=>0 }, # current DBD::Oracle
-);
-
-$tests = 3;
-$_->{skip} or $tests+=8 for @tests;
-
-print "1..$tests\n";
-
-my ($sth,$tmp);
-my $table = "dbd_oracle_test__drop_me";
-
-# drop table but don't warn if not there
-eval {
- local $dbh->{PrintError} = 0;
- $dbh->do("DROP TABLE $table");
-};
-
-ok(0, $dbh->do("CREATE TABLE $table (name VARCHAR2(2), vc VARCHAR2(20), c CHAR(20))"));
-
-my $val_with_trailing_space = "trailing ";
-my $val_with_embedded_nul = "embedded\0nul";
-
-for my $test_info (@tests) {
- next if $test_info->{skip};
-
- my $ph_type = $test_info->{type} || die;
- my $name = $test_info->{name} || die;
- print "#\n";
- print "# testing @{[ %$test_info ]} ...\n";
- print "#\n";
- if ($test_info->{skip}) {
- print "# skipping tests\n";
- foreach (1..12) { ok(0,1) }
- next;
- }
-
- $dbh->{ora_ph_type} = $ph_type;
- ok(0, $dbh->{ora_ph_type} == $ph_type );
-
- $sth = $dbh->prepare("INSERT INTO $table(name,vc,c) VALUES (?,?,?)");
- $sth->trace($test_info->{ti}) if $test_info->{ti};
- $sth->execute("ts", $val_with_trailing_space, $val_with_trailing_space);
- $sth->execute("en", $val_with_embedded_nul, $val_with_embedded_nul);
- $sth->execute("es", '', ''); # empty string
- $sth->trace(0) if $test_info->{ti};
-
- $dbh->trace($test_info->{ts}) if $test_info->{ts};
- $tmp = $dbh->selectall_hashref(qq{
- SELECT name, vc, length(vc) as len, nvl(vc,'ISNULL') as isnull
- FROM $table
- }, "name");
- ok(0, keys(%$tmp) == 3);
- $dbh->trace(0) if $test_info->{ts};
- $dbh->rollback;
-
- delete $_->{name} foreach values %$tmp;
- print Data::Dumper::Dumper($tmp);
-
- # check trailing_space behaviour
- my $expect = $val_with_trailing_space;
- $expect =~ s/\s+$// if $test_info->{chops_space};
- my $ok = ($tmp->{ts}->{vc} eq $expect);
- if (!$ok && ORA_OCI==7 && $name eq 'VARCHAR2') {
- warn " OCI7 ora_type=1 placeholder doesn't strip trailing spaces, OCI8 currently does\n";
- $ok = 1;
- }
- ok(0, $ok, sprintf(" expected %s but got %s for $name",
- neat($expect),neat($tmp->{ts}->{vc})) );
-
- # check embedded nul char behaviour
- $expect = $val_with_embedded_nul;
- $expect =~ s/\0.*// unless $test_info->{embed_nul};
- ok(0, $tmp->{en}->{vc} eq $expect, sprintf(" expected %s but got %s for $name",
- neat($expect),neat($tmp->{en}->{vc})) );
-
- # check empty string is NULL (irritating Oracle behaviour)
- ok(0, !defined $tmp->{es}->{vc});
- ok(0, !defined $tmp->{es}->{c});
- ok(0, !defined $tmp->{es}->{len});
- ok(0, $tmp->{es}->{isnull} eq 'ISNULL');
-
- exit 1 if $test_info->{ti} || $test_info->{ts};
-}
-
-ok(0, $dbh->do("DROP TABLE $table"));
-ok(0, $dbh->disconnect );
-
-
-__END__
@@ -1,292 +0,0 @@
-#!perl -w
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use DBI;
-use DBD::Oracle qw(ORA_RSET);
-use strict;
-
-$| = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '', { PrintError => 0 });
-
-unless($dbh) {
- warn "Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-# ORA-00900: invalid SQL statement
-# ORA-06553: PLS-213: package STANDARD not accessible
-my $tst = $dbh->prepare(q{declare foo char(50); begin RAISE INVALID_NUMBER; end;});
-if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) {
- warn "Your Oracle server doesn't support PL/SQL" if $dbh->err== 900;
- warn "Your Oracle PL/SQL is not properly installed" if $dbh->err==6553||$dbh->err==600;
- warn "Tests skipped\n";
- print "1..0\n";
- exit 0;
-}
-
-my $tests;
-print "1..$tests\n";
-
-my($csr, $p1, $p2, $tmp, @tmp);
-#DBI->trace(4,"trace.log");
-
-
-# --- test raising predefined exception
-ok(0, $csr = $dbh->prepare(q{
- begin RAISE INVALID_NUMBER; end;
-}), 1);
-
-# ORA-01722: invalid number
-ok(0, ! $csr->execute, 1);
-ok(0, $DBI::err == 1722);
-ok(0, $DBI::err == 1722); # make sure error doesn't get cleared
-
-
-# --- test raising user defined exception
-ok(0, $csr = $dbh->prepare(q{
- DECLARE FOO EXCEPTION;
- begin raise FOO; end;
-}), 1);
-
-# ORA-06510: PL/SQL: unhandled user-defined exception
-ok(0, ! $csr->execute, 1);
-ok(0, $DBI::err == 6510);
-
-
-# --- test raise_application_error with literal values
-ok(0, $csr = $dbh->prepare(q{
- declare err_num number; err_msg char(510);
- begin RAISE_APPLICATION_ERROR(-20101,'app error'); end;
-}), 1);
-
-# ORA-20101: app error
-ok(0, ! $csr->execute, 1);
-ok(0, $DBI::err == 20101);
-ok(0, $DBI::errstr =~ m/app error/);
-
-
-# --- test raise_application_error with 'in' parameters
-ok(0, $csr = $dbh->prepare(q{
- declare err_num varchar2(555); err_msg varchar2(510);
- --declare err_num number; err_msg char(510);
- begin
- err_num := :1;
- err_msg := :2;
- raise_application_error(-20000-err_num, 'msg is '||err_msg);
- end;
-}), 1);
-
-ok(0, ! $csr->execute(42, "hello world"), 1);
-ok(0, $DBI::err == 20042, $DBI::err);
-ok(0, $DBI::errstr =~ m/msg is hello world/, 1);
-
-# --- test named numeric in/out parameters
-ok(0, $csr = $dbh->prepare(q{
- begin
- :arg := :arg * :mult;
- end;
-}), 1);
-
-$p1 = 3;
-ok(0, $csr->bind_param_inout(':arg', \$p1, 50), 1);
-ok(0, $csr->bind_param(':mult', 2), 1);
-ok(0, $csr->execute, 1);
-ok(0, $p1 == 6);
-# execute 10 times from $p1=1, 2, 4, 8, ... 1024
-$p1 = 1; foreach (1..10) { $csr->execute || die $DBI::errstr; }
-ok(0, $p1 == 1024);
-
-# --- test undef parameters
-ok(0, $csr = $dbh->prepare(q{
- declare foo char(500);
- begin foo := :arg; end;
-}), 1);
-my $undef;
-ok(0, $csr->bind_param_inout(':arg', \$undef,10), 1);
-ok(0, $csr->execute, 1);
-
-
-# --- test named string in/out parameters
-ok(0, $csr = $dbh->prepare(q{
- declare str varchar2(1000);
- begin
- :arg := nvl(upper(:arg), 'null');
- :arg := :arg || :append;
- end;
-}), 1);
-
-undef $p1;
-$p1 = "hello world";
-ok(0, $csr->bind_param_inout(':arg', \$p1, 1000), 1);
-ok(0, $csr->bind_param(':append', "!"), 1);
-ok(0, $csr->execute, 1);
-ok(0, $p1 eq "HELLO WORLD!");
-# execute 10 times growing $p1 to force realloc
-foreach (1..10) {
- $p1 .= " xxxxxxxxxx";
- $csr->execute || die $DBI::errstr;
-}
-my $expect = "HELLO WORLD!" . (" XXXXXXXXXX!" x 10);
-ok(0, $p1 eq $expect);
-
-
-# --- test binding a null and getting a string back
-undef $p1;
-ok(0, $csr->execute, 1);
-ok(0, $p1 eq 'null!');
-
-$csr->finish;
-
-
-ok(0, $csr = $dbh->prepare(q{
- begin
- :out := nvl(upper(:in), 'null');
- end;
-}), 1);
-#$csr->trace(3);
-my $out;
-ok(0, $csr->bind_param_inout(':out', \$out, 1000), 1);
-
-ok(0, $csr->bind_param(':in', "foo", DBI::SQL_CHAR()), 1);
-ok(0, $csr->execute, 1);
-ok(0, $out eq "FOO");
-
-ok(0, $csr->bind_param(':in', ""), 1);
-ok(0, $csr->execute, 1);
-ok(0, $out eq "null");
-
-
-# --- test out buffer being too small
-ok(0, $csr = $dbh->prepare(q{
- begin
- select rpad('foo',200) into :arg from dual;
- end;
-}), 1);
-#$csr->trace(3);
-undef $p1; # force buffer to be freed
-ok(0, $csr->bind_param_inout(':arg', \$p1, 20), 1);
-# Execute fails with:
-# ORA-06502: PL/SQL: numeric or value error
-# ORA-06512: at line 3 (DBD ERROR: OCIStmtExecute)
-$tmp = $csr->execute;
-#$tmp = undef if DBD::Oracle::ORA_OCI()==8; # because BindByName given huge max len
-ok(0, !defined $tmp, 1);
-# rebind with more space - and it should work
-ok(0, $csr->bind_param_inout(':arg', \$p1, 200), 1);
-ok(0, $csr->execute, 1);
-ok(0, length($p1) == 200, 0);
-
-
-# --- test plsql_errstr function
-#$csr = $dbh->prepare(q{
-# create or replace procedure perl_dbd_oracle_test as
-# begin
-# procedure filltab( stuff out tab ); asdf
-# end;
-#});
-#ok(0, ! $csr);
-#if ($dbh->err && $dbh->err == 6550) { # PL/SQL error
-# warn "errstr: ".$dbh->errstr;
-# my $msg = $dbh->func('plsql_errstr');
-# warn "plsql_errstr: $msg";
-# ok(0, $msg =~ /Encountered the symbol/, "plsql_errstr: $msg");
-#}
-#else {
-# warn "plsql_errstr test skipped ($DBI::err)\n";
-# ok(0, 1);
-#}
-#die;
-
-# --- test dbms_output_* functions
-$dbh->{PrintError} = 1;
-ok(0, $dbh->func(30000, 'dbms_output_enable'), 1);
-
-#$dbh->trace(3);
-my @ary = ("foo", ("bar" x 15), "baz", "boo");
-ok(0, $dbh->func(@ary, 'dbms_output_put'), 1);
-
-@ary = scalar $dbh->func('dbms_output_get'); # scalar context
-ok(0, @ary==1 && $ary[0] && $ary[0] eq 'foo', 0);
-
-@ary = scalar $dbh->func('dbms_output_get'); # scalar context
-ok(0, @ary==1 && $ary[0] && $ary[0] eq 'bar' x 15, 0);
-
-@ary = $dbh->func('dbms_output_get'); # list context
-ok(0, join(':',@ary) eq 'baz:boo', 0);
-$dbh->{PrintError} = 0;
-#$dbh->trace(0);
-
-# --- test cursor variables
-if (1) {
- my $cur_query = q{
- SELECT object_name, owner
- FROM all_objects
- WHERE object_name LIKE :p1
- ORDER BY object_name
- };
- my $cur1 = 42;
- #$dbh->trace(4);
- my $parent = $dbh->prepare(qq{
- BEGIN OPEN :cur1 FOR $cur_query; END;
- });
- ok(0, $parent, $DBI::errstr);
- ok(0, $parent->bind_param(":p1", "V%"));
- ok(0, $parent->bind_param_inout(":cur1", \$cur1, 0, { ora_type => ORA_RSET } ));
- ok(0, $parent->execute());
- my @r;
- push @r, @tmp while @tmp = $cur1->fetchrow_array;
- ok(0, @r>0, "rows: ".@r);
- #$dbh->trace(0); $parent->trace(0);
-
- # compare results with normal execution of query
- my $s1 = $dbh->selectall_arrayref($cur_query, undef, "V%");
- my @s1 = map { @$_ } @$s1;
- ok(0, "@r" eq "@s1", "\nref=(@r),\nsql=(@s1)");
-
- # --- test re-bind and re-execute of same 'parent' statement
- my $cur1_str = "$cur1";
- #$dbh->trace(4); $parent->trace(4);
- ok(0, $parent->bind_param(":p1", "U%"));
- ok(0, $parent->execute());
- ok(0, "$cur1" ne $cur1_str); # must be ref to new handle object
- @r = ();
- push @r, @tmp while @tmp = $cur1->fetchrow_array;
- #$dbh->trace(0); $parent->trace(0); $cur1->trace(0);
- my $s2 = $dbh->selectall_arrayref($cur_query, undef, "U%");
- my @s2 = map { @$_ } @$s2;
- ok(0, "@r" eq "@s2", "\nref=(@r),\nsql=(@s2)");
-}
-
-
-
-# --- To do
- # test NULLs at first bind
- # NULLs later binds.
- # returning NULLs
- # multiple params, mixed types and in only vs inout
-
-# --- test ping
-ok(0, $dbh->ping);
-$dbh->disconnect;
-ok(0, !$dbh->ping);
-
-exit 0;
-BEGIN { $tests = 63 }
-# end.
-
-__END__
@@ -1,46 +0,0 @@
-#!perl -w
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- ($ok) ? print "ok $t\n"
- : print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
- if (!$ok && $warn) {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "$warn\n";
- }
-}
-
-use DBI;
-$| = 1;
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbuser_2 = $ENV{ORACLE_USERID_2} || '';
-
-sub give_up { warn @_ if @_; print "1..0\n"; exit 0; }
-
-if ($dbuser_2 eq '') {
- print("ORACLE_USERID_2 not defined.\nTests skiped.\n");
- give_up();
-}
-(my $uid1 = uc $dbuser) =~ s:/.*::;
-(my $uid2 = uc $dbuser_2) =~ s:/.*::;
-if ($uid1 eq $uid2) {
- give_up("ORACLE_USERID_2 not unique.\nTests skiped.\n")
-}
-
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '');
-
-unless($dbh) {
- give_up("Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n");
-}
-
-print "1..3\n";
-
-ok(0, ($dbh->selectrow_array("SELECT USER FROM DUAL"))[0] eq $uid1 );
-ok(0, $dbh->func($dbuser_2, '', 'reauthenticate'));
-ok(0, ($dbh->selectrow_array("SELECT USER FROM DUAL"))[0] eq $uid2 );
-
-$dbh->disconnect;
@@ -0,0 +1,88 @@
+# $Id$
+use strict;
+
+use DBI;
+use DBD::Oracle;
+
+use Test::More;
+
+use lib 't';
+require 'nchar_test_lib.pl';
+
+my $dbh = db_handle() or plan skip_all => "can't connect to database";
+
+my %priv = map { $_ => 1 } get_privs( $dbh );
+
+unless ( $priv{'CREATE TABLE'} ) {
+ plan skip_all => q{requires permissions 'CREATE TABLE'};
+}
+
+plan tests => 9;
+
+$dbh->do( 'DROP TABLE RT13865' );
+
+$dbh->do( <<'END_SQL' ) or die $dbh->errstr;
+CREATE TABLE RT13865(
+ COL_INTEGER INTEGER,
+ COL_NUMBER NUMBER,
+ COL_NUMBER_37 NUMBER(37),
+ COL_DECIMAL NUMBER(9,2),
+ COL_FLOAT FLOAT(126),
+ COL_VC2 VARCHAR2(67),
+ COL_VC2_69CHAR VARCHAR2(69 CHAR),
+ COL_NVC2 NVARCHAR2(69),
+ COL_NC NCHAR(69),
+ COL_CHAR CHAR(67),
+ COL_CHAR_69CHAR CHAR(69 CHAR)
+)
+END_SQL
+
+my $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_INTEGER' );
+
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 38,
+ "INTEGER is alias for NUMBER(38)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER_37' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 37,
+ "NUMBER(37)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER' );
+cmp_ok $col_h->fetchrow_hashref->{COLUMN_SIZE}, '>', 0,
+ "NUMBER";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67,
+ "VARCHAR(67)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2_69CHAR' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69,
+ "VARCHAR(69)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NVC2' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69,
+ "NVARCHAR2(69)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NC' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69,
+ "NCHAR(69)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67,
+ "CHAR(67)";
+
+$col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR_69CHAR' );
+is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69,
+ "CHAR(69)";
+
+$dbh->do( 'DROP TABLE RT13865' );
+
+# utility functions
+
+sub get_privs {
+ my $dbh = shift;
+
+ my $sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' );
+ $sth->execute;
+
+ return map { $_->[0] } @{ $sth->fetchall_arrayref };
+}
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use DBI;
+use Encode;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+$ENV{NLS_LANG} = 'AMERICAN_AMERICA.UTF8';
+$ENV{NLS_NCHAR} = 'UTF8';
+
+my $dbh = DBI->connect( $dsn, $dbuser, '', {
+ PrintError => 0, AutoCommit => 0
+});
+
+plan skip_all => "unable to connect to Oracle database" if not $dbh;
+plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh);
+
+plan tests => 3;
+
+$dbh->do(q(alter session set nls_territory = 'GERMANY'));
+
+my $sth = $dbh->prepare(<<"END_SQL");
+ SELECT ltrim(rtrim(to_char(0, 'L'))) FROM dual
+END_SQL
+
+$sth->execute;
+
+my ($val);
+$sth->bind_columns( \($val) );
+
+$sth->fetch;
+
+is Encode::is_utf8($val) => 1, "utf8 encoded";
+
+$sth->finish;
+
+$val = undef;
+
+$sth = $dbh->prepare(<<'END_SQL');
+declare
+ l_ret varchar2(10);
+begin
+ select ltrim(rtrim(to_char(0, 'L')))
+ into l_ret
+ from dual;
+ --
+ :ret := l_ret;
+end;
+END_SQL
+
+$sth->bind_param_inout(':ret', \$val, 100);
+$sth->execute;
+
+is Encode::is_utf8($val) => 1, "utf8 encoded";
+
+$sth = $dbh->prepare(<<'END_SQL');
+declare
+ l_ret varchar2(10);
+begin
+ select ltrim(rtrim(to_char(0, 'L')))
+ || ltrim(rtrim(to_char(0, 'L')))
+ || ltrim(rtrim(to_char(0, 'L')))
+ into l_ret
+ from dual;
+ --
+ :ret := l_ret;
+end;
+END_SQL
+
+$val = undef;
+
+# WARNING: does *not* truncate. DBD::Oracle doesn't heed the 3rd parameter
+$sth->bind_param_inout(':ret', \$val, 1);
+$sth->execute;
+
+is Encode::is_utf8($val) => 1, "truncated, yet utf8 encoded";
+
+$dbh->disconnect;
+
@@ -0,0 +1,50 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use DBI qw(:sql_types);
+use Devel::Peek;
+use B qw( svref_2object SVf_IOK SVf_NOK SVf_POK );
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+sub is_iv {
+ my $sv = svref_2object(my $ref = \$_[0]);
+ my $flags = $sv->FLAGS;
+
+ # See http://www.perlmonks.org/?node_id=971411
+ my $x = $sv->can('PV') ? $sv->PV : undef;
+
+ if (wantarray) {
+ return ($flags & SVf_IOK, $x);
+ } else {
+ return $flags & SVf_IOK;
+ }
+}
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+my $dbh = DBI->connect( $dsn, $dbuser, '', {
+ PrintError => 0, FetchHashKeyName =>'NAME_lc'});
+
+plan skip_all => "unable to connect to Oracle database" if not $dbh;
+
+plan tests => 2;
+
+my $s = $dbh->prepare(q/select 1 as one from dual/);
+$s->execute;
+
+$s->bind_col (1, undef, {TYPE => SQL_INTEGER, DiscardString => 1});
+
+my $list = $s->fetchall_arrayref({});
+
+is($list->[0]{one}, 1, "correct value returned");
+ok(is_iv($list->[0]{one}), "ivok") or Dump($list->[0]{one});
+
+$dbh->disconnect;
+
@@ -1,176 +0,0 @@
-#!perl -w
-
-use DBI;
-use DBD::Oracle qw(:ora_types ORA_OCI);
-use Data::Dumper;
-use strict;
-
-sub ok ($$;$);
-
-$| = 1;
-my $t = 0;
-my $failed = 0;
-my %ocibug;
-my $table = "dbd_ora__drop_me";
-
-my $utf8_test = ($] >= 5.006) && ($ENV{NLS_LANG} && $ENV{NLS_LANG} =~ m/utf8$/i);
-
-my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect('dbi:Oracle:', $dbuser, '', {
- AutoCommit => 1,
- PrintError => 0,
-});
-
-unless($dbh) {
- warn "Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-unless(create_table("str CHAR(10)")) {
- warn "Unable to create test table ($DBI::errstr)\nTests skiped.\n";
- print "1..0\n";
- exit 0;
-}
-
-
-my @test_sets = (
- [ "CHAR(10)", 10 ],
- [ "VARCHAR(10)", 10 ],
- [ "VARCHAR2(10)", 10 ],
-);
-
-# Set size of test data (in 10KB units)
-# Minimum value 3 (else tests fail because of assumptions)
-# Normal value 8 (to test 64KB threshold well)
-my $sz = 8;
-
-my $tests = 2;
-my $tests_per_set = 11;
-$tests += @test_sets * $tests_per_set;
-print "1..$tests\n";
-
-my($sth, $p1, $p2, $tmp, @tmp);
-#$dbh->trace(4);
-
-foreach (@test_sets) {
- run_select_tests( @$_ );
-}
-
-
-sub run_select_tests {
- my ($type_name, $field_len) = @_;
-
- my $data0;
- if ($utf8_test) {
- $data0 = eval q{ "0\x{263A}xyX" };
- } else {
- $data0 = "0\177x\0X";
- }
- my $data1 = "1234567890";
- my $data2 = "2bcdefabcd";
- my $data3 = "2bcdefabcd12345";
-
- if (!create_table("lng $type_name", 1)) {
- # typically OCI 8 client talking to Oracle 7 database
- warn "Unable to create test table for '$type_name' data ($DBI::err). Tests skipped.\n";
- foreach (1..$tests_per_set) { ok(0, 1) }
- return;
- }
-
- print " --- insert some $type_name data\n";
- ok(0, $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)"), 1);
- ok(0, $sth->execute(40, $data0), 1);
- ok(0, $sth->execute(41, $data1), 1);
- ok(0, $sth->execute(42, $data2), 1);
- ok(0, !$sth->execute(43, $data3), 1);
-
-
- print " --- fetch $type_name data back again\n";
-
- ok(0, $sth = $dbh->prepare("select * from $table order by idx"), 1);
- ok(0, $sth->execute, 1);
- ok(0, $tmp = $sth->fetchall_arrayref, 1);
- # allow for padded blanks
- ok(0, $tmp->[0][1] =~ m/$data0/,
- cdif($tmp->[0][1], $data0, "Len ".length($tmp->[0][1])) );
- ok(0, $tmp->[1][1] =~ m/$data1/,
- cdif($tmp->[1][1], $data1, "Len ".length($tmp->[1][1])) );
- ok(0, $tmp->[2][1] =~ m/$data2/,
- cdif($tmp->[2][1], $data2, "Len ".length($tmp->[2][1])) );
-
-
-} # end of run_select_tests
-
-my @pk = $dbh->primary_key(undef, $dbh->{USER}, uc $table);
-print "primary_key($table): ".Dumper(\@pk);
-ok(0, @pk);
-ok(0, join(",",@pk) eq 'DT,IDX');
-
-exit 0;
-END {
- $dbh->do(qq{ drop table $table }) if $dbh;
-}
-# end.
-
-
-# ----
-
-sub create_table {
- my ($fields, $drop) = @_;
- my $sql = qq{create table $table (
- idx integer,
- $fields,
- dt date,
- primary key (dt, idx)
- )};
- $dbh->do(qq{ drop table $table }) if $drop;
- $dbh->do($sql);
- if ($dbh->err && $dbh->err==955) {
- $dbh->do(qq{ drop table $table });
- warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err;
- $dbh->do($sql);
- }
- return 0 if $dbh->err;
- print "$sql\n";
- return 1;
-}
-
-
-sub cdif {
- my ($s1, $s2, $msg) = @_;
- $msg = ($msg) ? ", $msg" : "";
- my ($l1, $l2) = (length($s1), length($s2));
- return "Strings are identical$msg" if $s1 eq $s2;
- return "Strings are of different lengths ($l1 vs $l2)($s1 vs $s2)$msg" # check substr matches?
- if $l1 != $l2;
-
- my $i;
- for($i=0; $i < $l1; ++$i) {
- my ($c1,$c2) = (ord(substr($s1,$i,1)), ord(substr($s2,$i,1)));
- next if $c1 == $c2;
- return sprintf "Strings differ at position %d (\\%03o vs \\%03o)$msg",
- $i,$c1,$c2;
- }
- return "(cdif error $l1/$l2/$i)";
-}
-
-
-sub ok ($$;$) {
- my($n, $ok, $warn) = @_;
- $warn ||= '';
- ++$t;
- die "sequence error, expected $n but actually $t"
- if $n and $n != $t;
- if ($ok) {
- print "ok $t\n";
- }
- else {
- $warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
- warn "# failed test $t at line ".(caller)[2].". $warn\n";
- print "not ok $t\n";
- ++$failed;
- }
-}
-
-__END__
@@ -1,369 +0,0 @@
-#!/usr/local/bin/perl -w
-
-use ExtUtils::testlib;
-
-die "Use 'make test' to run test.pl\n" unless "@INC" =~ /\bblib\b/;
-
-# $Id: test.pl,v 1.7 2003/03/25 17:40:10 timbo Exp $
-#
-# Copyright (c) 1995-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.
-
-# XXX
-# XXX PLEASE NOTE THAT THIS CODE IS A RANDOM HOTCH-POTCH OF TESTS AND
-# XXX TEST FRAMEWORKS AND IS IN *NO WAY* A TO BE USED AS A STYLE GUIDE!
-# XXX
-
-require 'getopts.pl';
-
-$| = 1;
-print q{Oraperl test application $Revision: 1.7 $}."\n";
-
-$SIG{__WARN__} = sub {
- ($_[0] =~ /^(Bad|Duplicate) free/)
- ? warn "\n*** Read the README file about Bad free() warnings!\n": warn @_;
-};
-
-use Config;
-my $os = $Config{osname};
-$opt_d = 0; # debug
-$opt_l = 0; # log
-$opt_n = 5; # num of loops
-$opt_m = 0; # do mem leek test
-$opt_c = undef; # set RowCacheSize for some tests
-$opt_p = 1; # do perf test
-$opt_f = 0; # do fetch test
-&Getopts('md:n:f:c:lp ') || die "Invalid options\n";
-
-$ENV{PERL_DBI_DEBUG} = 2 if $opt_d;
-#$ENV{ORACLE_HOME} ||= '/usr/oracle' unless ($^O eq 'MSWin32');
-
-$dbname = $ARGV[0] || ''; # if '' it'll use TWO_TASK/ORACLE_SID
-$dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-
-eval 'use Oraperl; 1' || die $@ if $] >= 5;
-
-&test_extfetch_perf($opt_f) if $opt_f;
-
-&test_leak(100) if $opt_m;
-
-print "\n\nExtra tests. These are less formal and you need to read the output\n";
-print "to see if it looks reasonable and matches what the tests says is expected.\n";
-
-&ora_version;
-
-my @data_sources = DBI->data_sources('Oracle');
-print "Data sources:\n\t", join("\n\t",@data_sources),"\n\n";
-
-print "\nConnecting\n",
- " to '$dbname' (from command line, else uses ORACLE_SID or TWO_TASK - recommended)\n";
-print " as '$dbuser' (via ORACLE_USERID env var or default - recommend name/passwd\@dbname)\n";
-printf("(ORACLE_SID='%s', TWO_TASK='%s')\n", $ENV{ORACLE_SID}||'', $ENV{TWO_TASK}||'');
-printf("(LOCAL='%s', REMOTE='%s')\n", $ENV{LOCAL}||'', $ENV{REMOTE}||'') if $os eq 'MSWin32';
-
-{ # test connect works first
- local($l) = &ora_login($dbname, $dbuser, '');
- unless($l) {
- $ora_errno = 0 unless defined $ora_errno;
- $ora_errstr = '' unless defined $ora_errstr;
- warn "ora_login: $ora_errno: $ora_errstr\n";
- # Try to help dumb users who don't know how to connect to oracle...
- warn "\nHave you set the environment variable ORACLE_USERID ?\n"
- if ($ora_errno == 1017); # ORA-01017: invalid username/password
- warn "\nHave you included your password in ORACLE_USERID ? (e.g., 'user/passwd')\n"
- if ($ora_errno == 1017 and $dbuser !~ m:/:);
- warn "\nHave you set the environment variable ORACLE_SID or TWO_TASK?\n"
- if ($ora_errno == 2700); # error translating ORACLE_SID
- warn "\nORACLE_SID or TWO_TASK possibly not right, or server not running.\n"
- if ($ora_errno == 1034); # ORA-01034: ORACLE not available
- warn "\nTWO_TASK possibly not set correctly right.\n"
- if ($ora_errno == 12545);
- warn "\n";
- warn "Generally set TWO_TASK or ORACLE_SID but not both at the same time.\n";
- warn "Try to connect to the database using an oracle tool like sqlplus\n";
- warn "only if that works should you suspect problems with DBD::Oracle.\n";
- warn "Try leaving dbname value empty and set dbuser to name/passwd\@dbname.\n";
- die "\nTest aborted.\n";
- }
- if ($os ne 'MSWin32' and $os ne 'VMS') {
- my $backtick = `sleep 1; echo Backticks OK`;
- unless ($backtick) { # $! == Interrupted system call
- print "Warning: Oracle's SIGCHLD signal handler breaks perl ",
- "`backticks` commands: $!\n(d_sigaction=$Config{d_sigaction})\n";
- }
- }
- #test_bind_csr($l);
- #test_auto_reprepare($l);
- &ora_logoff($l) || warn "ora_logoff($l): $ora_errno: $ora_errstr\n";
-}
-$start = time;
-
-rename("test.log","test.olog") if $opt_l;
-eval 'DBI->_debug_dispatch(3,"test.log");' if $opt_l;
-
-&test_intfetch_perf() if $opt_p;
-
-&test1();
-
-print "\nTesting repetitive connect/open/close/disconnect:\n";
-print "If this test hangs then read the README.help file.\n";
-print "Expect sequence of digits, no other messages:\n";
-#DBI->internal->{DebugDispatch} = 2;
-foreach(1..$opt_n) { print "$_ "; &test2(); }
-print "\n";
-
-print "\nTest interaction of explicit close/logoff and implicit DESTROYs\n";
-print "Expect just 'done.', no other messages:\n";
-$lda2 = &ora_login($dbname, $dbuser, '');
-$csr2 = &ora_open($lda2, "select 42 from dual") || die "ora_open: $ora_errno: $ora_errstr\n";
-&ora_close($csr2) || warn "ora_close($csr2): $ora_errno: $ora_errstr\n";
-&ora_logoff($lda2) || warn "ora_logoff($lda2): $ora_errno: $ora_errstr\n";
-print "done.\n";
-
-&test_cache();
-
-$dur = time - $start;
-print "\nTest complete ($dur seconds).\n";
-print "If the tests above have produced the 'expected' output then they have passed.\n";
-
-exit 0;
-
-
-sub test1 {
- local($lda) = &ora_login($dbname, $dbuser, '')
- || die "ora_login: $ora_errno: $ora_errstr\n";
-
- &ora_commit($lda) || warn "ora_commit($lda): $ora_errno: $ora_errstr\n";
- &ora_rollback($lda) || warn "ora_rollback($lda): $ora_errno: $ora_errstr\n";
- &ora_autocommit($lda, 1);
- &ora_autocommit($lda, 0);
-
- # Test ora_do with harmless non-select statement
- &ora_do($lda, "set transaction read only ")
- || warn "ora_do: $ora_errno: $ora_errstr";
-
- # DBI::dump_results($lda->tables());
-
- # $lda->debug(2);
-
- {
- #$lda->trace(2);
- local($csr) = &ora_open($lda,
- "select to_number('7.2', '9D9',
- 'NLS_NUMERIC_CHARACTERS =''.,'''
- ) num_t,
- SYSDATE date_t,
- USER char_t,
- ROWID rowid_t,
- HEXTORAW('7D') raw_t,
- NULL null_t
- from dual") || die "ora_open: $ora_errno: $ora_errstr\n";
- $csr->{RaiseError} = 1;
-
- print "Fields: ",scalar(&ora_fetch($csr)),"\n";
- die "ora_fetch in scalar context error" unless &ora_fetch($csr)==6;
- print "Names: ",DBI::neat_list([&ora_titles($csr)], 0,"\t"),"\n";
- print "Lengths: ",DBI::neat_list([&ora_lengths($csr)],0,"\t"),"\n";
- print "OraTypes: ",DBI::neat_list([&ora_types($csr)], 0,"\t"),"\n";
- print "SQLTypes: ",DBI::neat_list($csr->{TYPE}, 0,"\t"),"\n";
- print "Scale: ",DBI::neat_list($csr->{SCALE}, 0,"\t"),"\n";
- print "Precision: ",DBI::neat_list($csr->{PRECISION}, 0,"\t"),"\n";
- print "Nullable: ",DBI::neat_list($csr->{NULLABLE}, 0,"\t"),"\n";
- print "Est row width: $csr->{ora_est_row_width}\n";
- print "Prefetch cache: $csr->{RowsInCache}\n" if $csr->{RowsInCache};
-
- print "Data rows:\n";
- #$csr->debug(2);
- while(@fields = $csr->fetchrow_array) {
- die "ora_fetch returned ".@fields." fields instead of 6!"
- if @fields != 6;
- die "Perl list/scalar context error" if @fields==1;
- print " fetch: ", DBI::neat_list(\@fields),"\n";
- }
-
- &ora_close($csr) || warn "ora_close($csr): $ora_errno: $ora_errstr\n";
- print "\n";
- }
-
- print "ora_logoff...\n";
- &ora_logoff($lda) || warn "ora_logoff($lda): $ora_errno: $ora_errstr\n";
-
- print "lda out of scope...\n";
-}
-
-
-sub test2 { # also used by test_leak()
- my $skip_sth = shift;
- local($l) = &ora_login($dbname, $dbuser, '');
- warn "ora_login: $ora_errno: $ora_errstr\n" if $ora_errno;
- return unless $l;
- unless ($skip_sth) {
- local($c) = &ora_open($l, "set transaction read only")#"select 42,42,42,42,42,42,42 from dual")
- || die "ora_open: $ora_errno: $ora_errstr\n";
- local(@row);
- @row = &ora_fetch($c);
- &ora_close($c) || warn "ora_close($c): $ora_errno: $ora_errstr\n";
- }
- &ora_logoff($l) || warn "ora_logoff($l): $ora_errno: $ora_errstr\n";
-}
-
-
-sub test_leak {
- local($count) = @_;
- local($ps) = (-d '/proc') ? "ps -lp " : "ps -l";
- local($i) = 0;
- print "\nMemory leak test:\n";
- while(++$i <= $count) {
- system("echo $i; $ps$$") if (($i % 10) == 0);
- &test2(1);
- }
- system("echo $i; $ps$$") if (($i % 10) == 0);
- print "Done.\n\n";
-}
-
-
-sub test_cache {
- local($cache) = 5;
- print "\nTesting row cache ($cache).\n";
- local($l) = &ora_login($dbname, $dbuser, '')
- || die "ora_login: $ora_errno: $ora_errstr\n";
- local($csr, $rows, $max);
- local($start) = time;
- #$l->trace(3);
- foreach $max (1, 0, $cache-1, $cache, $cache+1) {
- $csr = &ora_open($l, q{
- select object_name, rownum from all_objects where rownum <= :1
- }, $cache);
- &ora_bind($csr, $max) || die $ora_errstr;
- $rows = count_fetch($csr);
- die "test_cache $rows/$max" if $rows != $max;
- &ora_bind($csr, $max+2) || die $ora_errstr;
- $rows = count_fetch($csr);
- die "test_cache $rows/$max+2" if $rows != $max+2;
- }
- # this test will only show timing improvements when
- # run over a modem link. It's primarily designed to
- # test boundary cases in the cache code.
- print "Test completed in ".(time-$start)." seconds.\n";
-}
-sub count_fetch {
- local($csr) = @_;
- local($rows) = 0;
- # while((@row) = &ora_fetch($csr)) {
- while((@row) = $csr->fetchrow_array) {
- ++$rows;
- }
- die "count_fetch $ora_errstr" if $ora_errno;
- return $rows;
-}
-
-
-sub test_intfetch_perf {
- print "\nTesting internal row fetch overhead.\n";
- local($lda) = &ora_login($dbname, $dbuser, '')
- || die "ora_login: $ora_errno: $ora_errstr\n";
- DBI->trace(0);
- $lda->trace(0);
- local($csr) = &ora_open($lda,"select 0,1,2,3,4,5,6,7,8,9 from dual");
- local($max) = 50000;
- $csr->{ora_fetchtest} = $max;
- require Benchmark;
- $t0 = new Benchmark;
- 1 while $csr->fetchrow_arrayref;
- $td = Benchmark::timediff((new Benchmark), $t0);
- $csr->{ora_fetchtest} = 0;
- printf("$max fetches: ".Benchmark::timestr($td)."\n");
- printf("%d per clock second, %d per cpu second\n\n",
- $max/($td->real ? $td->real : 1),
- $max/($td->cpu_a ? $td->cpu_a : 1));
-}
-
-sub test_extfetch_perf {
- my $max = shift;
- print "\nTesting external row fetch overhead.\n";
- my $rows = 0;
- my $dbh = DBI->connect("dbi:Oracle:$dbname", $dbuser, '', { RaiseError => 1 });
- #$dbh->trace(2);
- $dbh->{RowCacheSize} = $::opt_c if defined $::opt_c;
- my $fields = (0) ? "*" : "object_name, status, object_type";
- my $sth = $dbh->prepare(q{
- select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- union all select all * from all_objects o1
- --, all_objects o2
- --where o1.object_id <= 400 and o2.object_id <= 400
- }, { ora_check_sql => 1 });
-
- require Benchmark;
- $t0 = new Benchmark;
- $sth->execute;
- $sth->trace(0);
- $sth->fetchrow_arrayref; # fetch one before starting timer
- $td = Benchmark::timediff((new Benchmark), $t0);
- printf("Execute: ".Benchmark::timestr($td)."\n");
-
- print "Fetching data with RowCacheSize $dbh->{RowCacheSize}...\n";
- $t1 = new Benchmark;
- 1 while $sth->fetchrow_arrayref && ++$rows < $max;
- $td = Benchmark::timediff((new Benchmark), $t1);
- printf("$rows fetches: ".Benchmark::timestr($td)."\n");
- printf("%d per clock second, %d per cpu second\n",
- $rows/($td->real ? $td->real : 1),
- $rows/($td->cpu_a ? $td->cpu_a : 1));
- my $ps = (-d '/proc') ? "ps -lp " : "ps -l";
- system("echo Process memory size; $ps$$");
- print "\n";
- $sth->finish;
- $dbh->disconnect;
- exit 1;
-}
-
-
-sub test_bind_csr {
- local($lda) = @_;
-$lda->{RaiseError} =1;
-$lda->trace(2);
-my $out_csr = $lda->prepare(q{select 42 from dual}); # sacrificial csr XXX
-$csr = $lda->prepare(q{
- begin
- OPEN :csr_var FOR select * from all_tables;
- end;
-});
-$csr->bind_param_inout(':csr_var', \$out_csr, 100, { ora_type => 102 });
-$csr->execute();
-# at this point $out_csr should be a handle on a new oracle cursor
-@row = $out_csr->fetchrow_array;
-
- exit 1;
-}
-
-sub test_auto_reprepare {
- local($dbh) = @_;
- $dbh->do(q{drop table timbo});
- $dbh->{RaiseError} =1;
- #$dbh->trace(2);
- $dbh->do(q{create table timbo ( foo integer)});
- $dbh->do(q{insert into timbo values (91)});
- $dbh->do(q{insert into timbo values (92)});
- $dbh->do(q{insert into timbo values (93)});
- $dbh->commit;
- $Oraperl::ora_cache = $Oraperl::ora_cache = 1;
- my $sth = $dbh->prepare(q{select * from timbo for update});
- $sth->execute; $sth->dump_results;
- $sth->execute;
- print $sth->fetchrow_array,"\n";
- $dbh->commit;
- print $sth->fetchrow_array,"\n";
- $dbh->do(q{drop table timbo});
- exit 1;
-}
-
-# end.
@@ -0,0 +1,2 @@
+OCILobLocator * T_PTROBJ
+OCIXMLType * T_PTROBJ
\ No newline at end of file