diff --git a/.github/workflows/action.yml b/.github/workflows/action.yml new file mode 100644 index 00000000..8d7e057e --- /dev/null +++ b/.github/workflows/action.yml @@ -0,0 +1,55 @@ +name: build + +on: + push: + branches: + - "*" + pull_request: + branches: + - "*" + workflow_dispatch: + +## +# Adjust container-image for different Perl version +# Adjust services-oracle-image for different OracleXE DB versions +# Adjust container-env-ORACLEV for different InstantClient versions +## +jobs: + build-job: + name: Build Latest + runs-on: ubuntu-latest + container: + image: perldocker/perl-tester:latest + env: + ORACLEV: latest + ORACLE_USERID: kermit/foobar + ORACLE_DSN: 'dbi:Oracle://oracle:1521/XEPDB1' + services: + # Oracle service (label used to access the service container) + oracle: + # Docker Hub image (change the tag "latest" to any other available one) + image: gvenzl/oracle-xe:latest + # Provide passwords and other environment variables to container + env: + ORACLE_PASSWORD: adminpass + APP_USER: kermit + APP_USER_PASSWORD: foobar + # Forward Oracle port + ports: + - 1521:1521 + # Provide healthcheck script options for startup + options: >- + --health-cmd healthcheck.sh + --health-interval 10s + --health-timeout 5s + --health-retries 10 + steps: + - uses: actions/checkout@v2 + - run: apt-get update -y + - run: apt-get install -y libaio1 libaio-dev bc sudo alien + - run: sudo -E maint/scripts/03_install_oracle_instantclient_rpm.bash + - run: . /etc/profile + - run: perl -V + - run: cpanm DBI # DBI must be installed before we can build a DBD. + - run: cpanm --installdeps . + - run: perl Makefile.PL && make && make test diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..d83bd087 --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +pm_to_blib +MYMETA.yml +Makefile +Makefile.old +Oracle.bs +Oracle.c +Oracle.o +Oracle.xsi +dbdcnx.o +blib +MYMETA.json +dbdimp.o +mk.pm +oci8.o +DBD-Oracle* +project.vim +cpanfile diff --git a/.mailmap b/.mailmap new file mode 100644 index 00000000..37fc2dc4 --- /dev/null +++ b/.mailmap @@ -0,0 +1,20 @@ +Alex Muntada +Dean Hamstead +Dean Hamstead +Dean Hamstead +Dean Pearce +H.Merijn Brand - Tux +John Scoles +Martin J. Evans +Martin J. Evans +Martin J. Evans +Martin J. Evans +Martin J. Evans +Michael Portnoy +Mike O'Regan +Tim Bunce +Tim Bunce +Wesley Hinds +Yanick Champoux +Yanick Champoux +Yanick Champoux diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 00000000..a104d62d --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,111 @@ +# CONTRIBUTING + +Thank you for considering contributing to {{ $dist }}. +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 sufficient 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/{{ $dist }}. + +If you use cpanminus, you can do it without downloading the tarball first: + +``` bash +$ cpanm --reinstall --installdeps --with-recommends {{ $dist =~ s/-/::/gr }} +``` + +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 {{ $dist =~ s/-/::/gr }} +``` + +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/perl5-dbi/DBD-Oracle/ +[bugtracker]: https://github.com/perl5-dbi/DBD-Oracle/issues + diff --git a/Changes b/Changes index 8cfee7be..72d96df5 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,599 @@ Revision history for DBD::Oracle -Changes in DBD-Oracle XXX +{{$NEXT}} + + Test updates (GH#193, Victor) + Fix up unit tests (Dean Hamstead) + Remove outdated ifdefs (GH#186, H.Merijn Brand) + Attempts to resolve SEGV issue (GH#187, Victor) + Various clean ups and typos (GH#187, Victor) + Makefile.PL fix for missing Test::NoWarnings build requirement (GH#175, Wesley Hinds) + don't care about ExtUtils::MakeMaker version number anymore (GH#184, Wesley Hinds) + Makefile.PL: help to find linking libraries on Gentoo (GH#184, Marco Genasci) + +1.90 2024-04-16 + + Specify resources metadata explicitly in dist.ini (GH#162, Graham Knop) + Ensure dbivport.h is installed- (GH#150, Wesley Hinds) + Add DBI to ConfigureRequires, BuildRequires, and Test Requires - (GH#155) + Move from TravisCI to Github Actions (GHA) - (PR#152, Wesley Hinds) + Update dbdcnx.c - (PR#152, Andrei Voropaev) + Rewrite of login6. This is an enormous rewrite which should fix many problems - (PR#150, Andrei Voropaev) + Improvements to Makefile.PL - (PR#150, Andrei Voropaev) + Have find_headers() also search for header files based off the major version number - (GH#142, Wesley Hinds) + Check for appropriate permissions before running 56embbeded.t tests - (#143, Wesley Hinds) + Updated links in doc in Oracle.pm - (Gh#145, kjetillll) + Update 25plsql.t and add 21.5 to @bad_oci_vers - (GH#144, kjetillll) + Check permissions for tests in 28array_bind.t - (GH#141, Wesley Hinds) + Exclude 19.9 and 19.13 from 25plsql.t - (GH#140, Wesley Hinds) + +1.83 + + Build improvements on Debian-ish systems (GH#112, Alex Muntada) + Add rpath to ORACLE_HOME to DBD/Oracle/Oracle.bundle (GH#129, hackonhagland). + +1.82 2021-12-29 + + Second try at github #130. Still not fully cooperating but better. + +1.81 2021-12-24 + + [BUG FIXES] + + Run nonassigned pl/sql tests based off versions known to have the issue. - (GH#70, Wesley Hinds) + Oracle Instant Client 21 support - (Tux) + Add rpath to ORACLE_HOME to DBD/Oracle/Oracle.bundle - (GH#128, hakonhagland) + fix materialised views being misclassified as tables in ->table_info - (GH#132, John Smith) + Fix bugtracker ref in dist metadata github - (GH#130, John Smith) + + [MISCELLANEOUS] + + Updates to POD and README file + Moved old README file to t/TESTING.md + Updated links + +1.80 2019-07-25 + + [BUG FIXES] + + orphaned test code in t/28_array_bind.t - (GH#64, dzort) + Made the code run so it is nolonger orphaned + + [MISCELLANEOUS] + + Updated bugtracker to git + updated home page to metacpan + +1.791 2019-07-22 + + [BUG FIXES] + + Fix Avoid GCC-ism so that HP-UX can compile (GH#92, Dean Hamstead) + + Destroy envhp with last dbh (GH#93, GH#89, Dean Hamstead, CarstenGrohmann) + + +1.76 2018-11-22 + + No Changes from 1.75, we just botched up publishing to CPAN + +1.75 2018-11-22 + + No Changes from 1.75_42 + +1.75_42 2018-08-22 + + [BUG FIXES] + + Fix potential buffer overflow in dbdimp.c - (GH#57, Various) + + Fix truncation error on ROWIDs from an Index Organized table as they are + not a fixed length. Code now allows up to a size of 2000. + (GH#31, Martin J. Evans) + + Various fixes for compiler warnings, OCI handle leaks, and OCI programming + errors. - (PR#38, Dag Lem) + + Corrections to t/25plsql.t - (GH#56, kjetillll) + + Fix: Invalid binding call for large undef arrays. - (GH#36, GH ghost) + + Fix: compile warnings about int vs long unsigned. - (PR#62, Dean Hamstead) + + Fix: Spelling errors in pod. - (PR#63, Jochen Hayek) + + Fix: Various changes in pod. - (PR#54, Mike O'Regan) + + [ENHANCEMENT] + + Connection informational messages like "ORA-28002: the password will + expire" were lost. Thanks to J.D. Laub. + + Add new path to find 64 bit Oracle client on MAC OSX - (GH#20, Martin J. Evans) + + Ignore constraints which are not enabled in primary/foreign key_info + (GH#23, Martin J. Evans) + + dist.init overhaul. - (PR#62, Dean Hamstead) + + Mailmap and TODO changes. - (PR#62, Dean Hamstead) + + Travis CI testing. - (PR#62, Dean Hamstead) + Note: this uses Oracle XE which doesn't provide enough features to test + the entire suite. Nor does it test anything other than Linux on Linux. + Release tests are also NOT yet run in Travis. + + Rewrite of DRCP session pooling to make it work as intended - (PR#38, Dag Lem) + + Support for Oracle Fast Application Notification (FAN). - (PR#38, Dag Lem) + + Work by Dag Lem was sponsored by EVRY Information Services. Thank you! + +1.75_2 2014-11-19 + + [ENHANCEMENT] + + Try and set -l when the build would have failed (H.Merijn Brand) + +1.75_1 2014-11-17 + + [DOCUMENTATION] + + Change mentions of READMEs in Makefile.PL to troubleshooting guides. + (GH#17, reported by Ken Williams) + + [BUG FIXES] + + Fix GH#15 and GH#21 (the same problem). Previous change for + RT91698 broke other things in output parameters. + +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 @@ -11,13 +604,17 @@ Changes in DBD-Oracle XXX 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] + - 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 @@ -53,7 +650,7 @@ Changes in DBD-Oracle 1.31_00 - 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 + - convert a symbolically linked ORACLE_HOME to an absolute path (patch by H.Merijn Brand, applied by Martin J. Evans) [rt70785] [DOCUMENTATION] @@ -153,7 +750,7 @@ Changes in DBD-Oracle 1.29_1 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 + 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. @@ -202,7 +799,7 @@ Changes in DBD-Oracle 1.29_1 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 #=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 @@ -212,7 +809,7 @@ Changes in DBD-Oracle 1.29_1 * 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 + Patch to Makefile 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 @@ -391,7 +988,7 @@ please enjoy. 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" + Changed some SUCCESS_WITH_INFO situations 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. @@ -1310,4 +1907,3 @@ please enjoy. 19th Sep 1994: DBperl project renamed to DBI. 29th Sep 1992: DBperl project started. - diff --git a/MANIFEST b/MANIFEST index baf4733c..2ecaa7e8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,55 +1,75 @@ +CONTRIBUTING.md +CONTRIBUTORS Changes +INSTALL +LICENSE +MANIFEST +META.json +Makefile.PL +Oracle.h +Oracle.xs +README +README.help.txt +TESTING.md +TODO +cpanfile +dbdcnx.c dbdimp.c dbdimp.h dbivport.h -hints/dgux.pl -hints/macos_bundle.syms -hints/macos_lib.syms -hints/macos_syms.pl -hints/svr4.pl -lib/DBD/Oracle/GetInfo.pm -lib/DBD/Oracle/Object.pm -Makefile.PL -MANIFEST -mkta.pl -oci.def OCI.DLL export declarations -oci8.c -ocitrace.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/README +examples/read_long_via_blob_read.pl examples/sql examples/tabinfo.pl -Oracle.h -Oracle.pm -Oracle.xs -oraperl.ph Old oraperl file included for completeness of emulation -Oraperl.pm -README -README-files/hpux/Makefile-Lincoln -README.64bit.txt -README.aix.txt -README.clients.txt -README.help.txt -README.hpux.txt -README.java.txt -README.macosx.txt -README.sec.txt -README.win32.txt -README.win64.txt +hints/dgux.pl +hints/macos_bundle.syms +hints/macos_lib.syms +hints/macos_syms.pl +hints/svr4.pl +lib/DBD/Oracle.pm +lib/DBD/Oracle/GetInfo.pm +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 +t/00-compile.t +t/00-report-prereqs.dd +t/00-report-prereqs.t +t/00dbdoracletestlib.t t/01base.t +t/02versions.t +t/05base.t t/10general.t t/12impdata.t t/14threads.t t/15nls.t +t/15threads.t +t/16cached.t +t/16drcp.t t/20select.t t/21nchar.t +t/22cset.t t/22nchar_al32utf8.t t/22nchar_utf8.t t/23wide_db.t @@ -66,6 +86,7 @@ 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 @@ -75,10 +96,14 @@ t/58object.t t/60reauth.t t/70meta.t t/80ora_charset.t -t/nchar_test_lib.pl -test.pl -Todo +t/90-segv-threads.t +t/91-segv-fork.t +t/92-segv-fork.pl +t/92-segv-fork.t +t/cache2.pl +t/lib/DBDOracleTestLib.pm +t/lib/ExecuteArray.pm +t/rt13865.t +t/rt74753-utf8-encoded.t +t/rt85886.t typemap -examples/ora_explain.pl -t/00versions.t -lib/DBD/Oracle/Troubleshooting.pm diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index d38951ae..34807e80 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -13,7 +13,22 @@ ^info/ ^oci8/ ^oracle/ +^maint/ ^tags$ ~$ ^\.git ^xt +dbdimp.o +Makefile.old +mk.pm +MYMETA.json +MYMETA.yml +oci8.o +Oracle.bs +Oracle.c +Oracle.o +Oracle.xsi +pm_to_blib + +dist.ini +project.vim diff --git a/Makefile.PL b/Makefile.PL old mode 100755 new mode 100644 index 2c1ff707..1e1a7114 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,3 @@ -## 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. @@ -18,8 +17,8 @@ use Pod::Usage; # 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.51; -use DBI::DBD; # DBD creation tools +use DBI 1.623; +use DBI::DBD; # DBD creation tools # Some MakeMaker's forged some FileHandle methods @@ -32,10 +31,8 @@ BEGIN { use VMS::Filespec; 1; } or die $@; - } - my $dbi_arch_dir = dbd_dbi_arch_dir(); 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 @@ -46,53 +43,37 @@ $| = 1; my %opts = ( NAME => 'DBD::Oracle', - VERSION_FROM => 'Oracle.pm', + VERSION_FROM => 'lib/DBD/Oracle.pm', PREREQ_PM => { "Test::Simple" => 0.90, # actually Test::More pkg in T::S dist - "DBI" => 1.51}, + "Test::NoWarnings" => 1.00, + "DBI" => 1.623}, OBJECT => '$(O_FILES)', DEFINE => '', DIR => [], - clean => { FILES => 'xstmp.c Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def mk.pm DBD_ORA_OBJ.*' }, + 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 tardist', - PREOP => '$(MAKE) -f Makefile.old distdir', - COMPRESS => 'gzip -v9', SUFFIX => 'gz', + 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', + configure_requires => { "DBI" => '1.623' }, + build_requires => {"DBI" => '1.623', "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', - }, - }, + "Test::Simple" => '0.90', + "Test::NoWarnings" => "1.00"}, }, ); -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 => 1.51 }; - $opts{CAPI} = 'TRUE' if $Config{archname} =~ /-object\b/i; -} -$opts{LICENSE} = 'perl' if $eumm >= 6.3002; +$opts{AUTHOR} = 'Tim Bunce (dbi-users@perl.org)'; +$opts{ABSTRACT_FROM} = 'lib/DBD/Oracle.pm'; +$opts{CAPI} = 'TRUE' if $Config{archname} =~ /-object\b/i; + +$opts{LICENSE} = 'perl'; $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, %MK, $MK_TEXT, %MK_expanding); # parsed macros from Oracle's makefiles my %mk_target_deps; my %mk_target_rules; @@ -104,7 +85,6 @@ my %mk_target_rules; Try to use Oracle's own 'build' rule. Defaults to true. - =item -r With I<-b>, use this names build rule (eg -r=build64). @@ -182,32 +162,32 @@ and we force our emulation of OCILobWriteAppend. # 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_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 -$::opt_g = ''; # enable debugging (-g for compiler and linker) -$::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_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_b = 1; # try to use Oracle's own 'build' rule +$::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 +$::opt_g = ''; # enable debugging (-g for compiler and linker) +$::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_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 + # 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! 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_g &&= '-g'; # convert to actual string $::opt_v = 1 if $::opt_d; $Verbose = 1 if $::opt_v; my $is_developer = (-d ".svn" && -f "MANIFEST.SKIP"); @@ -219,12 +199,17 @@ if ($::opt_W) { # --- Introduction -print qq{ +print <<"END_BLURB" unless $::opt_s; Configuring DBD::Oracle for perl $] on $^O ($Config{archname}) -Remember to actually *READ* the README file! Especially if you have any problems. +If you encounter any problem, a collection of troubleshooting +guides are available under lib/DBD/Oracle/Troubleshooting. +'DBD::Oracle::Troubleshooting' is the general troubleshooting +guide, while platform-specific troubleshooting hints +live in their labelled sub-document (e.g., Win32 +hints are gathered in 'lib/DBD/Oracle/Troubleshooting/Win32.pod'). -} unless $::opt_s; +END_BLURB # --- Where is Oracle installed... @@ -240,7 +225,7 @@ if (!$OH) { 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. + See the appropriate troubleshooting guide for your OS for more information. ABORTED! \n}; $ENV{$ORACLE_ENV} = $OH; @@ -254,13 +239,13 @@ 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 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. + See the appropriate troubleshooting guide for your OS for more information. ABORTED! } unless (-d $OH and $^O eq 'VMS') - or -d "$OH/sdk/." # Instant Client with SDK - or -d "$OH/lib/." # normal Oracle installation + 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 + or -e "$OH/oci.dll"; # Windows Instant Client print "Installing on a $^O, Ver#$osvers\n"; print "Using Oracle in $OH\n"; @@ -279,23 +264,26 @@ symbol_search() if $::opt_s or $::opt_S; # --- How shall we link with Oracle? Let me count the ways... -my $mkfile; # primary .mk file to use -my @mkfiles; # $mkfile plus any files it 'includes' +my $mkfile; # primary .mk file to use +my @mkfiles; # $mkfile plus any files it 'includes' my $linkwith = ""; my $linkwith_msg = ""; my $need_ldlp_env; +# Do these in advance to enable automatic -l +my @libclntsh = glob("$OH/libclntsh.$so*"); + 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 + 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{ + print qq{ The logical PERL_ENV_TABLES is not set. This may mean that some of the UTF functionallity tests may fail, @@ -305,7 +293,7 @@ if ($^O eq 'VMS') { table, please set this logical: \$ DEFINE PERL_ENV_TABLES LNM\$PROCESS - \a\n}; + \a\n}; sleep 3; } } @@ -314,9 +302,9 @@ 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 $_ && $_ !~ /^\./; + 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 @@ -325,24 +313,26 @@ elsif (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) { 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.txt\n" - if ! -f "liboci.a"; + + system "dlltool --input-def oci.def --output-lib liboci.a" + unless -f "liboci.a"; + + die "Could not find or create liboci.a.\n" unless -f "liboci.a"; + my $pwd = cwd(); $opts{LIBS} = [ "-L$pwd -loci" ]; } else { my %OCILIB; my $oci_compiler_dir; my @oci_compiler_dirs = - map { -d "$OH/$OCIDIR/lib/$_" ? "$OH/$OCIDIR/lib/$_": () } - $Config{cc} eq 'bcc32' ? qw(BORLAND BC) : qw(MSVC); + map { -d "$OH/$OCIDIR/lib/$_" ? "$OH/$OCIDIR/lib/$_": () } + $Config{cc} eq 'bcc32' ? qw(BORLAND BC) : qw(MSVC); find( sub { - $File::Find::prune = 1 if -d $_ && $_ !~ /^\./; - return unless /^(OCI|ORA).*\.LIB$/i; - ($oci_compiler_dir = $File::Find::dir) =~ s:^.*/::; - print "Found $OCIDIR/lib/$oci_compiler_dir/$_ library\n"; - $OCILIB{uc($_)} = $_; + $File::Find::prune = 1 if -d $_ && $_ !~ /^\./; + return unless /^(OCI|ORA).*\.LIB$/i; + ($oci_compiler_dir = $File::Find::dir) =~ s:^.*/::; + print "Found $OCIDIR/lib/$oci_compiler_dir/$_ library\n"; + $OCILIB{uc($_)} = $_; }, @oci_compiler_dirs ); # sort the version numbered libs into assending order my @OCILIB = sort grep { /(OCI|ORA)\d\d+\./i } keys %OCILIB; @@ -356,8 +346,8 @@ elsif (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) { 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 + $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. @@ -367,8 +357,8 @@ elsif (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) { 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; + && -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" ]; @@ -380,8 +370,8 @@ elsif (($^O eq 'MSWin32') or ($^O =~ /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*> +elsif ($::opt_l || !defined $mkfile and # use -l to enable this direct-link approach + @_=grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } <$OH/lib{,64}/lib*> ) { # --- the simple modern way --- foreach(@_) { s:\Q$OH/lib/::g } @@ -408,18 +398,18 @@ elsif ($::opt_l and # use -l to enable this direct-link approach # --- special case for Oracle 10g instant client (note lack of ../lib/...) -elsif (my @libclntsh = glob("$OH/libclntsh.$so*")) { +elsif (@libclntsh) { 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"; + 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"; + or warn "Can't create symlink $OH/libclntsh.$so to $libclntsh_v: $!\n"; } unless -e "$OH/libclntsh.$so"; check_ldlibpthname($OH); @@ -431,13 +421,13 @@ elsif (my @libclntsh = glob("$OH/libclntsh.$so*")) { my $lib = "clntsh"; $linkwith_msg = "-l$lib."; - $opts{LIBS} = [ "-L$OH -l$lib $syslibs" ]; + $opts{LIBS} = [ "-L$OH -Wl,-rpath,$OH -l$lib $syslibs" ]; my $inc = join " ", map { "-I$_" } find_headers(); $opts{INC} = "$inc -I$dbi_arch_dir"; } -elsif ($mkfile = find_mkfile() and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE +elsif (defined $mkfile and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE print "Looks like Oracle XE ($mkfile)\n"; @@ -445,12 +435,12 @@ elsif ($mkfile = find_mkfile() and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE $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] + # 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); @@ -462,27 +452,27 @@ elsif ($mkfile = find_mkfile() and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE check_ldlibpthname(); } -else { # --- trawl the guts of Oracle's make files looking the how it wants to link +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"; - sleep 6; + 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"; + sleep 6; } # can we give the shared library a helping hand? my @shared = grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } @ora_libs; # show original value of ORA_CLIENT_LIB if defined ... print "\$ORA_CLIENT_LIB=$ENV{ORA_CLIENT_LIB}\n" - if defined $ENV{ORA_CLIENT_LIB}; + if defined $ENV{ORA_CLIENT_LIB}; # ... before we then set it how it probably should be set # XXX but we still need to write it into the generated Makefile. $ENV{ORA_CLIENT_LIB} = 'shared' - if !defined $ENV{ORA_CLIENT_LIB} - && ($opts{LINKTYPE}||'') ne 'static' && @shared && !$::opt_c; + if !defined $ENV{ORA_CLIENT_LIB} + && ($opts{LINKTYPE}||'') ne 'static' && @shared && !$::opt_c; my $linkvia = fetch_oci_macros($mkfile) if -f $mkfile; @@ -498,84 +488,83 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l my @build_rules = grep { $mk_target_rules{$_} } qw(build build64 build32); my $build_target = "build"; if (@build_rules && $::opt_b) { - print "\n"; + print "\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; + $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"; + 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'; + # create dummy C file to keep 'make $mkfile' happy + my $DBD_ORA_OBJ = 'DBD_ORA_OBJ'; open DBD_ORA_C, ">$DBD_ORA_OBJ.c" - or die "Can't create temporary $DBD_ORA_OBJ.c file in current directory: $!\n"; + or die "Can't create temporary $DBD_ORA_OBJ.c file in current directory: $!\n"; print DBD_ORA_C "int main() { return 1; }\n"; close DBD_ORA_C; - sleep 2; # - system("make $DBD_ORA_OBJ.o CC='$Config{cc}'"); # make a valid .o file. - - 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"; - my @cmds = `$make 2>&1`; - 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; + sleep 2; # + system("make $DBD_ORA_OBJ.o CC='$Config{cc}'"); # make a valid .o file. + + my $make = "$Config{make} -f $mkfile $build_target" + . q/ ECHODO=echo ECHO=echo GENCLNTSH='echo genclntsh' CC=true/ + . q/ OPTIMIZE= CCFLAGS=/ + . qq/ EXE=DBD_ORA_EXE OBJS=$DBD_ORA_OBJ.o/; + print "by executing: [$make]\n"; + my @cmds = `$make 2>&1`; + 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 - 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; - - 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 == 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 $^O eq 'solaris'; - } - else { - 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 $^O eq 'darwin'; # why? - print "\n"; + # 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 + next if $line =~ m/^\s*\S*echo\s+/; + next if $line =~ m/^\s*\S*make\s+/; # remove recursive calls to make + next if $line =~ m/^\s*\S*make(\[\d\])?:/; # remove message rom "make:" or "make[x]:" + + next if $line =~ m/^\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; + + 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 == 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 $^O eq 'solaris'; + } + else { + print "WARNING: Unable to interpret Oracle build commands from $mkfile.\a\n"; + print "(Will continue by using fallback approach.)\n"; + sleep 2; + $::opt_b = 0; + } + 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; - $::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 " 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"; - print "\n"; - sleep 6; + 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 " 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"; + print "\n"; + sleep 6; } $linkwith =~ s/-Y P,/-YP,/g if $Config{gccversion}; @@ -649,8 +638,8 @@ 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 $client_version_full =~ /^8\.1\.6/ ) - or ( $osvers >= 11 and $OH =~ m,/8\.1\.6, ) ) { + if ( ( $osvers >= 11 and $client_version_full =~ m/^8\.1\.6/ ) + or ( $osvers >= 11 and $OH =~ m|/8\.1\.6| ) ) { my @extraLib = qw[libqsmashr.sl libclntsh.sl]; foreach my $extraLib (@extraLib) { if (-r "$OH/lib/$extraLib") { @@ -661,9 +650,9 @@ 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"; - $linkwith =~ s/\s*-l:libcl.a\b//g; - } + print "WARNING: stripping -l:libcl.a from liblist (conflict with ld looking for shared libs)\n"; + $linkwith =~ s/\s*-l:libcl.a\b//g; + } #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 @@ -678,59 +667,59 @@ else { # --- trawl the guts of Oracle's make files looking the how it wants to l } my $ccf = join " ", map { $_ || '' } @Config{qw(ccflags ccldflags cccdlflags)}; - 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; + if ($Config{cc} =~ m/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 DBD::Oracle::Troubleshooting::Hpux\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.txt\n" - unless $ccf =~ m/\+[zZ]/; + " See instructions in DBD::Oracle::Troubleshooting::Hpux\n" + unless $ccf =~ m/\+[zZ]/; } } - if ($::opt_b) { # The simple approach - $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g $linkwith" }; - $linkwith_msg = "OTHERLDFLAGS = $linkwith [from '$build_target' rule]"; + if ($::opt_b) { # The simple approach + $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g $linkwith" }; + $linkwith_msg = "OTHERLDFLAGS = $linkwith [from '$build_target' rule]"; } - else { # the not-so-simple approach! - # get a cut down $linkwith to pass to MakeMaker liblist - my $linkwith_s = expand_mkvars($linkwith, 1, 1); - - # convert "/full/path/libFOO.a" into "-L/full/path -lFOO" - # to cater for lack of smarts in MakeMaker / Liblist - # which ignores /foo/bar.a entries! - my $lib_ext_re = "(a|$Config{dlext}|$Config{so})"; - $linkwith_s =~ s!(\S+)/lib(\w+)\.($lib_ext_re)\b!-L$1 -l$2!g; - - # Platform specific fix-ups: - # delete problematic crt?.o on 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 ($^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 "Deleting -lthread from link list as a possible workround ($osvers).\n"; - $linkwith_s =~ s/\s*-lthread\b/ /g; - } - - # extract object files, keep for use later - my @linkwith_o; - push @linkwith_o, $1 while $linkwith_s =~ s/(\S+\.[oa])\b//; - # also extract AIX .exp files since they confuse MakeMaker - push @linkwith_o, $1 while $linkwith_s =~ s/(-bI:\S+\.exp)\b//; - - $linkwith_msg = "@linkwith_o $linkwith_s [from $linkvia]"; - $opts{LIBS} = [ "-L$libhome $linkwith_s" ]; - $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g @linkwith_o \$(COMPOBJS)" }; + else { # the not-so-simple approach! + # get a cut down $linkwith to pass to MakeMaker liblist + my $linkwith_s = expand_mkvars($linkwith, 1, 1); + + # convert "/full/path/libFOO.a" into "-L/full/path -lFOO" + # to cater for lack of smarts in MakeMaker / Liblist + # which ignores /foo/bar.a entries! + my $lib_ext_re = "(a|$Config{dlext}|$Config{so})"; + $linkwith_s =~ s!(\S+)/lib(\w+)\.($lib_ext_re)\b!-L$1 -l$2!g; + + # Platform specific fix-ups: + # delete problematic crt?.o on 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 ($^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 "Deleting -lthread from link list as a possible workround ($osvers).\n"; + $linkwith_s =~ s/\s*-lthread\b/ /g; + } + + # extract object files, keep for use later + my @linkwith_o; + push @linkwith_o, $1 while $linkwith_s =~ s/(\S+\.[oa])\b//; + # also extract AIX .exp files since they confuse MakeMaker + push @linkwith_o, $1 while $linkwith_s =~ s/(-bI:\S+\.exp)\b//; + + $linkwith_msg = "@linkwith_o $linkwith_s [from $linkvia]"; + $opts{LIBS} = [ "-L$libhome $linkwith_s" ]; + $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g @linkwith_o \$(COMPOBJS)" }; } my $OCIINCLUDE = expand_mkvars($MK{INCLUDE} || '', 0, 0); @@ -748,7 +737,7 @@ if ($::opt_g && $^O eq "MSWin32" && $Config::Config{cc} eq "cl") { $opts{DEFINE} .= ' -Wall -Wno-comment' if $Config{gccversion}; -$opts{DEFINE} .= ' -Xa' if $Config{cc} eq 'clcc'; # CenterLine CC +$opts{DEFINE} .= ' -Xa' if $Config{cc} eq 'clcc'; # CenterLine CC @@ -761,8 +750,8 @@ $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\""; + ? " -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 @@ -773,10 +762,10 @@ $opts{DEFINE} .= ($^O ne 'VMS') print "\nclient_version=$client_version\n\n"; $opts{DEFINE} .= " -DORA_OCI_102" if ($::opt_V && $client_version == 10.2) - or ( $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); + or ( $client_version >= 11.2); print "\nDEFINE=$opts{DEFINE}\n\n"; # OCIStmntFetch2() is a feature of OCI 9.0.0 @@ -788,11 +777,11 @@ if ($is_developer){ # a reasonable guess $BELL = "" if ($ENV{LOGNAME}||'') eq 'timbo'; $::opt_g = '-g'; 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{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"; } @@ -802,12 +791,12 @@ if ($is_developer){ # a reasonable guess # files, we sadly have to build static on HP-UX 9 :( if ($^O eq 'hpux') { if ($osvers < 10) { - print "WARNING: Forced to build static not dynamic on $^O $osvers.$BELL\n"; - $opts{LINKTYPE} = 'static'; + 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.txt...\n" - ." you may have to build your own perl, or go hunting for libraries\n"; + print "WARNING: If you have trouble, see DBD::Oracle::Troubleshooting::Hpux...\n" + ." you may have to build your own perl, or go hunting for libraries\n"; } print "WARNING: If you have trouble, try perl Makefile.PL -l\n" unless $::opt_l; sleep 5; @@ -843,11 +832,11 @@ print "Compiler: @Config{qw(cc optimize ccflags)}\n"; 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" if $MK{CC}; -print " CFLAGS: $MK{CFLAGS}\n" if $MK{CFLAGS}; + if $MK{CFLAGS} || $MK{LDFLAGS} || $MK{LDSTRING}; +print " CC: $MK{CC}\n" if $MK{CC}; +print " CFLAGS: $MK{CFLAGS}\n" if $MK{CFLAGS}; print " [".mkvar('CFLAGS',0,1,0). "]\n" if $MK{CFLAGS}; -print " CLIBS: $MK{CLIBS}\n" if $MK{CLIBS}; +print " CLIBS: $MK{CLIBS}\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} }; @@ -869,11 +858,11 @@ if ($^O eq 'aix' and $osvers >= 4 and $Config{cc} ne 'xlc_r') { 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"; + print " Also see DBD::Oracle::Troubleshooting::Aix for gcc instructions and read about the -p option.\n"; sleep 5; } -if ($Config{archname} !~ /-thread\b/i) { +if ($Config{archname} !~ /-threads?\b/i) { print "\n"; print "WARNING: If you have problems you may need to rebuild perl with threading enabled.$BELL\n"; sleep 5; @@ -886,11 +875,10 @@ if ($Config{usemymalloc} eq 'y') { } print "WARNING: Your GNU C compiler is very old. Please upgrade.\n" - if ($Config{gccversion} and $Config{gccversion} =~ m/^(1|2\.[1-5])/); + if ($Config{gccversion} and $Config{gccversion} =~ m/^(1\.|2\.[1-5])/); if ($opts{LINKTYPE} && $opts{LINKTYPE} eq 'static') { print "** Note: DBD::Oracle will be built *into* a NEW perl binary. You MUST use that new perl.\n"; - print " See README and Makefile.PL for more information.$BELL\n"; } @@ -904,9 +892,6 @@ WriteMakefile( dbd_edit_mm_attribs(\%opts) ); 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.txt files.\n"; -print " (Of course, you have read README by now anyway, haven't you?)\n\n"; vms_logical_names_sanity_check(); @@ -965,17 +950,24 @@ sub find_oracle_home { 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 + 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; + # this should work for non-instant-client installs ($OH/bin & $OH/lib*) + @oh = grep { (glob("$_/../lib*/libclntsh.$so*"))[0] } @path; + s:/[^/]/?$:: for @oh; + } + if (!@oh && lc($^O) eq 'linux') { # Try the standard Linux RPM location + my @loh = glob("/usr/lib/oracle/*/*/lib/libclntsh.$so*"); + @loh = sort { $a cmp $b } @loh; + my $loh = pop(@loh); + $loh =~ s/\/lib\/libclntsh.*$//g; + push(@oh,$loh); } print "Found @oh\n" if @oh; return $oh[0]; @@ -989,37 +981,37 @@ sub win32_oracle_home { my $default_home; if ( ! $oh ) { if ( $Config{osname} eq "MSWin32") { - # Win32::TieRegistry is prefered, but it requires Win32API::Registry - # which is not available in mingw or cygwin - eval { - require Win32::TieRegistry; - $Win32::TieRegistry::Registry->Delimiter("/"); - $req_ok = 1; - $hkey = $Win32::TieRegistry::Registry->{"LMachine/SOFTWARE/Oracle/"}; - }; - eval { # older name of Win32::TieRegistry - require Tie::Registry; - $Tie::Registry::Registry->Delimiter("/"); - $req_ok = 1; - $hkey = $Tie::Registry::Registry->{"LMachine/SOFTWARE/Oracle/"}; - } unless $req_ok; - eval { - $default_home = $hkey->{ORACLE_HOME} || ''; - }; - eval { - $Val = sub { - # Return value - my ($hkey) = @_; - return $hkey->{ORACLE_HOME} || ''; - }; - $Keys = sub { - # Return list of sub-folder keys - my ($hkey) = @_; - # MAC: %$hkey and related method calls don't work under - # perl5db, so don't try single stepping through here - return map {m:/$: ? $hkey->{$_} : ()} keys %$hkey; - }; - } if $hkey; + # Win32::TieRegistry is prefered, but it requires Win32API::Registry + # which is not available in mingw or cygwin + eval { + require Win32::TieRegistry; + $Win32::TieRegistry::Registry->Delimiter("/"); + $hkey = $Win32::TieRegistry::Registry->{"LMachine/SOFTWARE/Oracle/"} + and $req_ok = 1; + }; + eval { # older name of Win32::TieRegistry + require Tie::Registry; + $Tie::Registry::Registry->Delimiter("/"); + $hkey = $Tie::Registry::Registry->{"LMachine/SOFTWARE/Oracle/"} + and $req_ok = 1; + } unless $req_ok; + eval { + $default_home = $hkey->{ORACLE_HOME} || ''; + }; + eval { + $Val = sub { + # Return value + my ($hkey) = @_; + return $hkey->{ORACLE_HOME} || ''; + }; + $Keys = sub { + # Return list of sub-folder keys + my ($hkey) = @_; + # MAC: %$hkey and related method calls don't work under + # perl5db, so don't try single stepping through here + return map {m:/$: ? $hkey->{$_} : ()} keys %$hkey; + }; + } if $hkey; } # Win32::Registry imports some symbols into main:: @@ -1027,29 +1019,29 @@ sub win32_oracle_home { # MAC: it is available under mingw and might be available under cygwin # If cygwin doesn't have it, move the rest inside the other if block eval { - require Win32::Registry; - $main::HKEY_LOCAL_MACHINE->Open('SOFTWARE\\ORACLE', $hkey); - my $dummy = $main::HKEY_LOCAL_MACHINE; # avoid single use complaint - eval { - my $hval; - $hkey->GetValues($hval); - $default_home = $hval->{ORACLE_HOME}[2] || ''; - }; - $Val = sub { - # Return value - my ($hkey) = @_; - my $hval; - $hkey->GetValues($hval); - return $hval->{ORACLE_HOME}[2] || ''; - }; - $Keys = sub { - # Return list of sub-folder keys - my ($hkey) = @_; - my @hkey; - $hkey->GetKeys(\@hkey); - @hkey = map { $hkey->Open($_, $_); $_ } @hkey; - return @hkey; - }; + require Win32::Registry; + $main::HKEY_LOCAL_MACHINE->Open('SOFTWARE\\ORACLE', $hkey); + my $dummy = $main::HKEY_LOCAL_MACHINE; # avoid single use complaint + eval { + my $hval; + $hkey->GetValues($hval); + $default_home = $hval->{ORACLE_HOME}[2] || ''; + }; + $Val = sub { + # Return value + my ($hkey) = @_; + my $hval; + $hkey->GetValues($hval); + return $hval->{ORACLE_HOME}[2] || ''; + }; + $Keys = sub { + # Return list of sub-folder keys + my ($hkey) = @_; + my @hkey; + $hkey->GetKeys(\@hkey); + @hkey = map { $hkey->Open($_, $_); $_ } @hkey; + return @hkey; + }; } unless $req_ok; # Workaround Win32::TieRegistry FETCH error during global destruction. @@ -1058,38 +1050,38 @@ sub win32_oracle_home { # Look for ORACLE_HOME in all ORACLE sub-folders, use last one found # before 8.1.5, there should be only one eval { - my ($oh1, %oh); - my @hkey = ($hkey); - # JLU: December 5, 2002: if the "default" home is set and has - # an OCI directory, then use it. - if ($default_home && -d $default_home && -d $default_home . "/oci") { - $oh = $default_home; - } else { - # use previous logic if default home doesn't have OCI - # directory - while (@hkey) { - $hkey = shift @hkey; - $oh = $oh1, $oh{$oh1} = 1 - if ($oh1 = &$Val($hkey)) && -d $oh1; - push @hkey, &$Keys($hkey); - } - if (1 < keys %oh) { - # JLU: 8/21/01 Oracle's default home is the first one in - # the path, at least with 8i - print "\n\007Multiple Oracle homes: ", join(" ", sort keys %oh), "\n\n"; - my @path = split(";", $ENV{PATH}); - my $dir; - foreach $dir (@path) { - # the path will be c:\path\to\home\bin, so remove \bin if it's there. - $dir =~ s/\\bin$//; - if (defined($oh{$dir})) { - print "$dir is first in the PATH, so we'll use that as Oracle's default home.\n\n"; - $oh = $dir; - last; - } - } - } - } + my ($oh1, %oh); + my @hkey = ($hkey); + # JLU: December 5, 2002: if the "default" home is set and has + # an OCI directory, then use it. + if ($default_home && -d $default_home && -d $default_home . "/oci") { + $oh = $default_home; + } else { + # use previous logic if default home doesn't have OCI + # directory + while (@hkey) { + $hkey = shift @hkey; + $oh = $oh1, $oh{$oh1} = 1 + if ($oh1 = &$Val($hkey)) && -d $oh1; + push @hkey, &$Keys($hkey); + } + if (1 < keys %oh) { + # JLU: 8/21/01 Oracle's default home is the first one in + # the path, at least with 8i + print "\n\007Multiple Oracle homes: ", join(" ", sort keys %oh), "\n\n"; + my @path = split(";", $ENV{PATH}); + my $dir; + foreach $dir (@path) { + # the path will be c:\path\to\home\bin, so remove \bin if it's there. + $dir =~ s/\\bin$//; + if (defined($oh{$dir})) { + print "$dir is first in the PATH, so we'll use that as Oracle's default home.\n\n"; + $oh = $dir; + last; + } + } + } + } } if defined $Keys; } @@ -1101,14 +1093,17 @@ 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") : ''; + ? read_file("$OH/lib/sysliblist") + : (-f "$OH/rdbms/lib/sysliblist") ? read_file("$OH/rdbms/lib/sysliblist") : ''; 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; } + if (lc(@Config{qw(myuname)}) =~ /debian/) { + $syslibs .= " -Wl,--no-as-needed -lnnz12 -lons -lclntshcore -lipc1 -lmql1"; + } return $syslibs; } @@ -1117,12 +1112,15 @@ sub perl_is_64bit { return defined $Config{use64bitall} ; } sub ora_libdir { - my $libdir = 'lib' ; + my $libdir = 'lib'; if ( $client_version >= 9 ) { - $libdir = 'lib32' if ! perl_is_64bit() and -d "$OH/lib32"; + $libdir = 'lib32' if ! perl_is_64bit() and -d "$OH/lib32"; + $libdir = 'lib64' if perl_is_64bit() and -d "$OH/lib64"; + # Solaris OIC 12+ from pkg + $libdir = 'lib/64' if perl_is_64bit() and -d "$OH/lib/64"; } else { - $libdir = 'lib64' if perl_is_64bit() and -d "$OH/lib64"; + $libdir = 'lib64' if perl_is_64bit() and -d "$OH/lib64"; } return $libdir; @@ -1138,8 +1136,8 @@ sub del_crtobj { my @del; push @del, $1 while $str =~ s:([^\s=]*\bcrt[1in]\.o)\b::; if ($orig ne $str) { - print "Deleted @del from link args.\n" if $verbose; - print "del_crtobj: $orig\n : $str\n@del\n" if $::opt_v; + print "Deleted @del from link args.\n" if $verbose; + print "del_crtobj: $orig\n : $str\n@del\n" if $::opt_v; } return $str; } @@ -1148,17 +1146,20 @@ sub del_crtobj { sub find_mkfile { my @mk_oci32 = ( - 'rdbms/demo/demo_xe.mk', - 'rdbms/demo/demo_rdbms32.mk' + 'rdbms/demo/demo_xe.mk', + 'rdbms/demo/demo_rdbms32.mk', + 'rdbms/demo/demo_rdbms.mk', + 'rdbms/lib/ins_rdbms.mk', #Oracle 11 full client + 'sdk/demo/demo.mk' #OIC .mk location ); my @mk_oci64 = ( - 'rdbms/demo/demo_xe.mk', - 'rdbms/lib/oracle.mk', - 'rdbms/demo/oracle.mk', - 'rdbms/demo/demo_rdbms.mk', - 'rdbms/demo/demo_rdbms64.mk', - 'rdbms/lib/ins_rdbms.mk' #Oracle 11 full client for 64 bit and maybe 32 bit?? - + 'rdbms/demo/demo_xe.mk', + 'rdbms/lib/oracle.mk', + 'rdbms/demo/oracle.mk', + 'rdbms/demo/demo_rdbms.mk', + 'rdbms/demo/demo_rdbms64.mk', + 'rdbms/lib/ins_rdbms.mk', #Oracle 11 full client + 'sdk/demo/demo.mk' # git issue 20 - path on mac os ); my @mk_oci = perl_is_64bit() ? @mk_oci64 : @mk_oci32; @@ -1170,36 +1171,38 @@ sub find_mkfile { 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; + $::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; - foreach my $place (@mkplaces) { - $place = "$OH/$place" - unless $place =~ m:^[/\.]:; # abs or relative path - next unless -f $place; - $mkfile ||= $place; # use first one found - print "Found $place\n"; + for my $place (@mkplaces) { + $place = "$OH/$place" + unless $place =~ m:^[/\.]:; # abs or relative path + next unless -f $place; + $mkfile ||= $place; # use first one found + print "Found $place\n"; + } + unless ($^O eq 'MSWin32' || $^O eq 'VMS' || ($mkfile && -f $mkfile) || $::opt_F) { + $::opt_l or return ($mkfile = undef); + die qq{ + Unable to locate an oracle.mk or other suitable *.mk + file in your Oracle installation. (I looked in + @mkplaces under $OH) + + The oracle.mk (or demo_rdbms.mk) file is part of the Oracle + 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 the appropriate troubleshooting guide for your OS for more information and some alternatives. + }; } - die qq{ - Unable to locate an oracle.mk or other suitable *.mk - file in your Oracle installation. (I looked in - @mkplaces under $OH) - - The oracle.mk (or demo_rdbms.mk) file is part of the Oracle - 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 the appropriate README file for your OS for more information and some alternatives. - - } unless ($^O eq 'MSWin32') || ($^O eq 'VMS') || ($mkfile && -f $mkfile) || $::opt_F; print "Using $mkfile\n"; return $mkfile; @@ -1215,32 +1218,32 @@ sub fetch_oci_macros { # Don't include the following definitions in the generated # makefile (note that %MK stills gets these values). my @edit = qw( - SHELL CC CPP CFLAGS CCFLAGS OPTIMIZE ASFLAGS RCC LD LDFLAGS - AR AS CHMOD ECHO EXE OBJS PERL OBJ_EXT LIB_EXT VERSION + SHELL CC CPP CFLAGS CCFLAGS OPTIMIZE ASFLAGS RCC LD LDFLAGS + AR AS CHMOD ECHO EXE OBJS PERL OBJ_EXT LIB_EXT VERSION ); my %edit; @edit{@edit} = ('$_ = ""') x @edit; $edit{ORA_NLS} = $edit{ORA_NLS33} = $edit{ORA_NLS32} = q{ - print "Deleting $_\n", - " because it is not already set in the environment\n", - " and it can cause ORA-01019 errors.\n"; - $_ = ''; + print "Deleting $_\n", + " 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} - || 1; # Old problem? Let's try without it for a while + || 1; # Old problem? Let's try without it for a while $edit{COMPOBJS} = q{ - # Firstly a Solaris specific edit: - $_ = del_crtobj($_) if $^O eq 'solaris'; - - # Delete any object files in COMPOBJS that don't actually exist - my $of; - foreach $of (split(/=|\s+/)) { - next if !$of or $of eq "COMPOBJS"; - my $obj = expand_mkvars($of,0,0); - next if -e $obj; - print "Deleting $of from COMPOBJS because $obj doesn't exist.\n"; - s:\Q$of::; - } + # Firstly a Solaris specific edit: + $_ = del_crtobj($_) if $^O eq 'solaris'; + + # Delete any object files in COMPOBJS that don't actually exist + my $of; + foreach $of (split(/=|\s+/)) { + next if !$of or $of eq "COMPOBJS"; + my $obj = expand_mkvars($of,0,0); + 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 @@ -1254,117 +1257,117 @@ sub fetch_oci_macros { my $lastline = ''; my @lines = read_inc_file($file); for(1; $_ = shift(@lines); $lastline = $_){ - # Join split lines but retain backwack and newlines: - $_ .= shift @lines while(m/\\[\r\n]+$/); - chomp; - push @MK, '' if $_ eq '' and $lastline ne ''; # squeeze multiple blank lines - next unless $_; - - if ($incompat_ext) { - 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; - } - }; + # Join split lines but retain backwack and newlines: + $_ .= shift @lines while(m/\\[\r\n]+$/); + chomp; + push @MK, '' if $_ eq '' and $lastline ne ''; # squeeze multiple blank lines + next unless $_; + + if ($incompat_ext) { + 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 - for (@tgts) { $mk_target_deps{$_} = $2 || '' } - my @rules; + for (@tgts) { $mk_target_deps{$_} = $2 || '' } + my @rules; while (@lines && $lines[0] =~ m!^\t! && chomp $lines[0]) { my $tmp_line = shift @lines; - while($tmp_line =~ m!\\$!) { # continuations! + while($tmp_line =~ m!\\$!) { # continuations! $tmp_line =~ s/\s+\\$/ /; $tmp_line .= shift @lines; chomp($tmp_line); } - push @rules, $tmp_line; - #print "target @tgts => $mk_target_deps{$tgt} => @{$mk_target_rules{$tgt}}\n"; + push @rules, $tmp_line; + #print "target @tgts => $mk_target_deps{$tgt} => @{$mk_target_rules{$tgt}}\n"; } - for (@tgts) { push @{ $mk_target_rules{$_} ||= [] }, @rules } + for (@tgts) { push @{ $mk_target_rules{$_} ||= [] }, @rules } next; } - next if m!^\t!; # skip target build rules - next if m/^\s*\.SUFFIXES/; - - unless($MK{mkver}) { # still want to get version number - my $line = $_; $line =~ s/[\\\r\n]/ /g; - $MK{mkver} = $mkver = $1 - if $line =~ m/\$Header:.*?\.mk.+(\d+\.\d+)/; - } - - # We always store values into %MK before checking %edit - # %edit can edit this in addition to $_ if needed. - my $name; - if (m/^\s*(\w+)\s*(\+?)=\s*/) { - $name = $1; - my $append = $2; - my $value = $'; - $value =~ s/^\@`/`/; - if ($append) { - my $expanded = expand_mkvars($value, 0, 1); - print "Appending '$expanded' to $name\n" if $::opt_v; - $value = $MK{$name} ? "$MK{$name} $expanded" : $expanded; - } - elsif ($MK{$name} && $MK{$name} ne $value) { - print "$name macro redefined by Oracle\n from $MK{$name}\n to $value\n" - if $::opt_d; - } - $MK{$name} = $value; - $MK{$name} =~ s/^([^#]*)#.*/$1/; # remove comments - - if (exists $edit{$name}) { - my $pre = $_; - eval $edit{$name}; # execute code to edit $_ - print "Edit $name ($edit{$name}) failed: $@\n" if $@; - if ($_ ne $pre and $::opt_v) { - $_ ? print "Edited $name definition\n from: $pre\n to: $_\n" - : print "Deleted $name definition: $pre\n"; - } - } - } - - push(@MK, $_); + next if m!^\t!; # skip target build rules + next if m/^\s*\.SUFFIXES/; + + unless($MK{mkver}) { # still want to get version number + my $line = $_; $line =~ s/[\\\r\n]/ /g; + $MK{mkver} = $mkver = $1 + if $line =~ m/\$Header:.*?\.mk.+(\d+\.\d+)/; + } + + # We always store values into %MK before checking %edit + # %edit can edit this in addition to $_ if needed. + my $name; + if (m/^\s*(\w+)\s*(\+?)=\s*/) { + $name = $1; + my $append = $2; + my $value = $'; + $value =~ s/^\@`/`/; + if ($append) { + my $expanded = expand_mkvars($value, 0, 1); + print "Appending '$expanded' to $name\n" if $::opt_v; + $value = $MK{$name} ? "$MK{$name} $expanded" : $expanded; + } + elsif ($MK{$name} && $MK{$name} ne $value) { + print "$name macro redefined by Oracle\n from $MK{$name}\n to $value\n" + if $::opt_d; + } + $MK{$name} = $value; + $MK{$name} =~ s/^([^#]*)#.*/$1/; # remove comments + + if (exists $edit{$name}) { + my $pre = $_; + eval $edit{$name}; # execute code to edit $_ + print "Edit $name ($edit{$name}) failed: $@\n" if $@; + if ($_ ne $pre and $::opt_v) { + $_ ? print "Edited $name definition\n from: $pre\n to: $_\n" + : print "Deleted $name definition: $pre\n"; + } + } + } + + push(@MK, $_); } # --- now decide what to link with --- my $linkvia; if ($::opt_n) { - $linkvia = "\$($::opt_n)" if $MK{$::opt_n}; - warn "Can't use '$::opt_n': not defined by .mk files\n" - unless $linkvia; + $linkvia = "\$($::opt_n)" if $MK{$::opt_n}; + warn "Can't use '$::opt_n': not defined by .mk files\n" + unless $linkvia; } # modern Oracle .mk files define OCISTATICLIBS and OCISHAREDLIBS if (!$linkvia && ($MK{OCISHAREDLIBS} || $MK{OCISTATICLIBS})) { - $linkvia = ''; - if ($MK{OCISTATICLIBS} && - ( ($opts{LINKTYPE}||'') eq 'static' - || "@ARGV" =~ m/\bLINKTYPE=static\b/ - || $::opt_c) + $linkvia = ''; + if ($MK{OCISTATICLIBS} && + ( ($opts{LINKTYPE}||'') eq 'static' + || "@ARGV" =~ m/\bLINKTYPE=static\b/ + || $::opt_c) ) { - $linkvia .= '$(DEF_ON) ' if $MK{DEF_ON}; - $linkvia .= '$(SSCOREED) ' if $MK{SSCOREED}; - $linkvia .= '$(OCISTATICLIBS)'; - } - else { - $linkvia .= '$(SSDBED) ' if $MK{SSDBED}; - $linkvia .= '$(DEF_OPT) ' if $MK{DEF_OPT}; - 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"; - } - $linkvia .= '$(OCISHAREDLIBS)'; - } + $linkvia .= '$(DEF_ON) ' if $MK{DEF_ON}; + $linkvia .= '$(SSCOREED) ' if $MK{SSCOREED}; + $linkvia .= '$(OCISTATICLIBS)'; + } + else { + $linkvia .= '$(SSDBED) ' if $MK{SSDBED}; + $linkvia .= '$(DEF_OPT) ' if $MK{DEF_OPT}; + if ($client_version_full =~ m/^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"; + } + $linkvia .= '$(OCISHAREDLIBS)'; + } } $linkvia = '$(LIBCLNTSH)' if !$linkvia && $MK{LIBCLNTSH}; @@ -1373,29 +1376,29 @@ sub fetch_oci_macros { $linkvia = '$(OCILDLIBS)' if !$linkvia && $MK{OCILDLIBS}; # Now we get into strange land of twisty turny macros - if (!$linkvia && $MK{PROLDLIBS}) { # Oracle 7.3.x - # XXX tweak for threaded perl? - use PROLLSsharedthread - if ($MK{PROLDLIBS} =~ /thread/i && $MK{PROLLSshared}) { - $linkvia = '$(PROLLSshared)'; - } - else { - $linkvia = '$(PROLDLIBS)'; - } + if (!$linkvia && $MK{PROLDLIBS}) { # Oracle 7.3.x + # XXX tweak for threaded perl? - use PROLLSsharedthread + if ($MK{PROLDLIBS} =~ /thread/i && $MK{PROLLSshared}) { + $linkvia = '$(PROLLSshared)'; + } + else { + $linkvia = '$(PROLDLIBS)'; + } } elsif (!$linkvia && int($mkver) == 1) { - if ($MK{LLIBOCIC}) { - $linkvia = '$(LLIBOCIC) $(TTLIBS)'; - } else { - print "WARNING: Guessing what to link with.\n"; - $linkvia = '-locic $(TTLIBS)'; # XXX GUESS HACK - } + if ($MK{LLIBOCIC}) { + $linkvia = '$(LLIBOCIC) $(TTLIBS)'; + } else { + print "WARNING: Guessing what to link with.\n"; + $linkvia = '-locic $(TTLIBS)'; # XXX GUESS HACK + } } - elsif (!$linkvia && $MK{CCLIB}) { # Oracle XE - $linkvia = '$(CCLIB)'; + 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"; + 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"; } $MK_TEXT = join("\n", @MK); return $linkvia; @@ -1406,23 +1409,23 @@ sub read_inc_file { my $file = shift; my $fh; unless ($fh = new FileHandle "<$file") { - # Workaround more oracle bungling (Oracle 7.3.2/Solaris x86) - my $alt; ($alt = $file) =~ s/\.dk\.mk$/\.mk/; - $fh = new FileHandle "<$alt"; - die "Unable to read $file: $!" unless $fh; + # Workaround more oracle bungling (Oracle 7.3.2/Solaris x86) + my $alt; ($alt = $file) =~ s/\.dk\.mk$/\.mk/; + $fh = new FileHandle "<$alt"; + die "Unable to read $file: $!" unless $fh; } print "Reading $file\n"; my @lines; push(@mkfiles, $file); while(<$fh>) { - # soak up while looking for include directives - push(@lines, $_), next - unless /^\s*include\s+(.*?)\s*$/m; - my $inc_file = $1; - # deal with "include $(ORACLE_HOME)/..." - # (can't use expand_mkvars() here) - $inc_file =~ s/\$\((ORACLE_HOME|ORACLE_ROOT)\)/$ENV{$ORACLE_ENV}/og; - push(@lines, read_inc_file($inc_file)); + # soak up while looking for include directives + push(@lines, $_), next + unless /^\s*include\s+(.*?)\s*$/m; + my $inc_file = $1; + # deal with "include $(ORACLE_HOME)/..." + # (can't use expand_mkvars() here) + $inc_file =~ s/\$\((ORACLE_HOME|ORACLE_ROOT)\)/$ENV{$ORACLE_ENV}/og; + push(@lines, read_inc_file($inc_file)); } print "Read a total of ".@lines." lines from $file (including inclusions)\n" if $::opt_v; return @lines; @@ -1435,14 +1438,14 @@ sub expand_shellescape { my $cmd = $orig; my $debug = $::opt_d || $::opt_v; print "Evaluating `$orig`\n" - if $debug && !$expand_shellescape{$orig}; + if $debug && !$expand_shellescape{$orig}; # ensure we have no $(...) vars left - strip out undefined ones: $cmd =~ s/\$[({](\w+)[})]/mkvar("$1", 1, 0, $level+1)/ge; print " expanded `$cmd`\n" if $debug and $cmd ne $orig; my $result = `$cmd`; $result =~ s/\s+$/ /; # newlines etc to single space print " returned '$result'\n" - if $debug && !$expand_shellescape{$orig}; + if $debug && !$expand_shellescape{$orig}; $expand_shellescape{$orig} = $result; $result; } @@ -1450,22 +1453,22 @@ sub expand_shellescape { sub expand_mkvars { my ($string, $strip, $backtick, $level, $maxlevel) = @_; - return if(!defined $string); + return if(!defined $string); $level ||= 1; local($_) = $string; print "$level Expanding $_\n" if $::opt_d; # handle whizzo AIX make feature used by Oracle s/\$[({] (\w+) \? ([^(]*?) : ([^(]*?) [})]/ - my ($vname, $vT, $vF) = ($1,$2,$3); - $MK{$vname} = (mkvar($vname, 1, $backtick, $level+1)) ? $vT : $vF + my ($vname, $vT, $vF) = ($1,$2,$3); + $MK{$vname} = (mkvar($vname, 1, $backtick, $level+1)) ? $vT : $vF /xge; # can recurse s/\$[({] (\w+) [})]/ - mkvar("$1", $strip, $backtick, $level+1, $maxlevel) + mkvar("$1", $strip, $backtick, $level+1, $maxlevel) /xge; # can recurse s/`(.*?[^\\])`/expand_shellescape("$1", $level+1)/esg if $backtick; # can recurse - s/\s*\\\n\s*/ /g; # merge continuations - s/\s+/ /g; # shrink whitespace + s/\s*\\\n\s*/ /g; # merge continuations + s/\s+/ /g; # shrink whitespace print "$level Expanded $string\n to $_\n\n" if $::opt_d and $_ ne $string; $_; } @@ -1479,14 +1482,14 @@ sub mkvar { return $ENV{$ORACLE_ENV} if $var eq 'ORACLE_HOME'; my $val = $MK{$var}; if (!defined $val and exists $ENV{$var}) { - $val = $ENV{$var}; - print "Using value of $var from environment: $val\n" - unless $var eq 'LD_LIBRARY_PATH'; + $val = $ENV{$var}; + print "Using value of $var from environment: $val\n" + unless $var eq 'LD_LIBRARY_PATH'; } return $default unless defined $val; if ($MK_expanding{$var}) { - print "Definition of \$($var) includes \$($var).\n"; - return "\$($var)"; + print "Definition of \$($var) includes \$($var).\n"; + return "\$($var)"; } local($MK_expanding{$var}) = 1; return $val if $maxlevel && $level >= $maxlevel; @@ -1497,8 +1500,8 @@ sub mkvar { sub read_file { my $file = shift; unless (open(ROL, "<$file")) { - warn "WARNING: Unable to open $file: $!\n"; - return ""; + warn "WARNING: Unable to open $file: $!\n"; + return ""; } my $text = join "", ; $text =~ s/\n+/ /g; @@ -1508,11 +1511,16 @@ sub read_file { sub find_bin{ - use filetest 'access'; my $bin = shift; my $path_sep = $Config{path_sep}; 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 undef; } @@ -1522,28 +1530,39 @@ sub find_headers { # compensate for case where final .0 isn't in the install directory name (my $client_version_trim = $client_version_full) =~ s/\.0$//; + # for case where point is not in install directory name. OCI 21+ + (my $client_version_major = $client_version) =~ s/\..*$//; - my @try = ( # search the ORACLE_HOME we're using first + 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", + "$OH/include", # --- Oracle RPM Instant Client locations - "/usr/include/oracle/$client_version_full/client", # Instant Client for RedHat FC4 - "/usr/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC4 - "/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/client", # Instant Client 11.1 and up - "/usr/include/oracle/$client_version/client64", # Instant Client 11.1 and up - "/usr/include/oracle/$client_version_trim/client64", # Instant Client 64 - "/usr/include/oracle/$client_version_full/client64", # Instant Client 64 - + map { ( $_, $_."64" ) } + map { ( $_, "/usr$_" ) } + map { "/include/oracle/$_/client" } + $client_version, + $client_version_trim, + $client_version_full, + $client_version_major, + + #"/include/oracle/$client_version_full/client", # Instant Client for RedHat FC3 + #"/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC3 + #"/include/oracle/$client_version_major/client", # Instant Client RPM (21+) + #"/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_major/client64",# Instant Client RPM (21+) + #"/usr/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC4 + #"/usr/include/oracle/$client_version_major/client", # Instant Client RPM (21+) ); - - # 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. @@ -1568,14 +1587,14 @@ sub find_headers { 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 the appropriate README file for your OS for more information.$BELL\n"; - print "*********************************************************\n\n"; - sleep 5; + 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 the appropriate troubleshooting guide for your OS for more information.$BELL\n"; + print "*********************************************************\n\n"; + sleep 5; } return @h_dir; } @@ -1601,106 +1620,112 @@ sub get_client_version { 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; + 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 my $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 =~ m/(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; } - 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"; + warn "Can't find sqlplus. Pity, it would have helped.\n"; } if (!$client_version_full && $OH && open INST, "<$OH/install/unix.rgs") { - local $/ = undef; - =~ m/^(rdbms|sql\*plus)\s+([\d.]+)/m; - $client_version_full = $2 if $2; - close INST; + local $/ = undef; + =~ 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 = ; - 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 $_; - } + open my $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\.]((?:8|9|1\d)\.\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"; - } + print "I'm having trouble finding your Oracle version number... trying harder\n" + unless $force_version; + if ( $OH =~ m![^\d\.]((?:8|9|1\d)\.\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"; + } + elsif ( "$OH/" =~ m!/usr/lib/oracle/(\d+\.\d)/!) { # Linux RPM + $client_version_full = "$1.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; + 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+/ + if ($client_version_full && $client_version_full !~ m/^([789]|[12][0-9])\.[0-9]+/ ) { - print "Oracle version seems to be $client_version_full but that looks wrong so I'll ignore it.\n"; - $client_version_full = ""; + 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 + + # set a supported client version as default + $client_version_full = "9.2.0.4.0"; + + print qq{ +WARNING: Could not determine Oracle client version, defaulting 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 your +client version.\n }; - sleep 5; + # pause for focus + sleep 3; } # 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"; + print "Oracle Version $client_version_full ($client_version)\n"; return $client_version unless wantarray; return ($client_version, $client_version_full); @@ -1711,16 +1736,16 @@ sub symbol_search { $::opt_s ||= $::opt_S; print "Searching for symbol '$::opt_s' in $OH ...\n"; my $dlext = $Config{dlext}; - system(qq{ cd $OH; for i in lib/*.[ao] lib/*.$dlext */lib/*.[ao]; - do echo " searching oracle \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done + system(qq{ cd $OH; for i in lib/*.[ao] lib/*.$dlext */lib/*.[ao]; + do echo " searching oracle \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done }); if ($::opt_S) { - my @libpth = split ' ', $Config{libpth}; - print "Searching for symbol '$::opt_s' in @libpth ...\n"; - @libpth = map { ("$_/lib*.$dlext", "$_/lib*.a") } @libpth; - system(qq{ cd $OH; for i in @libpth; - do echo " searching \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done - }); + my @libpth = split ' ', $Config{libpth}; + print "Searching for symbol '$::opt_s' in @libpth ...\n"; + @libpth = map { ("$_/lib*.$dlext", "$_/lib*.a") } @libpth; + system(qq{ cd $OH; for i in @libpth; + do echo " searching \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done + }); } print "Search done.\n"; print "(Please only include the 'interesting' parts when mailing.)\n"; @@ -1745,87 +1770,75 @@ sub symbol_search { 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) - ->Dump([\%opts, $self], [qw(dbd_oracle_mm_opts dbd_oracle_mm_self)]); - }; - if ($@) { - warn "Can't dump config to mk.pm so you won't be able to build Oracle::OCI later if you wanted to: $@\n"; - print main::MK_PM qq{die "You need to reinstall DBD::Oracle after installing Data::Dumper\n"; }; - } - close main::MK_PM or die "Error closing mk.pm: $!\n"; - - foreach (qw(mk.pm Oracle.h dbdimp.h ocitrace.h)) { - $self->{PM}->{$_} = '$(INST_ARCHAUTODIR)/'.$_; - } - - # Add $linkwith to EXTRALIBS for those doing static linking - $self->{EXTRALIBS} .= " -L\$(LIBHOME)"; - $self->{EXTRALIBS} .= " $linkwith" if $linkwith; - - ''; + my $self = shift; + + 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:; + + eval { # This chunk is for Oracle::OCI + require Data::Dumper; + my $dmp = Data::Dumper->new([\%opts, $self], [qw(dbd_oracle_mm_opts dbd_oracle_mm_self)]); + print main::MK_PM $dmp->Purity(1)->Terse(0)->Indent(1)->Useqq(1)->Dump; + }; + if ($@) { + warn "Can't dump config to mk.pm so you won't be able to build Oracle::OCI later if you wanted to: $@\n"; + print main::MK_PM qq{die "You need to reinstall DBD::Oracle after installing Data::Dumper\n"; }; + } + close main::MK_PM or die "Error closing mk.pm: $!\n"; + + foreach (qw(mk.pm Oracle.h dbdimp.h dbivport.h ocitrace.h)) { + $self->{PM}->{$_} = '$(INST_ARCHAUTODIR)/'.$_; + } + + # Add $linkwith to EXTRALIBS for those doing static linking + $self->{EXTRALIBS} .= " -L\$(LIBHOME)"; + $self->{EXTRALIBS} .= " $linkwith" if $linkwith; + + ''; } sub postamble { - return main::dbd_postamble(@_); + return main::dbd_postamble(@_); } sub const_loadlibs { - my $self = shift; - - # 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) = $self->{LD_RUN_PATH}; - # remove redundant /lib or /usr/lib as it can cause problems - $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(@_); - - print "Ignoring LD_RUN_PATH='$ENV{LD_RUN_PATH}' in environment\n" if $ENV{LD_RUN_PATH}; - print "LD_RUN_PATH=$ldrp\n"; - return $_; + my $self = shift; + + # 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) = $self->{LD_RUN_PATH}; + # remove redundant /lib or /usr/lib as it can cause problems + $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(@_); + + print "Ignoring LD_RUN_PATH='$ENV{LD_RUN_PATH}' in environment\n" if $ENV{LD_RUN_PATH}; + print "LD_RUN_PATH=$ldrp\n"; + return $_; } sub post_constants { - my $self = shift; - return '' unless $::opt_f; - # Oracle Definitions, based on $(ORACLE_HOME)/proc/lib/proc.mk - ' + my $self = shift; + return '' unless $::opt_f; + # Oracle Definitions, based on $(ORACLE_HOME)/proc/lib/proc.mk + ' ################################################################### # ORACLE_HOME = '.$OH.' @@ -1842,96 +1855,96 @@ ORACLE_HOME = '.$OH.' sub const_cccmd { - my ($self) = shift; - print "Using DBD::Oracle $self->{VERSION}.\n"; - - local($_) = $self->SUPER::const_cccmd(@_); - # If perl Makefile.PL *-g* then switch on debugging - if ($::opt_g) { - 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 ($^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 - } - - $_; + my ($self) = shift; + print "Using DBD::Oracle $self->{VERSION}.\n"; + + local($_) = $self->SUPER::const_cccmd(@_); + # If perl Makefile.PL *-g* then switch on debugging + if ($::opt_g) { + 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 ($^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 + } + + $_; } sub cflags { - my ($self) = shift; - local($_) = $self->SUPER::cflags(@_); - # If perl Makefile.PL *-g* then switch on debugging - if ($::opt_g) { - 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 ($^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 - } - $_; + my ($self) = shift; + local($_) = $self->SUPER::cflags(@_); + # If perl Makefile.PL *-g* then switch on debugging + if ($::opt_g) { + 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 ($^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 + } + $_; } sub dynamic_lib { - my($self) = shift; - - 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); - } - - # special code for VMS only - my(%attribs) = @_; - return '' unless $self->needs_linking(); #might be because of a subdir - return '' unless $self->has_link_code(); - - my $OtherText; - my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; - my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; - my @m; - push @m, "OTHERLDFLAGS = $otherldflags\n"; - push @m, "INST_DYNAMIC_DEP = $inst_dynamic_dep\n"; + my($self) = shift; + + 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); + } + + # special code for VMS only + my(%attribs) = @_; + return '' unless $self->needs_linking(); #might be because of a subdir + return '' unless $self->has_link_code(); + + my $OtherText; + my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; + my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my @m; + push @m, "OTHERLDFLAGS = $otherldflags\n"; + push @m, "INST_DYNAMIC_DEP = $inst_dynamic_dep\n"; if ($] < 5.00450) { - push @m, ' + push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) - $(NOECHO) $(MKPATH) $(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,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option i + $(NOECHO) $(MKPATH) $(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,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option i '; } else { - push @m, ' + push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) - $(NOECHO) $(MKPATH) $(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 + $(NOECHO) $(MKPATH) $(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); + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('',@m); } } @@ -1967,21 +1980,23 @@ sub check_ldlibpthname { my $warn_name = $ldlibpthname; - return 1 if grep { s:[\\/]$::; $_ eq $libdir } @dirs; + # It is also ok if we are using symbolic links + return 1 if grep { s:[\\/]$::; $_ eq $libdir } + map { $_, Cwd::abs_path($_) } @dirs; # on solaris, it can be under LD_LIBRARY_PATH_(32|64) if ( $^O eq 'solaris' ) { - my $ld_library_path_name = 'LD_LIBRARY_PATH_' + 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}), + 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; + return 1 if grep { $_ eq $libdir } @dirs; } warn "WARNING: Your $warn_name env var doesn't include '$libdir' but probably needs to.\n"; @@ -1995,24 +2010,22 @@ sub check_security { # 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 - otrcfmt otrcrep otrccol + oratclsh lsnrctl oemevent onrsd osslogin tnslsnr + tnsping trcasst trcroute cmctl cmadmin cmgw names namesctl otrccref + otrcfmt otrcrep otrccol ); my @bad; - foreach (@files) { - my $file = "$ENV{ORACLE_HOME}/bin/$_"; - my ($mode) = (stat($file))[2]; - next unless defined $mode; - push @bad, $file if ($mode & 04000 and $mode & 00111) - or ($mode & 02000 and $mode & 00111); + for my $file (map { "$ENV{ORACLE_HOME}/bin/$_" } @files) { + my ($mode) = (stat($file))[2]; + next unless defined $mode; + push @bad, $file if ($mode & 04000 and $mode & 00111) + or ($mode & 02000 and $mode & 00111); } return unless @bad; print "\n"; warn "*** WARNING - YOUR ORACLE INSTALLATION HAS A SECURITY PROBLEM.$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; } @@ -2031,11 +2044,11 @@ sub check_macos_symbol_table { return if /^\s+U _(dlsym|dlclose)/; } - warn <<"END_WARNING"; + 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 +required - see DBD::Oracle::Troubleshooting::Macos END_WARNING return; diff --git a/Oracle.h b/Oracle.h index 8713ee40..6c42c2c7 100644 --- a/Oracle.h +++ b/Oracle.h @@ -26,7 +26,7 @@ #endif /* egcs-1.1.2 does not have _int64 */ -#if defined(__MINGW32__) || defined(__CYGWIN32__) +#if defined(__MINGW32__) || defined(__CYGWIN32__) || defined(__CYGWIN__) #define _int64 long long #endif @@ -60,6 +60,9 @@ void dbd_init _((dbistate_t *dbistate)); void dbd_init_oci_drh _((imp_drh_t * imp_drh)); +void dbd_dr_destroy _((SV *drh, imp_drh_t *imp_drh)); +void dbd_dr_globals_init _(()); +void dbd_dr_mng _(()); 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)); @@ -115,12 +118,19 @@ ub4 ora_blob_read_mb_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV * #define ORA_XMLTYPE 108 +/* define some constants from newer OCI versions */ +#ifndef OCI_SPOOL_ATTRVAL_TIMEDWAIT +#define OCI_SPOOL_ATTRVAL_TIMEDWAIT 3 +#endif +#ifndef OCI_SPOOL_ATTRVAL_NOWAIT +#define OCI_SPOOL_ATTRVAL_NOWAIT 1 +#endif /* 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 +most of these are largely undocumented XML functions that are in the API but not defined +not normally 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) diff --git a/Oracle.xs b/Oracle.xs index 84667512..e1dc5d80 100644 --- a/Oracle.xs +++ b/Oracle.xs @@ -29,6 +29,10 @@ constant(name=Nullch) 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 @@ -58,6 +62,7 @@ constant(name=Nullch) 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 @@ -67,6 +72,10 @@ constant(name=Nullch) OCI_DBSHUTDOWN_IMMEDIATE = 3 OCI_DBSHUTDOWN_ABORT = 4 OCI_DBSHUTDOWN_FINAL = 5 + OCI_SPOOL_ATTRVAL_WAIT = OCI_SPOOL_ATTRVAL_WAIT + OCI_SPOOL_ATTRVAL_TIMEDWAIT = OCI_SPOOL_ATTRVAL_TIMEDWAIT + OCI_SPOOL_ATTRVAL_NOWAIT = OCI_SPOOL_ATTRVAL_NOWAIT + OCI_SPOOL_ATTRVAL_FORCEGET = OCI_SPOOL_ATTRVAL_FORCEGET SQLT_CHR = SQLT_CHR SQLT_BIN = SQLT_BIN CODE: @@ -99,7 +108,7 @@ ora_env_var(name) sv_setpv(sv, p); ST(0) = sv; -#ifdef __CYGWIN32__ +#if defined(__CYGWIN32__) || defined(__CYGWIN64__) || defined(__CYGWIN__) void ora_cygwin_set_env(name, value) char * name @@ -109,9 +118,19 @@ ora_cygwin_set_env(name, value) #endif /* __CYGWIN32__ */ +void +ora_shared_release(sv) + SV * sv + CODE: + ora_shared_release(aTHX_ sv); INCLUDE: Oracle.xsi + + +# ------------------------------------------------------------ +# statement interface +# ------------------------------------------------------------ MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st @@ -159,6 +178,8 @@ ora_fetch_scroll(sth,fetch_orient,fetch_offset) 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; } @@ -274,7 +295,9 @@ cancel(sth) - +# ------------------------------------------------------------ +# database level interface +# ------------------------------------------------------------ MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db void @@ -304,9 +327,9 @@ ora_db_startup(dbh, attribs) 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((dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, (dvoid*)str, (ub4)svp_len, (ub4)OCI_ATTR_ADMIN_PFILE, (OCIError*)imp_dbh->errhp, status); + 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->svchp, imp_dbh->errhp, admhp, mode, flags, 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; @@ -314,7 +337,7 @@ ora_db_startup(dbh, attribs) else { ST(0) = &PL_sv_yes; } - if (admhp) OCIHandleFree_log_stat((dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, status); + if (admhp) OCIHandleFree_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, status); #else croak("OCIDBStartup not available"); #endif @@ -337,7 +360,7 @@ ora_db_shutdown(dbh, attribs) mode = OCI_DEFAULT; DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode); admhp = (OCIAdmin*)0; - OCIDBShutdown_log_stat(imp_dbh->svchp, imp_dbh->errhp, admhp, mode, status); + 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; @@ -357,9 +380,13 @@ ora_can_taf(dbh) sword status; ub4 can_taf = 0; CODE: - OCIAttrGet_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL, +#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); } @@ -383,17 +410,28 @@ ora_ping(dbh) /*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*/ + /*so we should stay connected but we cannot get any new connections*/ { -#if !defined(ORA_OCI_102) - OCIServerVersion_log_stat(imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); + /* 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->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); + OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); } else { - OCIPing_log_stat(imp_dbh->svchp,imp_dbh->errhp,status); + OCIPing_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,status); } #endif if (status != OCI_SUCCESS){ @@ -405,12 +443,29 @@ ora_ping(dbh) void -reauthenticate(dbh, uid, pwd) +reauthenticate(dbh, usv, psv) SV * dbh - char * uid - char * pwd + SV * usv + SV * psv CODE: + STRLEN ulen, plen; + char * uid, * pwd; D_imp_dbh(dbh); + + uid = (char*)SvPV(usv, ulen); + pwd = (char*)SvPV(psv, plen); + if(plen == 0 && ulen != 0) + { + char * b = strchr(uid, '/'); + if(b != NULL && b != uid) + { + size_t off = b - uid; + SV * tmp = sv_mortalcopy(usv); + uid = (char *)SvPV(tmp, ulen); + uid[off] = 0; + pwd = uid + off + 1; + } + } ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &PL_sv_yes : &PL_sv_no; void @@ -436,7 +491,7 @@ ora_lob_write(dbh, locator, offset, data) /* 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->envhp, imp_dbh->errhp, locator, &csform, status ); + 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; @@ -444,7 +499,12 @@ ora_lob_write(dbh, locator, offset, data) } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ - OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); + 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; @@ -452,9 +512,9 @@ ora_lob_write(dbh, locator, offset, data) } #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); + csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(imp_dbh, csform); - OCILobWrite_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, + OCILobWrite_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, (ub4)offset, bufp, (ub4)data_len, OCI_ONE_PIECE, NULL, NULL, @@ -492,7 +552,7 @@ ora_lob_append(dbh, locator, data) /* if (1 && SvUTF8(data) && !IN_BYTES) */ /* added by lab: */ /* LAB do something about length here? see above comment */ - OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); + 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; @@ -500,7 +560,12 @@ ora_lob_append(dbh, locator, data) } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ - OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); + 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; @@ -508,8 +573,8 @@ ora_lob_append(dbh, locator, data) } #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->svchp, imp_dbh->errhp, locator, + csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(imp_dbh, 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); @@ -539,39 +604,61 @@ ora_lob_read(dbh, locator, offset, length) 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 */ - 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->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; - } - OCILobRead_log_stat(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); - } - } - } + + 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(imp_dbh, csform)){ + SvUTF8_on(dest_sv); + } + } + } + } /* length > 0 */ + ST(0) = dest_sv; void @@ -583,7 +670,7 @@ ora_lob_trim(dbh, locator, length) D_imp_dbh(dbh); sword status; CODE: - OCILobTrim_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, length, status); + 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; @@ -601,7 +688,7 @@ ora_lob_is_init(dbh, locator) sword status; boolean is_init = 0; CODE: - OCILobLocatorIsInit_log_stat(imp_dbh->envhp,imp_dbh->errhp,locator,&is_init,status); + 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; @@ -619,7 +706,7 @@ ora_lob_length(dbh, locator) sword status; ub4 len = 0; CODE: - OCILobGetLength_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &len, status); + 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; @@ -638,7 +725,7 @@ ora_lob_chunk_size(dbh, locator) sword status; ub4 chunk_size = 0; CODE: - OCILobGetChunkSize_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status); + 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; @@ -648,8 +735,17 @@ ora_lob_chunk_size(dbh, locator) } + +# ------------------------------------------------------------ +# driver level interface +# ------------------------------------------------------------ MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr +void +init_globals() + CODE: + dbd_dr_globals_init(); + void init_oci(drh) SV * drh @@ -657,7 +753,13 @@ init_oci(drh) D_imp_drh(drh); dbd_init_oci(DBIS) ; dbd_init_oci_drh(imp_drh) ; + dbd_dr_mng(); - - - +void +DESTROY(drh) + SV * drh + PPCODE: + /* keep in sync with default DESTROY in DBI.xs (currently there is no dr default) */ + D_imp_drh(drh); + ST(0) = &PL_sv_yes; + dbd_dr_destroy(drh, imp_drh); diff --git a/Oraperl.pm b/Oraperl.pm deleted file mode 100644 index e3796002..00000000 --- a/Oraperl.pm +++ /dev/null @@ -1,881 +0,0 @@ -# Oraperl Emulation Interface for Perl 5 DBD::Oracle DBI -# -# Oraperl.pm -# -# Copyright (c) 1994,1995 Tim Bunce -# -# See the COPYRIGHT section in the Oracle.pm file for terms. -# -# 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.22; -use Exporter; - -$VERSION = substr(q$Revision: 1.44 $, 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, @_) }; - return DBI->connect("dbi:Oracle:$system_id", $name, $password, { - PrintError => 0, AutoCommit => 0 - }); -} -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 -*Oraperl::ora_errno = \$DBI::err; -*Oraperl::ora_errstr = \$DBI::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 - [DEPRECATED] 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 -(a database driver what operates within L) and adds an extra layer over -L 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 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 . Any comments -specific to the DBD::Oracle Oraperl emulation are prefixed by B. -See the DBD::Oracle and DBI manuals for more information. - -B 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> 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; - - -The use of I is deprecated in favor of L, -and will be removed from the I distribution as of -1.38. - -=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 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 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 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 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 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 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 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 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 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 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 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 AUTHOR - -Original Oraperl 2.4 code and documentation -by Kevin Stock . - -DBI and Oraperl emulation using DBD::Oracle by Tim Bunce. - -=head1 MAINTAINER - -As of DBD::Oracle release 1.17 in February 2006 The Pythian Group, Inc. -(L) are taking the lead in maintaining DBD::Oracle with -my assistance and gratitude. - -=head1 COPYRIGHT - -Copyright (c) 1994-2006 Tim Bunce. Ireland. -Copyright (c) 2006-2008 John Scoles (The Pythian Group). 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. - -=cut diff --git a/README b/README index fd2b28aa..8b4d7b9e 100644 --- a/README +++ b/README @@ -1,31 +1,32 @@ DBD::Oracle -- an Oracle interface for Perl 5. - Copyright (c) 1994-2006 Tim Bunce, Ireland. + Copyright (c) 1994-2025 Tim Bunce, et. al. See the COPYRIGHT section in the Oracle.pm file for terms. See also the MAINTAINER section in the Oracle.pm PLEASE READ THE ENTIRE README FILE CAREFULLY ! - AND THEN READ ANY README.* FILES RELEVANT TO YOUR PLATFORM: + AND THEN READ ANY TROUBLESHOOTING POD FILES RELEVANT TO YOUR PLATFORM: - README.aix.txt - AIX - README.hpux.txt - HP-UX - README.java.txt - Java/thread problem on Solaris - README.macosx.txt - Mac OS/X - README.win32.txt - MS Windows - README.wingcc.txt - MS Windows using GCC - README.* - see if there's a file for your platform + DBD::Oracle::Troubleshooting - General Tips + DBD::Oracle::Troubleshooting::Aix - AIX + DBD::Oracle::Troubleshooting::Cygwin - MS Windows using GCC + DBD::Oracle::Troubleshooting::Hpux - HP-UX + DBD::Oracle::Troubleshooting::Linux - Linux + DBD::Oracle::Troubleshooting::Macos - Mac OS + DBD::Oracle::Troubleshooting::Sun - Sun + DBD::Oracle::Troubleshooting::Vms - OpenVMS + DBD::Oracle::Troubleshooting::Win32 - MS Windows (32bit) + DBD::Oracle::Troubleshooting::Win64 - MS Windows (64bit) + DBD::Oracle::Troubleshooting::* - see if there's a file for your platform - You may find these useful + DBD::Oracle::Troubleshooting::java.txt - Java/thread problem on Solaris - README.help.txt - Help and hints on build problems - README.sec.txt - Oracle security issues to be aware of - README.login.txt - Help on how to connect to Oracle - README.longs.txt - Help on handling LONGs - README.clients.txt - What Oracle client files you need installed + You may find these useful + README.help.txt - Help and hints on build problems *** QUICK START GUIDE: @@ -43,7 +44,7 @@ DBD::Oracle -- an Oracle interface for Perl 5. Build, test and install Perl 5 (at least 5.6.1) It is very important to TEST it and INSTALL it! - Build, test and install the DBI module (at least DBI 1.51). + Build, test and install the DBI module (at least DBI 1.623). It is very important to TEST it and INSTALL it! Remember to *read* the DBI README file and this one CAREFULLY! @@ -57,12 +58,14 @@ DBD::Oracle -- an Oracle interface for Perl 5. your configuration and DBD::Oracle determine your Oracle version. For full Oracle installs: that usually includes Pro*C and SQL*Net. - (That's not very specific because it varies between Oracle releases.). + (That's not very specific because it varies between Oracle releases.). As of release 1.22 support of Oracle clients before 9 was dropped. - The main reason for this is that next few versions of DBD::Oracle will introduce a number of new features - whicht will required a great deal of extra coding to make the OCI 8 work. - As well it is getting harder to find an Oracle client 8 to test against as well - Oracle no longer supports clients before 9. + The main reason for this is that next few versions of DBD::Oracle will + introduce a number of new features which will required a great deal of extra + coding to make the OCI 8 work. + + As well it is getting harder to find an Oracle client 8 to test against as + well Oracle no longer supports clients before 9. The ORACLE_HOME environment variable must point to the Oracle Home used to create DBD::Oracle. (Not essential under MS Windows). @@ -109,12 +112,12 @@ See the oracle_test_dsn() sub in t/nchar_test_lib.pl The supplied tests will connect to the database using the value of the ORACLE_USERID environment variable to supply the username/password. So you should set that to a valid user (e.g. 'scott/tiger') and ensure that -this user has sufficient privileges to create, insert into, select from and -drop a table, is also able to create, call and drop a procedure and is able to select from -systemtables like 'v$sessions'. Using 'system/manager' might work but is not -recommended! See also +this user has sufficient privileges to create, insert into, select from and +drop a table, is also able to create, call and drop a procedure and is able +to select from systemtables like 'v$sessions'. Using 'system/manager' might +work but is not recommended! See also README.login.txt and TESTING.md. -README.login.txt. +Run tests with: make test @@ -136,9 +139,9 @@ It's also important to use the same compiler that was used to build the Perl you are using. If you have build/link or core dump problems try: - perl Makefile.PL -p + perl Makefile.PL -p or - perl Makefile.PL -nob + 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). @@ -178,7 +181,7 @@ Please do NOT post problems to comp.lang.perl.*, perl5-porters@perl.org, http://www.cpanforum.com/dist/DBD-Oracle, or google groups etc. If you're *sure* the problem is a bug then you can post a bug report -to http://rt.cpan.org/Public/Dist/Display.html?Name=DBD-Oracle +to https://github.com/perl5-dbi/DBD-Oracle/issues Problem reports that don't include sufficient detail (including the information listed below and how to reproduce the problem) are unlikely to get resolved. @@ -224,7 +227,7 @@ dbi-users@perl.org. 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 + 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 @@ -252,47 +255,18 @@ directly - use the dbi-users mailing list. Regards, Tim. -=============================================================================== +================================================================================ Examples and other info: README.help.txt -- READ IT FIRST IF YOU HAVE ANY PROBLEMS -README.win32.txt -- building DBD::Oracle under MS Windows -README.wingcc.txt -- building DBD::Oracle under MS Windows with gcc -README.macosx.txt -- building DBD::Oracle under MacOS X -README.clients.txt -- building/using DBD::Oracle on minimally configured systems -README.login.txt -- help for login problems -README.longs.txt -- examples dealing with LONG types (blobs) +DBD::Oracle::Troubleshooting::* -- Various platform specific info 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/ - -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 - -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.txt file for lots of hints and advice about building and runtime issues. diff --git a/README-files/hpux/Makefile-Lincoln b/README-files/hpux/Makefile-Lincoln deleted file mode 100644 index 0565def4..00000000 --- a/README-files/hpux/Makefile-Lincoln +++ /dev/null @@ -1,223 +0,0 @@ -# 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 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=\"" ;\ - exit 1; \ - else \ - echo ORACLE_HOME=$(ORACLE_HOME); \ - fi - @if test -z "$$ORACLE_USERID" ; \ - then \ - echo " Please set \"export ORACLE_USERID=\"" ;\ - 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 diff --git a/README.64bit.txt b/README.64bit.txt deleted file mode 100644 index 9d3ebe0f..00000000 --- a/README.64bit.txt +++ /dev/null @@ -1,272 +0,0 @@ -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 -------- - -Subject: Building 32bit DBD::Oracle against 64bit Oracle -From: Dennis Reso -Date: 7/9/2008 5:44 PM -Priority: Normal - -Building DBD::Oracle v1.21 against Perl 5.8.5 Oracle 9.2.0.4 Solaris 8 - -Got the dreaded "wrong ELF class" when the Oracle.so ends up built -against the 64bit library instead of the one in $ORACLE_HOME/lib32. -Use 'dump -vL Oracle.so' to see the internalized RPATH definition. - -Tried the following solution, widely posted, without success: - - perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/demo_rdbms32.mk - -What worked for me (pass the LIBDIR to the Oracle make process): - - export ORACLE_HOME=/apps/Oracle9.2.0.4 - export LD_LIBRARY_PATH=$ORACLE_HOME/lib32 - perl -pi -e 's/CC=true/CC=true LIBDIR=lib32/' Makefile.PL - perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/demo_rdbms32.mk - make - -The LIBDIR= is defined in $ORACLE_HOME/rdbms/lib/env_rdbms.mk which -also includes a REDEFINES32= that overrides it, but is only used by -the $ORACLE_HOME/rdbms/lib/ins_rdbms.mk. Oracle bug? - -Also repeated the same failure and success with - Oracle 9.2.0.8 Solaris 10 - Oracle 10.2.0.3 Solaris 10 - -Seems fixed in demo_rdbms32.mk (no Makefile.PL edit needed ) as of - Oracle 10.2.0.4 Solaris 10 - -Probably also fixed in some patchset newer than 9.2.0.4. - --- -Dennis Reso - --------- Original Message -------- - -Subject: DBD::Oracle 64-bit success story -From: H.Merijn Brand -Date: On Mon, 14 Apr 2008 09:48:41 -Priority: Normal - -I finally got round trying Oracle Instant Client on Linux with no -Oracle installed, connecting to a 64bit Oracle 9.2.0.8 on HP-UX -11.11/64. I had to do some fiddling with Makefile.PL (see bottom). -Sorry for this being long. Feel free to mold it into anything useful. - -1. Before you start on DBD::Oracle, make sure DBD::ODBC works. That will - assure your DSN works. Install unixODBC before anything else. - -2. Assuming you've got OIC from the rpm's, you will have it here: - - /usr/include/oracle/11.1.0.1/client - /usr/lib/oracle/11.1.0.1/client - /usr/share/oracle/11.1.0.1/client - - -3. for the 64 bit clienat we have these rpm - oracle-instantclient-basic-11.1.0.1-1.x86_64.rpm - oracle-instantclient-devel-11.1.0.1-1.x86_64.rpm - oracle-instantclient-jdbc-11.1.0.1-1.x86_64.rpm - oracle-instantclient-odbc-11.1.0.1-1.x86_64.rpm - oracle-instantclient-sqlplus-11.1.0.1-1.x86_64.rpm - - and to add to the confusement, they install to - - /usr/include/oracle/11.1.0.1/client64 - /usr/lib/oracle/11.1.0.1/client64 - /usr/share/oracle/11.1.0.1/client64 - -4. To make DBD::ODBC work, I had to create a tnsnames.ora, and I chose - - /usr/lib/oracle/11.1.0.1/admin/tnsnames.ora - - /usr/lib/oracle/11.1.0.1/admin > cat sqlnet.ora - NAMES.DIRECTORY_PATH = (TNSNAMES, ONAMES, HOSTNAME) - /usr/lib/oracle/11.1.0.1/admin > cat tnsnames.ora - ODBCO = ( - DESCRIPTION = - ( ADDRESS_LIST = - ( ADDRESS = - ( PROTOCOL = TCP ) - ( PORT = 1521 ) - ( HOST = rhost ) - ) - ) - ( CONNECT_DATA = - ( SERVICE_NAME = odbctest ) - ) - ) - /usr/lib/oracle/11.1.0.1/admin > - - Real world example changed to hide the obvious. Important bits are - "ODBCO", which is the ODBC name, and it can be anything, as long as - you use this in ORACLE_DSN too (please don't use whitespace, colons, - semicolons and/or slashes. "rhost" is the hostname of where the DB - is running, and "odbctest" is available on "rhost". To check that, - run "lsnrctl services" on "rhost". - Set the environment (TWO_TASK is not needed) - - > setenv LD_LIBRARY_PATH /usr/lib/oracle/11.1.0.1/client/lib - > setenv TNS_ADMIN /usr/lib/oracle/11.1.0.1/admin - > setenv ORACLE_HOME /usr/lib/oracle/11.1.0.1/client - > setenv ORACLE_DSN dbi:Oracle:ODBCO - > setenv ORACLE_USERID ORAUSER/ORAPASS - - Check if the connection works: - > isql -v ODBCO - - And for Oracle: - > sqlplus ORAUSER/ORAPASS@ODBCO - and - > sqlplus ORAUSER/ORAPASS@rhost/odbctest - - should both work - - -Note by JPS: - -Merijn patched the trunk version of Makeifle.PL to account for the above it will be in release 1.22 - --------- Original Message -------- - -Subject: DBD::Oracle 64-bit success story -From: "QiangLi" -Date: Thu, March 6, 2008 5:25 pm -To: pause@pythian.com -Priority: Normal - -hi, - -thanks for maintaining DBD::Oracle. I have installed DBD::Oracle against - 64-bit oracle 10g on a 64-bit solaris machine. maybe worth another -entry for the README.64bit.txt file. - -i am using gcc from sun freesoftware and also SUNWbinutils which -contains the gas (gnu assembler) - -here is the steps with comment: - -# set install target -% /usr/perl5/5.8.4/bin/perlgcc Makefile.PL PREFIX=/var/tmp/lib - -# since our perl is 32-bit, we can't build it against a 64bit oracle -install. -# edit Makefile and change reference to oracle's "lib/" to "lib32/" -% perl -pi -e 's/oracle_home\/lib/oracle_home\/lib32/g' Makefile -% perl -pi -e 's/oracle_home\/rdbms\/lib/oracle_home\/rdbms\/lib32/g' -Makefile - -% make - -# ignore error like ORA-12162: TNS:net service name is incorrectly -specified... -% make test - -% make install - -# does it work. -% perl -I'/var/tmp/lib/lib/site_perl/5.8.4/sun4-solaris-64int/' --MDBD::Oracle -e1 - -cheers, - -Qiang - - - - --------- Original Message -------- -Subject: Tip: Compiling 32bit modules against 64bit Oracle 10g on solaris -Date: Thu, 1 Nov 2007 16:41:28 -0400 -From: Edgecombe, Jason -To: -CC: - - - -Hi There, - -I just wanted to thank both of you. - -The tip from cartmanltd@hotmail.com was the trick for getting -DBD::Oracle compiled in 32bit format against the Oracle 10g client on -solaris. - -Here was the command that worked: - perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/demo_rdbms32.mk - -Even though the tip was for aix, it fixed my build issue on solaris 9 -(sparc) - -I've been banging my head on this problem for a few days. - -Thanks, -Jason - -Jason Edgecombe -Solaris & Linux Administrator -Mosaic Computing Group, College of Engineering -UNC-Charlotte -Phone: (704) 687-3514 - - - -Source:Tom Reinertson -Platform:Amd64 -OS:Gentoo-amd64 - -The following instructions work for dbd::oracle 1.19 on a gentoo-amd64 installation. - -1) install the oracle libraries - - Strictly speaking you only need dev-db/oracle-instantclient-basic - for dbd::oracle, but i always like to have sql*plus lying around, - which requires the basic package, so i just install sql*plus. - - emerge dev-db/oracle-instantclient-sqlplus which also pulls in - dev-db/oracle-instantclient-basic. these packages are fetch - restricted so you will be required to follow the download instructions. - following these instructions, you should have retrieved these packages: - - instantclient-basic-linux-x86-64-10.2.0.3-20070103.zip - instantclient-sdk-linux-x86-64-10.2.0.3-20070103.zip - instantclient-sqlplus-linux-x86-64-10.2.0.3-20070103.zip - - now move them into the /usr/portage/distfiles directory. - - you should now be able to emerge dev-db/oracle-instantclient-sqlplus. - -2) install DBD::Oracle - - issue the command: - - perl -MCPAN -e'install DBD::Oracle' - - this fails with the following error: - - x86_64-pc-linux-gnu-gcc: unrecognized option '-wchar-stdc++' - x86_64-pc-linux-gnu-gcc: unrecognized option '-cxxlib-gcc' - cc1: error: /ee/dev/bastring.h: No such file or directory - - find the offending files in your cpan directory: - {~/.cpan/build/DBD-Oracle-1.19} grep -lr cxxlib * - Makefile - blib/arch/auto/DBD/Oracle/mk.pm - mk.pm - - edit these files and remove the two invalid options and the include of bastring.h. - - now build the module: - - perl Makefile.PL -l - make - # make test generates lots of errors - make test - make install - - you should now be ready to run. - - diff --git a/README.aix.txt b/README.aix.txt deleted file mode 100644 index a83bf144..00000000 --- a/README.aix.txt +++ /dev/null @@ -1,255 +0,0 @@ - -DBD::Oracle AIX-specific README - - -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 -paulhill20@copper.net - - - -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 -peril99@yahoo.com - - - - -Using xlc_r C Compiler -====================================================================================== --------------------------------------------------------------------------------------- -From: Rafael Caceres -Date: 22 Jul 2003 10:05:20 -0500 -Message-Id: <1058886321.1066.13.camel@rcaceres.aasa.com.pe> - -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 - -On Tue, 2003-07-22 at 08:12, mpaladino@invacare.com wrote: -> -> I dont 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 probobly 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: - -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 editting 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 -======================= -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. - --------------------------------------------------------------------------------------- diff --git a/README.clients.txt b/README.clients.txt deleted file mode 100644 index 274ca435..00000000 --- a/README.clients.txt +++ /dev/null @@ -1,279 +0,0 @@ -This file contains some random notes relating to minimal Oracle -configurations for building and/or using DBD::Oracle / Oraperl. - - -*** ALL THE TEXT BELOW IS OLD *** -*** THE PREFERED METHOD IS TO USE Oracle Instant Client *** - - -------------------------------------------------------------------------------- -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 - -> [...], 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 - -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 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 -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 - > [...], 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 - -------------------------------------------------------------------------------- -Subject: Re: Oracle Licencing... -Date: Thu, 15 May 1997 11:54:09 -0700 -From: Mark Dedlow - -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 - -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 - -------------------------------------------------------------------------------- diff --git a/README.help.txt b/README.help.txt index cfbe9932..ec4b4c21 100644 --- a/README.help.txt +++ b/README.help.txt @@ -7,141 +7,15 @@ 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. -------------------------------------------------------------------------------- -Error: 'UV' not in typemap in Oracle.xs, line ... - -You're using Perl 5.5.3. 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. - -Meanwhile, edit Oracle.xs and change each UV to an IV, change newSVuv to newSViv, -cross your fingers, and avoid using longer, bigger, wider than 2GB, or less than zero! -This is a hacked DBD::Oracle and not recommended for production use. - -------------------------------------------------------------------------------- -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) - -If you find a memory leak that you can isolate to DBD::Oracle, and you're -using a perl built with threading enabled, first try rebuilding perl without -support for threads. Apart from making perl run faster it may also fix the leak. -Please report memory leaks, with a small self-contained test script, -to dbi-users@perl.org. - -------------------------------------------------------------------------------- -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: - -Dave Moellenhoff : 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 $ORACLE_HOME/lib. If it's missing, try -running $ORACLE_HOME/lib/genclntsh.sh and it should create it. - -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 : 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 : 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 for this information. ------------------------------------------------------------------------------- AIX 4 - core dump on login and similar problems -set - cc='xlc_r' +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 +set environment + ORACCENV='cc=xlc_r'; export ORACCENV to enforce this in oraxlc Thanks to Goran Thyni for this information. @@ -202,11 +76,11 @@ 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 + 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 @@ -282,7 +156,7 @@ 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 : -Run, dont walk, to your console and 'mv /opt/gnu/bin/as /opt/gnu/bin/gas; +Run, don't 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. @@ -370,19 +244,12 @@ 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 + 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: diff --git a/README.java.txt b/README.java.txt deleted file mode 100644 index 8958df27..00000000 --- a/README.java.txt +++ /dev/null @@ -1,322 +0,0 @@ -README.java.txt - -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 - -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 - -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 - -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 - diff --git a/README.sec.txt b/README.sec.txt deleted file mode 100644 index 72920db6..00000000 --- a/README.sec.txt +++ /dev/null @@ -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 ----- - -Date: Fri, 7 May 1999 06:29:09 -0700 -From: Oracle Support Services -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 - -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 -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 - -> 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." -> :) - ------------------------------------------------------------------------------- diff --git a/README.win32.txt b/README.win32.txt deleted file mode 100644 index e3ad66db..00000000 --- a/README.win32.txt +++ /dev/null @@ -1,236 +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 however only version 1.17 is available there. - -If you built Perl with gcc, read README.wingcc.txt as well as this file. - - -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. - - ---- other information, some of which is out of date --- - -DBD-Oracle for Windows and Oracle Instantclient and 10XE (Express Edition) -By: John Scoles Scoles@ptyhian.com -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 - -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 explicitely. -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. diff --git a/TESTING.md b/TESTING.md new file mode 100644 index 00000000..a27efc5e --- /dev/null +++ b/TESTING.md @@ -0,0 +1,64 @@ +# Variables used in tests + +**Connecting to Oracle** + +`ORACLE_USERID` - important + +Which user & password to use when running tests against a real Oracle database + +Should be 'user/password' or a longer string with connection details. + +``` bash +$ export ORACLE_USERID='scott/tiger' +``` + +`ORACLE_USERID_2` + +Provides a second set of user credentials when needed + +`ORACLE_DSN` + +DSN details when connecting to real Oracle for tests + +``` bash +$ export ORACLE_DSN='dbi:Oracle:testdb' +``` + +`DBI_DSN` + +If `ORACLE_DSN` is not provided, this will be used. Otherwise falls back to internal default. + +**Creation of tables, views, functions etc** + +`DBD_ORACLE_SEQ` - important + +Appended to table, view, function (etc) that are created during testing to help +prevent collisions + +`DBD_SKIP_TABLE_DROP` + +Skips dropping temporary tables when tests complete. Use to examine the mess after failed tests. + +**Other** + +`NLS_DATE_FORMAT` + +Sets the date format as normal + +# Test all script + +The mkta.pl script might be useful as for testing against multiple DB's quickly + +# Vars that need more detail + +`NLS_NCHAR` + +`NLS_LANG` + +??? + +`DBI_USER` + +`DBI_PASS` + +`DBD_ALL_TESTS` - Forces some tests to run, that otherwise wouldn't diff --git a/Todo b/TODO similarity index 86% rename from Todo rename to TODO index bdd90060..be51a193 100644 --- a/Todo +++ b/TODO @@ -1,37 +1,39 @@ [ In no particular order ] -**************************** NOTE: ora_db_shutdown/ora_dv_startup/StrictlyType/DiscardString not documented +**************************** + +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... - +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.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 + +--> done 1.22 Drop support for Oracle 8 and earlier add support for $dbh->trace('SQL'); -Replace OCIInitialize + OCIEnvInit, with OCIEnvCreate - +--> done 1.76(or earlier) Replace OCIInitialize + OCIEnvInit, with OCIEnvNlsCreate + (found this way in 1.90 during review of SEGV investigation, seen it in as early as 1.76) + --> 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 +--> 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 @@ -50,8 +52,6 @@ LOBs http://www.csis.gvsu.edu/GeneralInfo/Oracle/appdev.920/a96595/dci06mlt.htm 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. diff --git a/dbdcnx.c b/dbdcnx.c new file mode 100644 index 00000000..beabc2f0 --- /dev/null +++ b/dbdcnx.c @@ -0,0 +1,1162 @@ +/* notes {{{ + * This module attempts to provide reuse of OCIEnv + * and storage for session pool(s). + * + * Note, configuration uses acronym "drcp", which is + * somewhat misleading. DRCP stands for "connection pooling" + * and DBD::Oracle offers "session pooling", which is + * not "connection pooling" (that is also offered by Oracle). + * + * To make things complex DBD::Oracle offers 2 ways to + * share connections between threads. Such sharing + * requires that one thread does not use pointers + * to data allocated in another thread. In perl, + * each thread gets copy of perl interpreter, and each + * thread has its own heap for memory allocation. + * When the thread ends, that memory may get released, + * which leads to problems if the memory is referenced + * from another thread. + * + * It appears, that OCI uses itsown memory pool for + * allocation, so the data allocated in one thread + * is still accessible in another thread. At least + * tests don't fail in such cases. There are + * also OCI internal mutexes that protect access to + * that memory. The good news, one may ask OCI to allocate + * some memory for the caller. That is what this + * module is using. + * + * When OCIEnv is created, it uses 3 parameters + * that define the functionality of new OCIEnv. + * Those are: mode, charset and ncharset. So, when + * we need some OCIEnv we have to check for existing + * ones that have matching parameters. If charset + * or ncharset is 0, then current value from environment + * is used (OCINlsEnvironmentVariableGet) + * + * The session pool is identified (in addition to + * charsets and mode for OCIEnv) by dbname, user + * and "rlb" (activity of load-balancer). Since all + * sessions are "homogenous", Oracle won't check + * password when new session is requested. So probably + * it makes sense to check it here. So password + * is also saved. + * + * This module does not use HV to find cached + * handles because HV may need to allocate memory + * from current thread, and that is not good. Still + * it is very unlikely that someone uses thousands + * of different pools/characters, so simple + * running through doubly-linked list should be + * fast enough (and maybe even faster) than hashing. + * + * Now, how long shall be cached all handles? As long + * as there are users. Each open connection is a user. + * Additionally every "driver"-object is a user. + * The driver-object is allocated in each thread + * that tries to connect to DB and is released when + * thread ends. + }}} */ +#include "Oracle.h" + +DBISTATE_DECLARE; + +typedef struct llist_t llist_t; +/* small implementation for doubly-linked list {{{ */ +struct llist_t { + llist_t * left; + llist_t * right; +}; + +#define llist_empty(list) ((list)->left == (list)) + +#define llist_init(lst) do{\ + llist_t * list = lst;\ + list->right = list->left = list;\ +}while(0) + +#define llist_is_initialized(list) ((list)->left != NULL) + +#define llist_add(aleft, aright) do{\ + llist_t * old;\ + llist_t * left = aleft;\ + llist_t * right = aright;\ + old = left->right;\ + left->right = right;\ + old->left = right->left;\ + right->left = left;\ + old->left->right = old;\ +}while(0) + +#define llist_drop(ael) do{\ + llist_t * el = ael;\ + if(!llist_empty(el)) {\ + el->left->right = el->right;\ + el->right->left = el->left;\ + llist_init(el);\ + } \ +}while(0) + +#define llist_size(list) ({\ + llist_t * base = list;\ + int size = 0;\ + while(base->left != list) {\ + size++;\ + base = base->left;\ + }\ + size;\ +}) + +// this is pointer to the left element in chain +#define llist_left(list) (list)->left + +// this one is a pointer to the right element in chain +#define llist_right(list) (list)->right +/* }}} */ + +#if defined(USE_ITHREADS) +static perl_mutex mng_lock; +#endif +static llist_t mng_list; +static int dr_instances; +/* to get information about charsets we need these */ +static OCIEnv * mng_env; +static OCIError * mng_err; + +/*dbd_dr_globals_init{{{*/ +void +dbd_dr_globals_init() +{ +#if defined(USE_ITHREADS) + dTHX; + MUTEX_INIT(&mng_lock); +#endif + // Ancient-Wizard: + // I believe this list, being static, was intented to be shared by all threads! + // Additional comments in the code suggest this as well. + // However as it was written every thread was nuking the setup of the last + // startng with a fresh empty list. Smells like a memory leak at best + // and a crash at worst. We received both. + if ( llist_is_initialized(&mng_list) ) return; + + llist_init(&mng_list); + dr_instances = 0; + mng_env = NULL; + mng_err = NULL; +} +/*}}}*/ + +struct box_st { + llist_t lock; + int refs; /* this shall be positive for OCIEnv and negativ for Session Pool */ +}; + +struct env_box_st +{ + box_t base; + OCIEnv * envhp; + ub4 mode; + ub2 cset; + ub2 ncset; +}; +typedef struct env_box_st env_box_t; + +#ifdef ORA_OCI_112 +struct pool_box_st{ + box_t base; + env_box_t * env; + OCISPool *poolhp; + OCIError *errhp; + OraText *name; + ub4 name_len; + ub2 pass_len; + ub2 dbname_len; + /* all text strings are stored below. The buffer + * is long enough to contain dbname_len+user_len+pass_len + 4 bytes. + * So pass is box->buf + 1; + * dbname is box->buf + 2 + box->pass_len + * user is box->buf + 3 + box->dbname_len + box->pass_len + * First byte is 0 if RLB is not desired. + */ + char buf[1]; +}; +typedef struct pool_box_st pool_box_t; +#endif + +#define tracer(imp, dlvl, vlvl, ...) if \ + (DBIc_DBISTATE(imp)->debug >= (dlvl) || dbd_verbose >= (vlvl) )\ + PerlIO_printf(DBIc_LOGPIO(imp), __VA_ARGS__) + +/* local_error{{{*/ +static int +local_error(pTHX_ SV * h, const char * fmt, ...) +{ + va_list ap; + SV * txt_sv = sv_newmortal(); + SV * code_sv = get_sv("DBI::stderr", 0); + D_imp_xxh(h); + if(code_sv == NULL) + { + code_sv = sv_newmortal(); + sv_setiv(code_sv, 2000000000); + } + va_start(ap, fmt); + sv_vsetpvf(txt_sv, fmt, &ap); + va_end(ap); + DBIh_SET_ERR_SV(h, imp_xxh, code_sv, txt_sv, &PL_sv_undef, &PL_sv_undef); + return FALSE; +} +/*}}}*/ +/* release_env{{{*/ +static void +release_env(pTHX_ env_box_t * box) +{ + llist_drop(&box->base.lock); + if(dbd_verbose >= 3) + warn("Releasing OCIEnv %p\n", box->envhp); + (void)OCIHandleFree(box->envhp, OCI_HTYPE_ENV); +}/*}}}*/ + +/* new_envhp_box{{{*/ +static int +new_envhp_box(pTHX_ env_box_t ** slot, dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + env_box_t * box; + OCIEnv * envhp; + sword status = OCIEnvNlsCreate( + &envhp, ctrl->mode, + 0, NULL, NULL, NULL, + sizeof(*box), (dvoid**)&box, + imp_dbh->cset, imp_dbh->ncset + ); + if (status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCIEnv"); + tracer(imp_dbh, 3, 3, "allocated new OCIEnv %p (cset %d, ncset %d, mode %d)\n", + envhp, (int)imp_dbh->cset, (int)imp_dbh->ncset, (int)ctrl->mode); + llist_init(&box->base.lock); + box->envhp = envhp; + box->base.refs = dr_instances; + box->cset = imp_dbh->cset; + box->ncset = imp_dbh->ncset; + box->mode = ctrl->mode; + llist_add(&mng_list, &box->base.lock); + *slot = box; + return TRUE; +}/*}}}*/ +/* figure_out_charsets {{{*/ +static int +figure_out_charsets(pTHX_ dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + if(ctrl->cset != NULL) + { + imp_dbh->cset = OCINlsCharSetNameToId( + mng_env, (OraText*)ctrl->cset + ); + if(imp_dbh->cset == 0) return local_error( + aTHX_ ctrl->dbh, "Invalid ora_charset '%s'", ctrl->cset + ); + } + else if(imp_dbh->cset == 0) + { + size_t rsize; + sword status = OCINlsEnvironmentVariableGet( + &imp_dbh->cset, 0, OCI_NLS_CHARSET_ID, 0, &rsize + ); + if(status != OCI_SUCCESS || imp_dbh->cset == 0) + return local_error(aTHX_ ctrl->dbh, "NLS_LANG appears to be invalid"); + } + if(ctrl->ncset != NULL) + { + imp_dbh->ncset = OCINlsCharSetNameToId( + mng_env, (OraText*)ctrl->ncset + ); + if(imp_dbh->ncset == 0) return local_error( + aTHX_ ctrl->dbh, "Invalid ora_ncharset '%s'", ctrl->ncset + ); + } + else if(imp_dbh->ncset == 0) + { + size_t rsize; + sword status = OCINlsEnvironmentVariableGet( + &imp_dbh->ncset, 0, OCI_NLS_NCHARSET_ID, 0, &rsize + ); + if(status != OCI_SUCCESS || imp_dbh->ncset == 0) + return local_error(aTHX_ ctrl->dbh, "NLS_NCHAR appears to be invalid"); + } + + return TRUE; +}/*}}}*/ +/*find_env{{{*/ +static env_box_t * +find_env(ub4 mode, ub2 cset, ub2 ncset) +{ + llist_t * base = llist_left(&mng_list); + while(base != &mng_list) + { + env_box_t * box = (env_box_t *)base; + if(box->base.refs > 0 + && box->mode == mode + && box->ncset == ncset + && box->cset == cset + ) + { + /* check if this handle is still valid */ + if(box->base.refs == dr_instances) + { + OCIError *errhp; + sword status=OCIHandleAlloc( + box->envhp, + (dvoid**)&errhp, + OCI_HTYPE_ERROR, 0, NULL + ); + if(status != OCI_SUCCESS) + { + llist_drop(base); + OCIHandleFree(box->envhp, OCI_HTYPE_ENV); + return NULL; + } + } + return box; + } + base = llist_left(base); + } + return NULL; +} +/*}}}*/ +/* simple_connect {{{*/ +static int +simple_connect(pTHX_ dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + sword status; + ub4 ulen, plen, ctype; + + tracer(imp_dbh, 3, 3, "using OCIEnv envhp:%p to connect\n", imp_dbh->envhp); + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &imp_dbh->errhp, + OCI_HTYPE_ERROR, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCIError\n"); + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &imp_dbh->srvhp, + OCI_HTYPE_SERVER, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCIServer\n"); + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &imp_dbh->svchp, + OCI_HTYPE_SVCCTX, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCISvcCtx\n"); + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &imp_dbh->seshp, + OCI_HTYPE_SESSION, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCISession\n"); + + OCIServerAttach_log_stat(imp_dbh, ctrl->dbname,OCI_DEFAULT, status); + if (status != OCI_SUCCESS) + return oci_error(ctrl->dbh, imp_dbh->errhp, status, "OCIServerAttach"); + + OCIAttrSet_log_stat( + imp_dbh, imp_dbh->svchp, + OCI_HTYPE_SVCCTX, + imp_dbh->srvhp, + (ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) return oci_error( + ctrl->dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_HTYPE_SVCCTX" + ); + plen = (ub4)strlen(ctrl->pwd); + ulen = (ub4)strlen(ctrl->uid); + if(plen == 0 && ulen == 0) ctype = OCI_CRED_EXT; + else + { + ctype = OCI_CRED_RDBMS; + OCIAttrSet_log_stat( + imp_dbh, imp_dbh->seshp, + OCI_HTYPE_SESSION, + ctrl->uid, ulen, + (ub4) OCI_ATTR_USERNAME, + imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) return oci_error( + ctrl->dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_USERNAME" + ); + + OCIAttrSet_log_stat( + imp_dbh, imp_dbh->seshp, + OCI_HTYPE_SESSION, + ((plen) ? ctrl->pwd : NULL), plen, + (ub4) OCI_ATTR_PASSWORD, + imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) return oci_error( + ctrl->dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_PASSWORD" + ); + } +#ifdef ORA_OCI_112 + if(ctrl->driver_name_len != 0) + { + OCIAttrSet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, + ctrl->driver_name, ctrl->driver_name_len, + OCI_ATTR_DRIVER_NAME, + imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) return oci_error( + ctrl->dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_DRIVER_NAME" + ); + } +#endif + + OCISessionBegin_log_stat( + imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, + ctype, ctrl->session_mode, status + ); + if (status == OCI_SUCCESS_WITH_INFO) + { + /* eg ORA-28011: the account will expire soon; change your password now */ + oci_error(ctrl->dbh, imp_dbh->errhp, status, "OCISessionBegin"); + status = OCI_SUCCESS; + } + if (status != OCI_SUCCESS) + return oci_error(ctrl->dbh, imp_dbh->errhp, status, "OCISessionBegin"); + + 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 + ); + if (status != OCI_SUCCESS) return oci_error( + ctrl->dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_SESSION" + ); + return TRUE; +}/*}}}*/ +#ifdef ORA_OCI_112 +/*release_pool{{{*/ +static void +release_pool(pTHX_ pool_box_t * box) +{ + env_box_t * ebox; + if(dbd_verbose >= 3) + warn("Releasing pool %p\n", box->poolhp); + + ebox = box->env; + llist_drop(&box->base.lock); + (void)OCISessionPoolDestroy (box->poolhp, box->errhp, OCI_DEFAULT); + (void)OCIHandleFree(box->poolhp, OCI_HTYPE_SPOOL); + ebox->base.refs--; + if(ebox->base.refs == 0) release_env(aTHX_ ebox); +}/*}}}*/ +/*cnx_pool_min{{{*/ +void +cnx_pool_min(pTHX_ SV * dbh, imp_dbh_t * imp_dbh, ub4 val) +{ + pool_box_t * box; + sword status; + if(imp_dbh->lock->refs > 0) return; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrSet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&val, sizeof(val), + OCI_ATTR_SPOOL_MIN, box->errhp + ); + if(status != OCI_SUCCESS) + (void)oci_error(dbh, box->errhp, status, "OCIAttrSet POOL_MIN"); +}/*}}}*/ +/*cnx_pool_max{{{*/ +void +cnx_pool_max(pTHX_ SV * dbh, imp_dbh_t * imp_dbh, ub4 val) +{ + pool_box_t * box; + sword status; + if(imp_dbh->lock->refs > 0) return; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrSet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&val, sizeof(val), + OCI_ATTR_SPOOL_MAX, box->errhp + ); + if(status != OCI_SUCCESS) + (void)oci_error(dbh, box->errhp, status, "OCIAttrSet POOL_MAX"); +}/*}}}*/ +/*cnx_pool_incr{{{*/ +void +cnx_pool_incr(pTHX_ SV * dbh, imp_dbh_t * imp_dbh, ub4 val) +{ + pool_box_t * box; + sword status; + if(imp_dbh->lock->refs > 0) return; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrSet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&val, sizeof(val), + OCI_ATTR_SPOOL_INCR, box->errhp + ); + if(status != OCI_SUCCESS) + (void)oci_error(dbh, box->errhp, status, "OCIAttrSet POOL_INCR"); +}/*}}}*/ +/*cnx_pool_mode{{{*/ +void +cnx_pool_mode(pTHX_ SV * dbh, imp_dbh_t * imp_dbh, ub4 val) +{ + pool_box_t * box; + sword status; + if(imp_dbh->lock->refs > 0) return; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrSet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&val, sizeof(val), + OCI_ATTR_SPOOL_GETMODE, box->errhp + ); + if(status != OCI_SUCCESS) + (void)oci_error(dbh, box->errhp, status, "OCIAttrSet POOL_GETMODE"); +}/*}}}*/ +/*cnx_pool_wait{{{*/ +#if OCI_MAJOR_VERSION > 18 +void +cnx_pool_wait(pTHX_ SV * dbh, imp_dbh_t * imp_dbh, ub4 val) +{ + pool_box_t * box; + sword status; + if(imp_dbh->lock->refs > 0) return; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrSet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&val, sizeof(val), + OCI_ATTR_SPOOL_WAIT_TIMEOUT, box->errhp + ); + if(status != OCI_SUCCESS) + (void)oci_error(dbh, box->errhp, status, "OCIAttrSet POOL_WAIT_TIMEOUT"); +} +#endif +/*}}}*/ +/*cnx_is_pooled_session{{{*/ +int +cnx_is_pooled_session(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + return (imp_dbh->lock->refs < 0); +}/*}}}*/ +/*cnx_get_pool_mode{{{*/ +int +cnx_get_pool_mode(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_GETMODE, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_METHOD"); + return 0; +}/*}}}*/ +/*cnx_get_pool_wait{{{*/ +#if OCI_MAJOR_VERSION > 18 +int +cnx_get_pool_wait(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_WAIT_TIMEOUT, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_WAIT_TIMEOUT"); + return 0; +} +#endif +/*}}}*/ +/*cnx_get_pool_used{{{*/ +int +cnx_get_pool_used(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_BUSY_COUNT, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_USED"); + return 0; +}/*}}}*/ +/*cnx_get_pool_max{{{*/ +int +cnx_get_pool_max(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_MAX, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_MAX"); + return 0; +}/*}}}*/ +/*cnx_get_pool_min{{{*/ +int +cnx_get_pool_min(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_MIN, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_MIN"); + return 0; +}/*}}}*/ +/*cnx_get_pool_incr{{{*/ +int +cnx_get_pool_incr(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + pool_box_t * box; + ub4 v, l; + sword status; + if(imp_dbh->lock->refs > 0) return 0; + box = ((pool_box_t*)imp_dbh->lock); + status = OCIAttrGet( + box->poolhp, OCI_HTYPE_SPOOL, + (dvoid*)&v, &l, + OCI_ATTR_SPOOL_INCR, box->errhp + ); + if(status == OCI_SUCCESS) return (int)v; + (void)oci_error(dbh, box->errhp, status, "OCIAttrGet POOL_INCR"); + return 0; +}/*}}}*/ +/*cnx_get_pool_rlb{{{*/ +int +cnx_get_pool_rlb(pTHX_ SV *dbh, imp_dbh_t * imp_dbh) +{ + if(imp_dbh->lock->refs > 0) return 0; + return (int)(((pool_box_t*)imp_dbh->lock)->buf[0]); +}/*}}}*/ +/*find_pool{{{*/ +static pool_box_t * +find_pool(dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + llist_t * base = llist_left(&mng_list); + while(base != &mng_list) + { + char * name; + pool_box_t * box = (pool_box_t *)base; + base = llist_left(base); + if(box->base.refs > 0) continue; + if(box->env->mode != ctrl->mode) continue; + if(box->env->ncset != imp_dbh->ncset) continue; + if(box->env->cset != imp_dbh->cset) continue; + name = box->buf + 2 + box->pass_len; + if(0 != strcmp(name, ctrl->dbname)) continue; + name += box->dbname_len + 1; + if(0 != strcmp(name, ctrl->uid)) continue; + if((int)(box->buf[0]) != (int)(ctrl->pool_rlb)) continue; + return box; + } + return NULL; +} +/*}}}*/ +/* new_pool_box{{{*/ +int +new_pool_box(pTHX_ pool_box_t ** slot, dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + OCIEnv * envhp = imp_dbh->envhp; + pool_box_t * box; + char * name; + OCISPool *poolhp; + ub4 mode; + ub4 dbname_len = strlen(ctrl->dbname); + ub4 user_len = strlen(ctrl->uid); + ub4 pwd_len = strlen(ctrl->pwd); + size_t boxlen = sizeof(*box) + dbname_len + user_len + pwd_len + 3; + + sword status = OCIHandleAlloc( + envhp, (dvoid*)&poolhp, OCI_HTYPE_SPOOL, boxlen, (dvoid**)&box + ); + if (status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCISPool"); + + status = OCIHandleAlloc(envhp, (dvoid*)&box->errhp, OCI_HTYPE_ERROR, 0, NULL); + if (status != OCI_SUCCESS) + { + OCIHandleFree(poolhp, OCI_HTYPE_SPOOL); + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCIError"); + } +#ifdef ORA_OCI_112 + if(ctrl->driver_name_len != 0) + { + OCIAuthInfo * authp; + status = OCIHandleAlloc(envhp, (dvoid*)&authp, OCI_HTYPE_AUTHINFO, 0, NULL); + if(status != OCI_SUCCESS) + { + OCIHandleFree(box->errhp, OCI_HTYPE_ERROR); + OCIHandleFree(poolhp, OCI_HTYPE_SPOOL); + return local_error(aTHX_ ctrl->dbh, "Failed to allocate OCIAuthInfo"); + } + status = OCIAttrSet( + authp, OCI_HTYPE_AUTHINFO, + (OraText*)ctrl->driver_name, ctrl->driver_name_len, + OCI_ATTR_DRIVER_NAME, + box->errhp + ); + if(status != OCI_SUCCESS) + { + (void)oci_error(ctrl->dbh, box->errhp, status, "OCIAttrSet DriverName"); + OCIHandleFree(box->errhp, OCI_HTYPE_ERROR); + OCIHandleFree(authp, OCI_HTYPE_AUTHINFO); + OCIHandleFree(poolhp, OCI_HTYPE_SPOOL); + return FALSE; + } + status = OCIAttrSet( + poolhp, OCI_HTYPE_SPOOL, + authp, 0, + OCI_ATTR_SPOOL_AUTH, + box->errhp + ); + if(status != OCI_SUCCESS) + { + (void)oci_error(ctrl->dbh, box->errhp, status, "OCIAttrSet OCIAuthInfo"); + OCIHandleFree(box->errhp, OCI_HTYPE_ERROR); + OCIHandleFree(authp, OCI_HTYPE_AUTHINFO); + OCIHandleFree(poolhp, OCI_HTYPE_SPOOL); + return FALSE; + } + OCIHandleFree(authp, OCI_HTYPE_AUTHINFO); + } +#endif + + + mode = OCI_SPC_HOMOGENEOUS; + if(!ctrl->pool_rlb) mode |= OCI_SPC_NO_RLB; + status = OCISessionPoolCreate( + envhp, + box->errhp, + poolhp, + &box->name, + &box->name_len, + (OraText *) ctrl->dbname, + dbname_len, + ctrl->pool_min, + ctrl->pool_max, + ctrl->pool_incr, + (OraText *) ctrl->uid, + user_len, + (OraText *) ctrl->pwd, + pwd_len, + mode + ); + if (status != OCI_SUCCESS) + { + (void)oci_error(ctrl->dbh, box->errhp, status, "OCISessionPoolCreate"); + OCIHandleFree(box->errhp, OCI_HTYPE_ERROR); + OCIHandleFree(poolhp, OCI_HTYPE_SPOOL); + return FALSE; + } + llist_init(&box->base.lock); + box->env = (env_box_t *)imp_dbh->lock; + box->buf[0] = ctrl->pool_rlb; + name = box->buf + 1; + strcpy(name, ctrl->pwd); + box->pass_len = pwd_len; + name += pwd_len + 1; + strcpy(name, ctrl->dbname); + box->dbname_len = dbname_len; + name += dbname_len + 1; + strcpy(name, ctrl->uid); + + box->base.refs = -dr_instances; + llist_add(&mng_list, &box->base.lock); + box->poolhp = poolhp; + + *slot = box; + return TRUE; +}/*}}}*/ +/* session_from_pool {{{*/ +static int +session_from_pool(pTHX_ dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + sword status; + OCIAuthInfo *authp; + OraText *rettag; + OraText *tag; + ub4 rettagl; + STRLEN tagl; + boolean session_tag_found; + /* try to find existing pool */ + pool_box_t * box = find_pool(ctrl); + if(box != NULL) + { + if(0 != strcmp(box->buf + 1, ctrl->pwd)) + return local_error(aTHX_ ctrl->dbh, "Password for session is wrong"); + } + else if(!new_pool_box(aTHX_ &box, ctrl)) return FALSE; + + /* replace env-box with pool-box. It shall be cleared by DESTROY */ + imp_dbh->lock = &box->base; + box->base.refs--; /* refcount for pool is negative! I know, I know... */ + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "OCIError alloc failed"); + + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, &authp, OCI_HTYPE_AUTHINFO, status + ); + if(status != OCI_SUCCESS) + return local_error(aTHX_ ctrl->dbh, "OCIAuthInfo alloc failed"); + if(ctrl->pool_class != NULL) + { + tag = (OraText*)SvPV(ctrl->pool_class, tagl); + OCIAttrSet_log_stat( + imp_dbh, authp, + OCI_HTYPE_AUTHINFO, + tag, (ub4) tagl, + OCI_ATTR_CONNECTION_CLASS, imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) return local_error(aTHX_ ctrl->dbh, + "OCIAuthInfo setting connection class failed"); + } + + tag = NULL; + tagl = 0; + if(ctrl->pool_tag != NULL) + { + tag = (OraText*)SvPV(ctrl->pool_tag, tagl); + if(tagl == 0) tag = NULL; + } + + OCISessionGet_log_stat( + imp_dbh, imp_dbh->envhp, + imp_dbh->errhp, + &imp_dbh->svchp, + authp, + box->name, box->name_len, + tag, (ub4)tagl, + &rettag, &rettagl, &session_tag_found, + status + ); + if (status != OCI_SUCCESS) + { + (void)oci_error(ctrl->dbh, imp_dbh->errhp, status, "OCISessionGet"); + OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status); + return FALSE; + } + if(session_tag_found && rettagl != 0) + { + if(imp_dbh->session_tag != NULL) SvREFCNT_dec(imp_dbh->session_tag); + imp_dbh->session_tag = newSVpv((char*)rettag, rettagl); + } + + OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status); + + /* Get server and session handles from service context handle, + * allocated by OCISessionGet. */ + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, &imp_dbh->srvhp, NULL, + OCI_ATTR_SERVER, imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) + return oci_error(ctrl->dbh, imp_dbh->errhp, status, "Server get"); + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, &imp_dbh->seshp, NULL, + OCI_ATTR_SESSION, imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) + return oci_error(ctrl->dbh, imp_dbh->errhp, status, "Session get"); + + return 1; +} +/*}}}*/ +#endif + +#if defined(USE_ITHREADS) +static int _cnx_establish +#else +int cnx_establish +#endif +(pTHX_ dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + env_box_t * env_box = NULL; + + if(!figure_out_charsets(aTHX_ ctrl)) return FALSE; + /* try to find existing OCIEnv */ + env_box = find_env(ctrl->mode, imp_dbh->cset, imp_dbh->ncset); + if(env_box == NULL && !new_envhp_box(aTHX_ &env_box, ctrl)) return FALSE; + + env_box->base.refs++; + imp_dbh->envhp = env_box->envhp; + imp_dbh->lock = &env_box->base; + imp_dbh->errhp = NULL; + imp_dbh->srvhp = NULL; + imp_dbh->svchp = NULL; + imp_dbh->seshp = NULL; + /* Now I want DESTROY to be called if something goes wrong */ + DBIc_IMPSET_on(imp_dbh); +#ifdef ORA_OCI_112 + if(ctrl->pool_max != 0) + return session_from_pool(aTHX_ ctrl); +#endif + return simple_connect(aTHX_ ctrl); +} + +#if defined(USE_ITHREADS) +int +cnx_establish(pTHX_ dblogin_info_t * ctrl) +{ + int rv; + MUTEX_LOCK(&mng_lock); + rv = _cnx_establish(aTHX_ ctrl); + MUTEX_UNLOCK(&mng_lock); + return rv; +} +#endif + +/*dbd_dr_mng{{{ + * this function is called every time new DR object is created. + * It is responsible for incrementing refs on all cached objects + */ +void +dbd_dr_mng() +{ + llist_t * el; +#if defined(USE_ITHREADS) + dTHX; + MUTEX_LOCK(&mng_lock); +#endif + dr_instances++; + el = llist_left(&mng_list); + while(el != &mng_list) + { + box_t * base = (box_t *)el; +#ifdef ORA_OCI_112 + if(base->refs < 0) base->refs--; + else +#endif + base->refs++; + el = llist_left(el); + } + if(mng_env == NULL) + { + // Now that this env handle is actually shared by threads the safest setup uses OCI_THREADED + ub4 oci_mode = OCI_DEFAULT; + // I haven't been able to prove that this is needed (TBD) + // I'm still chasing another SEGV in an unknown call as of yet! + // #if defined(USE_ITHREADS) + // oci_mode |= OCI_THREADED; + // #endif + sword status = OCIEnvNlsCreate( + &mng_env, oci_mode, + 0, NULL, NULL, NULL, + 0, NULL, 0, 0 + ); + if(status == OCI_SUCCESS) + status=OCIHandleAlloc( + mng_env, + (dvoid**)&mng_err, + OCI_HTYPE_ERROR, + 0, NULL + ); + utf8_csid = OCINlsCharSetNameToId(mng_env, (void*)"UTF8"); + al32utf8_csid = OCINlsCharSetNameToId(mng_env, (void*)"AL32UTF8"); + al16utf16_csid = OCINlsCharSetNameToId(mng_env, (void*)"AL16UTF16"); + } +#if defined(USE_ITHREADS) + MUTEX_UNLOCK(&mng_lock); +#endif +} +/*}}}*/ + +/* cnx_detach{{{*/ +void +cnx_detach(pTHX_ imp_dbh_t * imp_dbh) +{ + /* Oracle will commit on an orderly disconnect. */ + /* See DBI Driver.xst file for the DBI approach. */ +#ifdef ORA_OCI_112 + if (imp_dbh->lock->refs < 0) + { + /* Release session, tagged for future retrieval. */ + if(imp_dbh->session_tag != NULL) + { + STRLEN tlen; + char * tag = SvPV(imp_dbh->session_tag, tlen); + (void)OCISessionRelease( + imp_dbh->svchp, imp_dbh->errhp, + (OraText*)tag, (ub4)tlen, OCI_SESSRLS_RETAG + ); + SvREFCNT_dec(imp_dbh->session_tag); + imp_dbh->session_tag = NULL; + } + else (void)OCISessionRelease( + imp_dbh->svchp, imp_dbh->errhp, + NULL, 0, OCI_DEFAULT + ); + /* all handles are gone now */ + imp_dbh->seshp = NULL; + imp_dbh->svchp = NULL; + imp_dbh->srvhp = NULL; + } + else { +#endif + + sword status = OCI_SUCCESS; + + // GLOBAL Perl END's may cause these to SEGV due to filehandles (just a guess). + // Also forking can cause duplicate closings of a session. A preexisting handle in + // the parent is duplicated in the child. The first process to call SessionEnd + // wins, each successive call returns OCI_ERROR. + // + // The prior author included a comment about errors but was not specific and choose to ignore them. + // + // I thought I was being clever by adding the logging to these OCI calls; + // to help debug the original SEGV issue. Best guess is the logging relies on + // the filehandles being valid and they are not always valid, hence the SEGV + // within Perl's IO printing. + // + // The OCI calls are successful but the logging is not. I don't like silent failures + // so we'll use a more direct approach to handle this; keeping Perl and it's state + // out of the picture. + + // OCISessionEnd_log_stat( imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, OCI_DEFAULT, status ); + // OCIServerDetach_log_stat( imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status ); + + if (( status = OCISessionEnd( imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, OCI_DEFAULT )) != OCI_SUCCESS + && status != OCI_ERROR ) + { + // by printing the pointers I could see the children and parent were + // using the same handles. The first is successful, the rest fail. (seems reasonable enough) + fprintf( stderr, "OCISessionEnd() failed: %d %p %p %p pid=%d\n", status, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, getpid()); + } + + if (( status = OCIServerDetach( imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT )) != OCI_SUCCESS ) + { + fprintf( stderr, "OCIServerDetach() failed: %d pid=%d\n", status, getpid()); + } + +#ifdef ORA_OCI_112 + } +#endif +}/*}}}*/ +/*cnx_clean{{{*/ +void +cnx_clean(pTHX_ imp_dbh_t * imp_dbh) +{ + if(imp_dbh->errhp != NULL) + { + (void)OCIHandleFree(imp_dbh->errhp, OCI_HTYPE_ERROR); + imp_dbh->errhp = NULL; + } + if(imp_dbh->seshp != NULL) + { + (void)OCIHandleFree(imp_dbh->seshp, OCI_HTYPE_SESSION); + imp_dbh->seshp = NULL; + } + if(imp_dbh->svchp != NULL) + { + (void)OCIHandleFree(imp_dbh->svchp, OCI_HTYPE_SVCCTX); + imp_dbh->svchp = NULL; + } + if(imp_dbh->srvhp != NULL) + { + (void)OCIHandleFree(imp_dbh->srvhp, OCI_HTYPE_SERVER); + imp_dbh->srvhp = NULL; + } + +#ifdef ORA_OCI_112 + if(imp_dbh->lock->refs < 0) + { + imp_dbh->lock->refs++; + if(imp_dbh->lock->refs == 0) + release_pool(aTHX_ (pool_box_t *)imp_dbh->lock); + } + else + { +#endif + imp_dbh->lock->refs--; + if(imp_dbh->lock->refs == 0) + release_env(aTHX_ (env_box_t *)imp_dbh->lock); +#ifdef ORA_OCI_112 + } +#endif +}/*}}}*/ + +void +cnx_drop_dr(pTHX_ imp_drh_t * imp_drh) +{ + llist_t * el; +#if defined(USE_ITHREADS) + MUTEX_LOCK(&mng_lock); +#endif + dr_instances--; + el = llist_left(&mng_list); + while(el != &mng_list) + { + box_t * base = (box_t *)el; +#ifdef ORA_OCI_112 + int is_pool = 0; + if(base->refs < 0) + { + base->refs++; + is_pool = 1; + } + else +#endif + base->refs--; + el = llist_left(el); + if(base->refs == 0) + { +#ifdef ORA_OCI_112 + if(is_pool) + release_pool(aTHX_ (pool_box_t *)base); + else +#endif + release_env(aTHX_ (env_box_t *)base); + } + } +#if defined(USE_ITHREADS) + MUTEX_UNLOCK(&mng_lock); +#endif +} + +/* in vim: set foldmethod=marker: */ diff --git a/dbdimp.c b/dbdimp.c index 84eb7054..f6711c72 100644 --- a/dbdimp.c +++ b/dbdimp.c @@ -13,15 +13,13 @@ #define strcasecmp strcmpi #endif -#ifdef __CYGWIN32__ -#include "w32api/windows.h" -#include "w32api/winbase.h" -#endif /* __CYGWIN32__ */ +#if defined(__CYGWIN__) || defined(__CYGWIN32__) +#include +#include +#endif /* __CYGWIN__ */ #include "Oracle.h" - - /* XXX DBI should provide a better version of this */ #define IS_DBI_HANDLE(h) \ (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && \ @@ -33,8 +31,7 @@ DBISTATE_DECLARE; -int ora_fetchtest; /* intrnal test only, not thread safe */ -int is_extproc = 0; /* not ProC but ExtProc.pm */ +int ora_fetchtest; /* internal test only, not thread safe */ 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 */ @@ -46,13 +43,14 @@ int ora_ncs_buff_mtpl = 4; /* a mulitplyer for ncs clob buffers */ #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; +/* reduce noise in the login6 function */ +#define tracer(dlvl, vlvl, ...) if (DBIc_DBISTATE(imp_dbh)->debug >= (dlvl) || dbd_verbose >= (vlvl) )\ + PerlIO_printf(DBIc_LOGPIO(imp_dbh), __VA_ARGS__) typedef struct sql_fbh_st sql_fbh_t; struct sql_fbh_st { @@ -60,13 +58,25 @@ struct sql_fbh_st { int prec; int scale; }; +typedef struct login_info_st login_info_t; +struct login_info_st { + SV * dbh; + imp_dbh_t * imp_dbh; + char *dbname; + char *uid; + char *pwd; + ub4 mode; +}; static sql_fbh_t ora2sql_type _((imp_fbh_t* fbh)); +static void disable_taf(imp_dbh_t *imp_dbh); +static int enable_taf(pTHX_ 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); static sb4 -oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug) +oci_error_get(imp_xxh_t *imp_xxh, + OCIError *errhp, sword status, char *what, SV *errstr, int debug) { dTHX; text errbuf[1024]; @@ -86,17 +96,18 @@ oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug) } while( ++recno - && OCIErrorGet_log_stat(errhp, recno, (text*)NULL, &eg_errcode, errbuf, + && 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 + && eg_status != OCI_INVALID_HANDLE + && recno < 100 ) { if (debug >= 4 || recno>1/*XXX temp*/ || dbd_verbose >= 4 ) - PerlIO_printf(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", - what ? what : "", (long)recno, - (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status), - status, (long)eg_errcode, errbuf); - errcode = eg_errcode; + PerlIO_printf(DBIc_LOGPIO(imp_xxh), + " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", + what ? 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); @@ -114,6 +125,28 @@ oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug) return errcode; } + +/* report to DBI errors that are not comming from Oracle */ +static int +local_error(pTHX_ SV * h, const char * fmt, ...) +{ + va_list ap; + SV * txt_sv = sv_newmortal(); + SV * code_sv = get_sv("DBI::stderr", 0); + D_imp_xxh(h); + if(code_sv == NULL) + { + code_sv = sv_newmortal(); + sv_setiv(code_sv, 2000000000); + } + va_start(ap, fmt); + sv_vsetpvf(txt_sv, fmt, &ap); + va_end(ap); + DBIh_SET_ERR_SV(h, imp_xxh, code_sv, txt_sv, &PL_sv_undef, &PL_sv_undef); + return FALSE; +} + + static int GetRegKey(char *key, char *val, char *data, unsigned long *size) { @@ -125,7 +158,7 @@ GetRegKey(char *key, char *val, char *data, unsigned long *size) 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); + ret = RegQueryValueEx(hKey, val, NULL, NULL, (LPBYTE)data, size); RegCloseKey(hKey); if ((ret != ERROR_SUCCESS) || (*size >= len)) return 0; @@ -146,7 +179,7 @@ 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]; + char ora_home_key[WIN32_REG_BUFSIZE*2+1]; unsigned long len = WIN32_REG_BUFSIZE; char *e = getenv(name); if (e) @@ -162,7 +195,7 @@ ora_env_var(char *name, char *buf, unsigned long size) return buf; } -#ifdef __CYGWIN32__ +#if defined(__CYGWIN__) || defined(__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. @@ -188,9 +221,25 @@ ora_cygwin_set_env(char *name, char *value) { SetEnvironmentVariable(name, value); } -#endif /* __CYGWIN32__ */ +#endif /* __CYGWIN__ */ +void +ora_shared_release(pTHX_ SV * sv) +{ + STRLEN len; + imp_dbh_t *imp_dbh; + while (SvROK(sv)) sv = SvRV(sv) ; + imp_dbh = (imp_dbh_t *)SvPV(sv, len); + if(len == sizeof(*imp_dbh)) + { + if(dbd_verbose >= 3) + warn("clearing shared session %p\n", imp_dbh->seshp); + cnx_detach(aTHX_ imp_dbh); + cnx_clean(aTHX_ imp_dbh); + } +} + void dbd_init(dbistate_t *dbistate) { @@ -199,40 +248,47 @@ dbd_init(dbistate_t *dbistate) dbd_init_oci(dbistate); } +void +dbd_dr_destroy(SV *drh, imp_drh_t *imp_drh) +{ + dTHX; + if (dbd_verbose >= 3 ) + PerlIO_printf(DBIc_LOGPIO(imp_drh), "dr_destroy %p\n", imp_drh); + cnx_drop_dr(aTHX_ imp_drh); +} + int dbd_discon_all(SV *drh, imp_drh_t *imp_drh) { dTHR; dTHX; + /* The disconnect_all concept is flawed and needs more work */ 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; + DBIh_SET_ERR_CHAR(drh, (imp_xxh_t*)imp_drh, Nullch, 1, "disconnect_all not implemented", Nullch, Nullch); + return FALSE; } return FALSE; } - void -dbd_fbh_dump(imp_fbh_t *fbh, int i, int aidx) +dbd_fbh_dump(imp_sth_t *imp_sth, imp_fbh_t *fbh, int i, int aidx) { dTHX; - PerlIO *fp = DBILOGFP; - PerlIO_printf(fp, " fbh %d: '%s'\t%s, ", + 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", + 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(fp, " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n", + 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(int dbtype) { @@ -271,7 +327,7 @@ oratype_bind_ok(int dbtype) /* It's a type we support for placeholders */ 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 ORA_XMLTYPE: /* SQLT_NTY must be careful here as its value (108) is the same for an embedded object Well really only XML clobs not embedded objects */ return 1; } return 0; @@ -362,7 +418,6 @@ fb_ary_free(fb_ary_t *fb_ary) } - /* ================================================================== */ @@ -373,14 +428,58 @@ dbd_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd) } -/* from shared.xs */ -typedef struct { - 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 */ -} shared_sv; +static sword +get_env_charset(OCIEnv *envhp, OCIError * errhp, ub2 * charset_p, ub2 * ncharset_p) +{ + sword status = OCIAttrGet(envhp, OCI_HTYPE_ENV, + charset_p, NULL, + OCI_ATTR_ENV_CHARSET_ID,errhp + ); + if (status != OCI_SUCCESS) return status; + return OCIAttrGet(envhp, OCI_HTYPE_ENV, + ncharset_p, NULL, + OCI_ATTR_ENV_NCHARSET_ID,errhp + ); +} +/* this function makes final adjustments to connected handle */ +static int +activate_dbh(pTHX_ dblogin_info_t * ctrl) +{ + imp_dbh_t * imp_dbh = ctrl->imp_dbh; + DBIc_IMPSET_on(imp_dbh); /* just in case */ + 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) */ + + if (DBIc_DBISTATE(imp_dbh)->debug >= 3 || dbd_verbose >= 3 ) { + sword status; + oratext charsetname[OCI_NLS_MAXBUFSZ]; + oratext ncharsetname[OCI_NLS_MAXBUFSZ]; + ub2 charsetid_l = 0; + ub2 ncharsetid_l = 0; + + /* Report charsets used in the environment */ + status = get_env_charset(imp_dbh->envhp, imp_dbh->errhp, &charsetid_l, &ncharsetid_l); + if (status != OCI_SUCCESS) { + oci_error(ctrl->dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_ENV_CHARSET_ID"); + return 0; + } + OCINlsCharSetIdToName(imp_dbh->envhp,charsetname, sizeof(charsetname),charsetid_l ); + OCINlsCharSetIdToName(imp_dbh->envhp,ncharsetname, sizeof(ncharsetname),ncharsetid_l ); + PerlIO_printf( DBIc_LOGPIO(imp_dbh), + " charset id=%d, name=%s, ncharset id=%d, name=%s, session=%p" + " (csid: utf8=%d al32utf8=%d)\n", + charsetid_l,charsetname, ncharsetid_l,ncharsetname, imp_dbh->seshp, + utf8_csid, al32utf8_csid); +#ifdef ORA_OCI_112 + if (ctrl->pool_max) + PerlIO_printf(DBIc_LOGPIO(imp_dbh)," Using DRCP Connection\n "); +#endif + } + return TRUE; +} int @@ -388,539 +487,214 @@ dbd_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd, S { dTHR; dTHX; - sword status; + dblogin_info_t ctrl = {0}; 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_sv = NULL; #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); - - - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_driver_name", 15)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_driver_name is not a string"); - imp_dbh->driver_name = (char *) SvPV (*svp, svp_len ); - imp_dbh->driver_namel= (ub4) svp_len; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->driver_name,imp_dbh->driver_namel,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status); - } - else { - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION,(text*)"DBDO1.28",7,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status); - } -#endif /*ORA_OCI_112*/ - - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_action", 10)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_action is not a string"); - imp_dbh->action = (char *) SvPV (*svp, svp_len ); - imp_dbh->actionl= (ub4) svp_len; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status); - } - - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_module_name", 15)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_module_name is not a string"); - imp_dbh->module_name = (char *) SvPV (*svp, svp_len ); - imp_dbh->module_namel= (ub4) svp_len; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->module_name,imp_dbh->module_namel,OCI_ATTR_MODULE,imp_dbh->errhp, status); - - } - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_client_identifier", 21)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_client_identifier is not a string"); - imp_dbh->client_identifier = (char *) SvPV (*svp, svp_len ); - imp_dbh->client_identifierl= (ub4) svp_len; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_identifier,imp_dbh->client_identifierl,OCI_ATTR_CLIENT_IDENTIFIER,imp_dbh->errhp, status); - - } - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_client_info", 15)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_client_info is not a string"); - imp_dbh->client_info = (char *) SvPV (*svp, svp_len ); - imp_dbh->client_infol= (ub4) svp_len; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_info,imp_dbh->client_infol,OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status); - - } - - /* TAF Events */ - imp_dbh->using_taf = 0; - - if (DBD_ATTRIB_TRUE(attr,"ora_taf",7,svp)){ - imp_dbh->using_taf = 1; - imp_dbh->taf_sleep = 5; /* 5 second default */ - - DBD_ATTRIB_GET_IV( attr, "ora_taf_sleep", 13, svp, imp_dbh->taf_sleep); - - if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_taf_function", 16)) && SvOK(*svp)) { - STRLEN svp_len; - if (!SvPOK(*svp)) - croak("ora_taf_function is not a string"); - imp_dbh->taf_function = (char *) SvPV (*svp, svp_len ); - - } - } - - 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); - - - /* check to see if success_warn is set. This will */ - /* warn after some sucessfull operations for tuning results */ - if (DBD_ATTRIB_TRUE(attr,"ora_oci_success_warn",20,svp)) - DBD_ATTRIB_GET_IV( attr, "ora_oci_success_warn", 20, svp, oci_warn); - - /* check to see if ora_objects set*/ - /* with this set any embedded types will go into a DBD::Oracle::Object */ - /* rather than just an ref array */ - if (DBD_ATTRIB_TRUE(attr,"ora_objects",11,svp)) - DBD_ATTRIB_GET_IV( attr, "ora_objects",11, svp, ora_objects); + DBD_ATTRIB_GET_IV( attr, "dbd_verbose", 11, svp, dbd_verbose); + DBD_ATTRIB_GET_IV( attr, "ora_verbose", 11, svp, dbd_verbose); - if (DBIS->debug >= 6 || dbd_verbose >= 6 ) - dump_env_to_trace(); + // Noise (TMI) + if (DBIc_DBISTATE(imp_dbh)->debug >= 8 || dbd_verbose >= 8 ) + 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 (DBIS->debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "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 (DBIS->debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - "dbd_db_login6 IMPSET but not ACTIVE so connect not skipped\n"); + if (DBIc_has(imp_dbh, DBIcf_IMPSET)) + { + /* dbi_imp_data from take_imp_data */ + if (DBIc_has(imp_dbh, DBIcf_ACTIVE)) + { + tracer(2, 3, "dbd_db_login6 impset. Env is %p\n", imp_dbh->envhp); + /* tell our parent we've adopted an active child */ + ++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh)); + return TRUE; + } + /* not ACTIVE so connect not skipped */ + tracer(2, 3, "dbd_db_login6 IMPSET but not ACTIVE\n"); + } + + ctrl.mode = OCI_OBJECT;/* needed for LOBs (8.0.4) */ + if (DBD_ATTRIB_TRUE(attr, "ora_events", 10, svp)) + { + ctrl.mode |= OCI_EVENTS; + /* Needed for Oracle Fast Application Notification (FAN). */ } - imp_dbh->envhp = imp_drh->envhp; /* will be NULL on first connect */ + /* Undocumented, this overrides all previous settings */ + DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, svp, ctrl.mode); -#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 defined(USE_ITHREADS) || defined(MULTIPLICITY) || defined(USE_5005THREADS) + ctrl.mode |= OCI_THREADED; +#endif + ctrl.dbname = dbname; + ctrl.dbh = dbh; + ctrl.imp_dbh = imp_dbh; + ctrl.uid = uid; + ctrl.pwd = pwd; - 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 (DBIS->debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_db_login: use shared Oracle database handles.\n"); - } else { - shared_dbh = NULL ; - } - } +#ifdef ORA_OCI_112 + /*check to see if the user is connecting with DRCP */ + if (DBD_ATTRIB_TRUE(attr,"ora_drcp",8,svp)) + { + ctrl.pool_max = 40; + hv_delete((HV*)SvRV(attr), "ora_drcp", 8, G_DISCARD); + } + + /* some connection pool attributes */ + if(ctrl.pool_max) + { + svp = DBD_ATTRIB_GET_SVP(attr, "ora_drcp_min",12); + if (svp != NULL) + { + ctrl.pool_min = SvIV(*svp); + hv_delete((HV*)SvRV(attr), "ora_drcp_min", 12, G_DISCARD); + } + svp = DBD_ATTRIB_GET_SVP(attr,"ora_drcp_max",12); + if (svp != NULL) + { + ctrl.pool_max = SvIV(*svp); + if (ctrl.pool_max == 0) ctrl.pool_max = 40; + hv_delete((HV*)SvRV(attr), "ora_drcp_max", 12, G_DISCARD); + } + svp = DBD_ATTRIB_GET_SVP(attr,"ora_drcp_incr",13); + if (svp != NULL) + { + ctrl.pool_incr = SvIV(*svp); + hv_delete((HV*)SvRV(attr), "ora_drcp_incr", 13, G_DISCARD); + } + svp = DBD_ATTRIB_GET_SVP(attr,"ora_drcp_rlb",12); + if (svp != NULL) + { + ctrl.pool_rlb = (0 != SvIV(*svp)) ? 1 : 0; + hv_delete((HV*)SvRV(attr), "ora_drcp_rlb", 12, G_DISCARD); + } + svp = DBD_ATTRIB_GET_SVP(attr,"ora_drcp_class",14); + if (svp != NULL) + ctrl.pool_class = hv_delete((HV*)SvRV(attr), "ora_drcp_class", 14, 0); + /* save session tag to be used during session-get + * it won't be passed to STORE. The found tag shall + * be stored in imp_dbh->session_tag + */ + svp = DBD_ATTRIB_GET_SVP(attr,"ora_drcp_tag",12); + if (svp != NULL) + ctrl.pool_tag = hv_delete((HV*)SvRV(attr), "ora_drcp_tag", 12, 0); + /* pool Default values */ + if (!ctrl.pool_incr) ctrl.pool_incr = 1; + } + svp = DBD_ATTRIB_GET_SVP(attr,"ora_driver_name",15); + if (svp != NULL) + { + STRLEN l; + SV * v = hv_delete((HV*)SvRV(attr), "ora_driver_name", 15, 0); + ctrl.driver_name = SvPV(v, l); + ctrl.driver_name_len = (ub4)l; + } + else + { + ctrl.driver_name = "DBD::Oracle : " VERSION; + ctrl.driver_name_len = strlen(ctrl.driver_name); + } #endif + /* TAF Events shall be processed from STORE*/ + imp_dbh->server_version = 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; - } - } - 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); - - { - size_t rsize = 0; - /* Get CLIENT char and nchar charset id values */ - OCINlsEnvironmentVariableGet_log_stat( &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( &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->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->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"); - } - - } - - 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->envhp, OCI_DEFAULT, 0, 0, status); - if (status != OCI_SUCCESS) { - oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit"); - return 0; - } - } - } - - OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status); - OCIAttrGet_log_stat(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; - } - - OCIAttrGet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, &ncharsetid, (ub4)0 , - OCI_ATTR_ENV_NCHARSET_ID, imp_dbh->errhp, status); - - if (status != OCI_SUCCESS) { - oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_NCHARSET_ID"); - return 0; +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + imp_dbh->is_shared = 0; + svp = DBD_ATTRIB_GET_SVP(attr,"ora_dbh_share",13); + if(svp != NULL) + { + MAGIC * mg; + shared_sv = *svp; + tracer(2, 3, "trying to find shared session\n"); + while (SvROK(shared_sv)) shared_sv = SvRV(shared_sv) ; + /* check if this is shared scalar by finding appropriate magic */ + if(SvTYPE(shared_sv) < SVt_PVMG || + (mg = mg_find(shared_sv, PERL_MAGIC_shared_scalar)) == NULL) + return local_error( + aTHX_ dbh,"value of ora_dbh_share must be a scalar that is shared" + ) ; + + /* now we should lock access. Note, locking of unshared variable croaks */ + /* this is unlocked automatically when current XS function ends */ + SvLOCK (shared_sv) ; + /* copy value from shared part, just in case */ + SvGETMAGIC(shared_sv); + shared_dbh_len = SvCUR(shared_sv) ; + + if (shared_dbh_len == sizeof (imp_dbh_t)) { + imp_dbh_t * shared_dbh = (imp_dbh_t *)SvPVX(shared_sv) ; + /* initialize from shared data */ + memcpy ( + ((char *)imp_dbh) + DBH_DUP_OFF, + ((char *)shared_dbh) + DBH_DUP_OFF, + DBH_DUP_LEN + ); + imp_dbh->is_shared = 1; + + /* using private errhp does not make sense really because + * one can not use this copy of connection at the same + * time in different threads. There are transactions and + * if some threads starts transaction, then other thread + * should not accidently finish it. So if the connections + * are used carefully, then they don't need separate errhp + */ + tracer(2, 3, "dbd_db_login: shared session %p\n", shared_dbh->seshp); + (void)hv_delete((HV*)SvRV(attr), "ora_dbh_share", 13, G_DISCARD); + /* nothing else to do with this handle */ + return activate_dbh(aTHX_ &ctrl); + } + else if (shared_dbh_len != 0) + return local_error(aTHX_ dbh, "Invalid value for ora_dbh_share %d vs %d", + (int)shared_dbh_len, (int)sizeof(imp_dbh_t)) ; + /* indicate that this connection is shared */ + imp_dbh->is_shared = 1; } - - /* 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 (DBIS->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(DBILOGFP," 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(DBILOGFP," Useing DRCP Connection\n "); #endif - } - if (!shared_dbh) { - OCIHandleAlloc_ok(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->srvhp, OCI_HTYPE_SERVER, status); - OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status); - return 0; - } + /* Get desired charset and ncharset */ + if ((svp = DBD_ATTRIB_GET_SVP(attr, "ora_charset", 11))) { + if (!SvPOK(*svp)) return local_error( + aTHX_ dbh, "ora_charset is not a string" + ); + ctrl.cset = SvPV_nolen(*svp); + /* don't remove attribute because I need pointer */ + } + + if ((svp = DBD_ATTRIB_GET_SVP(attr, "ora_ncharset", 12))) { + if (!SvPOK(*svp)) return local_error( + aTHX_ dbh, "ora_ncharset is not a string" + ); + ctrl.ncset = SvPV_nolen(*svp); + } + ctrl.session_mode = OCI_DEFAULT; + if ((svp = DBD_ATTRIB_GET_SVP(attr, "ora_session_mode", 16))) { + ctrl.session_mode = SvIV(*svp); + hv_delete((HV*)SvRV(attr), "ora_session_mode", 16, G_DISCARD); + } + if(!cnx_establish(aTHX_ &ctrl)) return FALSE; - { - 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); +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + if (imp_dbh->is_shared != 0 && 0 == shared_dbh_len) { #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->envhp, &imp_dbh->poolhp, OCI_HTYPE_SPOOL, status); - - OCISessionPoolCreate_log_stat(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->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); - OCIHandleFree_log_stat(imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); - OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status); - OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status); - return 0; - } - - OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->authp, OCI_HTYPE_AUTHINFO, status); - - OCIAttrSet_log_stat(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->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->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->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); - OCISessionPoolDestroy(imp_dbh->poolhp, imp_dbh->errhp,status); - OCIHandleFree_log_stat(imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); - OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status); - OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status); - return 0; - } - - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) { - PerlIO_printf(DBILOGFP,"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(DBILOGFP,"with connection class=%s\n",imp_dbh->pool_class); - } - - } - else { -#endif /* ORA_OCI_112 */ - - OCIHandleAlloc_ok(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->seshp, 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); - if (forced_new_environment) - OCIHandleFree_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, status); - return 0; - } - - - OCIAttrSet_log_stat( imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp, - (ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status); - - OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->seshp, OCI_HTYPE_SESSION, status); - - cred_type = ora_parse_uid(imp_dbh, &uid, &pwd); - - OCISessionBegin_log_stat( 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->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); - OCIHandleFree_log_stat(imp_dbh->seshp, 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); - if (forced_new_environment) - OCIHandleFree_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, status); - return 0; - } - - OCIAttrSet_log_stat(imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX, - imp_dbh->seshp, (ub4) 0,(ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status); + SV * tag = imp_dbh->session_tag; + imp_dbh->session_tag = NULL; +#endif + tracer(2, 3, "saving shared session %p\n", imp_dbh->seshp); + sv_setpvn_mg(shared_sv, (char*)imp_dbh, sizeof(*imp_dbh)); #ifdef ORA_OCI_112 - } + imp_dbh->session_tag = tag; #endif - } - - } - - 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) */ - - 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) { - /* much of this could be replaced with a single sv_setpvn() */ - (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 - - /* set up TAF callback if wanted */ - - - if (imp_dbh->using_taf){ - bool can_taf; - OCIAttrGet_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL, - OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status); - - if (!can_taf){ - croak("You are attempting to enable TAF on a server that is not TAF Enabled \n"); - } - - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) { - PerlIO_printf(DBILOGFP,"Setting up TAF with wait time of %d seconds\n",imp_dbh->taf_sleep); - } - status = reg_taf_callback(imp_dbh); - if (status != OCI_SUCCESS) { - oci_error(dbh, NULL, status, - "Setting TAF Callback Failed! "); - return 0; - } - } - - return 1; + return activate_dbh(aTHX_ &ctrl); } @@ -929,7 +703,7 @@ dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; sword status; - OCITransCommit_log_stat(imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, 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; @@ -952,7 +726,7 @@ dbd_st_cancel(SV *sth, imp_sth_t *imp_sth) /* 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->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); + OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); } return 1; } @@ -964,7 +738,7 @@ dbd_db_rollback(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; sword status; - OCITransRollback_log_stat(imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, 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"); return 0; @@ -986,10 +760,13 @@ int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV * croak("cannot bind to non-existent field %d", field); } - imp_sth->fbh[field-1].req_type = type; - imp_sth->fbh[field-1].bind_flags = 0; /* default to none */ + 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; @@ -1013,7 +790,6 @@ int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV * imp_sth->fbh[field-1].bind_flags |= DBIstcf_DISCARD_STRING; } } -#endif /* DBIXS_REVISION >= 13590 */ return 1; } @@ -1022,45 +798,33 @@ dbd_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh) { 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 ; - } -#endif /* 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. */ - - if (refcnt == 1 ) { - sword s_se, s_sd; +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + /* do nothing for connections stored in shared variables */ + if(imp_dbh->is_shared != 0) + { #ifdef ORA_OCI_112 - if (imp_dbh->using_drcp) { - OCISessionRelease_log_stat(imp_dbh->svchp, imp_dbh->errhp,s_se); - } - else { + /* just in case, drop session_tag if it is set + * normally it is used during session release */ + if(imp_dbh->session_tag != NULL) + { + SvREFCNT_dec(imp_dbh->session_tag); + imp_dbh->session_tag = NULL; + } #endif - OCISessionEnd_log_stat(imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, - OCI_DEFAULT, s_se); -#ifdef ORA_OCI_112 - } + return TRUE; + } #endif - 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; - } + cnx_detach(aTHX_ imp_dbh); + /* 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; + return TRUE; } @@ -1068,56 +832,63 @@ void dbd_db_destroy(SV *dbh, imp_dbh_t *imp_dbh) { dTHX ; - int refcnt = 1 ; - sword status; + if (DBIc_ACTIVE(imp_dbh)) dbd_db_disconnect(dbh, imp_dbh); + DBIc_IMPSET_off(imp_dbh); + if (imp_dbh->taf_function) { + disable_taf(imp_dbh); + 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; + } #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-- ; - } + /* on shared cnx only decrement reference count */ + if(imp_dbh->is_shared != 0) return; #endif + tracer(3, 3, "clearing session 0x%p\n", imp_dbh->seshp); + cnx_clean(aTHX_ 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; - - if (imp_dbh->using_taf){ - OCIFocbkStruct tafailover; - tafailover.fo_ctx = NULL; - tafailover.callback_function = NULL; - OCIAttrSet_log_stat(imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER, - (dvoid *) &tafailover, (ub4) 0, - (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status); - - } -#ifdef ORA_OCI_112 - if (imp_dbh->using_drcp) { - OCIHandleFree_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,status); - OCISessionPoolDestroy_log_stat(imp_dbh->poolhp, imp_dbh->errhp,status); - OCIHandleFree_log_stat(imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); - } - else { -#endif - OCIHandleFree_log_stat(imp_dbh->seshp, OCI_HTYPE_SESSION,status); - OCIHandleFree_log_stat(imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); +SV * +dbd_take_imp_data(SV *dbh, imp_xxh_t *imp_xxh, void* foo) +{ + dTHX; + D_imp_dbh(dbh); + tracer(3, 3, "take_imp for %p (session %p)\n", imp_dbh, imp_dbh->seshp); + if (imp_dbh->taf_function) { + disable_taf(imp_dbh); + 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; + } #ifdef ORA_OCI_112 - } + if(imp_dbh->session_tag != NULL) + { + SvREFCNT_dec(imp_dbh->session_tag); + imp_dbh->session_tag = NULL; + } #endif - OCIHandleFree_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, status); - - } - OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status); -dbd_db_destroy_out: - DBIc_IMPSET_off(imp_dbh); + /* we do nothing else here because the copy of current state is saved by + * SUPER::take_imp_data and no other method shall be called on this + * handle. If user calls something, then it is not our problem. + * Wether DESTROY nor DISCONNECT are called by DBI + */ + /* Indicate that SUPER::take_imp_data should be called. */ + return &PL_sv_no; } +/* According to Oracle's documentation of OCISessionGet, attributes should not be changed + on the server and session handles attached to OCISessionGet's service context handle. + This would imply that dbd_db_STORE_attrib is wrong for session pooling, however + it seems to work just fine... */ int dbd_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv) { @@ -1134,66 +905,116 @@ dbd_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv) } #ifdef ORA_OCI_112 else if (kl==15 && strEQ(key, "ora_driver_name") ) { - imp_dbh->driver_name = (char *) SvPV (valuesv, vl ); - imp_dbh->driver_namel= (ub4) vl; - OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->driver_name,imp_dbh->driver_namel,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status); + (void)local_error( + aTHX_ dbh, "ora_driver_name can not be changed" + ); } else if (kl==8 && strEQ(key, "ora_drcp") ) { - imp_dbh->using_drcp = 1; + (void)local_error( + aTHX_ dbh, "ora_drcp can not be changed" + ); } 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; + (void)local_error( + aTHX_ dbh, "ora_drcp_class can not be changed" + ); + } + else if (kl==12 && strEQ(key, "ora_drcp_tag") ) { +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + if(imp_dbh->is_shared != 0) + { + (void)local_error( + aTHX_ dbh, "ora_drcp_tag not supported for shared DBH" + ); + } + else +#endif + if(cnx_is_pooled_session(aTHX_ dbh, imp_dbh)) + { + if(imp_dbh->session_tag != NULL) SvREFCNT_dec(imp_dbh->session_tag); + imp_dbh->session_tag = newSVsv(valuesv); + } + else (void)local_error( + aTHX_ dbh, "ora_drcp_tag is not used without DRCP" + ); } else if (kl==12 && strEQ(key, "ora_drcp_min") ) { - imp_dbh->pool_min = SvIV (valuesv); + cnx_pool_min(aTHX_ dbh, imp_dbh, (ub4)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_mode") ) { + cnx_pool_mode(aTHX_ dbh, imp_dbh, (ub4)SvIV(valuesv)); } - else if (kl==13 && strEQ(key, "ora_drcp_incr") ) { - imp_dbh->pool_incr = SvIV (valuesv); +#if OCI_MAJOR_VERSION > 18 + else if (kl==13 && strEQ(key, "ora_drcp_wait") ) { + cnx_pool_wait(aTHX_ dbh, imp_dbh, (ub4)SvIV(valuesv)); } #endif - else if (kl==7 && strEQ(key, "ora_taf") ) { - imp_dbh->using_taf = 1; + else if (kl==12 && strEQ(key, "ora_drcp_max") ) { + cnx_pool_max(aTHX_ dbh, imp_dbh, (ub4)SvIV(valuesv)); } - else if (kl==16 && strEQ(key, "ora_taf_function") ) { - imp_dbh->taf_function = (char *) SvPV (valuesv, vl ); + else if (kl==13 && strEQ(key, "ora_drcp_incr") ) { + cnx_pool_incr(aTHX_ dbh, imp_dbh, (ub4)SvIV(valuesv)); } - else if (kl==13 && strEQ(key, "ora_taf_sleep") ) { - imp_dbh->taf_sleep = SvIV (valuesv); + else if (kl==12 && strEQ(key, "ora_drcp_rlb") ) { + /* ignore it here, too late to do anything */ } - 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->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status); +#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)) { + if(!enable_taf(aTHX_ dbh, imp_dbh)) return FALSE; + } 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->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status); - + char * action = (char *) SvPV (valuesv, vl ); + OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, + action,(ub4)vl, OCI_ATTR_ACTION, imp_dbh->errhp, status); + if(status != OCI_SUCCESS) (void)oci_error( + dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_ACTION"); } +#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->seshp,OCI_HTYPE_SESSION, imp_dbh->client_identifier,imp_dbh->client_identifierl,OCI_ATTR_CLIENT_IDENTIFIER,imp_dbh->errhp, status); - - } + char * cid = (char *) SvPV (valuesv, vl ); + OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, + cid,(ub4)vl,OCI_ATTR_CLIENT_IDENTIFIER, + imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) (void)oci_error( + dbh, imp_dbh->errhp, status, + "OCIAttrSet OCI_ATTR_CLIENT_IDENTIFIER"); + } +#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->seshp,OCI_HTYPE_SESSION, imp_dbh->client_info,imp_dbh->client_infol,OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status); + char * client_info = (char *) SvPV (valuesv, vl ); + OCIAttrSet_log_stat(imp_dbh, + imp_dbh->seshp,OCI_HTYPE_SESSION, + client_info,(ub4)vl, + OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) (void)oci_error( + dbh, imp_dbh->errhp, status, + "OCIAttrSet OCI_ATTR_CLIENT_INFO"); } +#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->seshp,OCI_HTYPE_SESSION, imp_dbh->module_name,imp_dbh->module_namel,OCI_ATTR_MODULE,imp_dbh->errhp, status); - + char * module_name = (char *) SvPV (valuesv, vl ); + OCIAttrSet_log_stat(imp_dbh, + imp_dbh->seshp,OCI_HTYPE_SESSION, + module_name, (ub4)vl, + OCI_ATTR_MODULE,imp_dbh->errhp, status + ); + if(status != OCI_SUCCESS) (void)oci_error( + dbh, imp_dbh->errhp, status, + "OCIAttrSet OCI_ATTR_MODULE"); } +#endif else if (kl==20 && strEQ(key, "ora_oci_success_warn") ) { oci_warn = SvIV (valuesv); } @@ -1249,6 +1070,7 @@ dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) SV *retsv = Nullsv; /* Default to caching results for DBI dispatch quick_FETCH */ int cacheit = FALSE; + sword status; /* AutoCommit FETCH via DBI */ @@ -1257,45 +1079,116 @@ dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) } #ifdef ORA_OCI_112 else if (kl==15 && strEQ(key, "ora_driver_name") ) { - retsv = newSVpv((char *)imp_dbh->driver_name,0); + char * driver_name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &driver_name, + &namelen, OCI_ATTR_DRIVER_NAME, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) + retsv = newSVpv(driver_name, namelen); } else if (kl==8 && strEQ(key, "ora_drcp") ) { - retsv = newSViv(imp_dbh->using_drcp); + retsv = newSViv(cnx_is_pooled_session(aTHX_ dbh, imp_dbh)); } else if (kl==14 && strEQ(key, "ora_drcp_class") ) { - retsv = newSVpv((char *)imp_dbh->pool_class, 0); - } + char * pool_name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &pool_name, + &namelen, OCI_ATTR_CONNECTION_CLASS, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) + retsv = newSVpv(pool_name, namelen); + else (void)oci_error(dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_CONNECTION_CLASS"); + } + else if (kl==12 && strEQ(key, "ora_drcp_tag") ) { + if(imp_dbh->session_tag) + { + retsv = imp_dbh->session_tag; + SvREFCNT_inc(retsv); + } + } else if (kl==12 && strEQ(key, "ora_drcp_min") ) { - retsv = newSViv(imp_dbh->pool_min); + retsv = newSViv(cnx_get_pool_min(aTHX_ dbh, imp_dbh)); + } + else if (kl==13 && strEQ(key, "ora_drcp_mode") ) { + retsv = newSViv(cnx_get_pool_mode(aTHX_ dbh, imp_dbh)); + } +#if OCI_MAJOR_VERSION > 18 + else if (kl==13 && strEQ(key, "ora_drcp_wait") ) { + retsv = newSViv(cnx_get_pool_wait(aTHX_ dbh, imp_dbh)); } +#endif else if (kl==12 && strEQ(key, "ora_drcp_max") ) { - retsv = newSViv(imp_dbh->pool_max); + retsv = newSViv(cnx_get_pool_max(aTHX_ dbh, imp_dbh)); } else if (kl==13 && strEQ(key, "ora_drcp_incr") ) { - retsv = newSViv(imp_dbh->pool_incr); + retsv = newSViv(cnx_get_pool_incr(aTHX_ dbh, imp_dbh)); } -#endif - else if (kl==7 && strEQ(key, "ora_taf") ) { - retsv = newSViv(imp_dbh->using_taf); + else if (kl==12 && strEQ(key, "ora_drcp_rlb") ) { + retsv = newSViv(cnx_get_pool_rlb(aTHX_ dbh, imp_dbh)); } - else if (kl==16 && strEQ(key, "ora_taf_function") ) { - retsv = newSVpv((char *)imp_dbh->taf_function,0); + else if (kl==13 && strEQ(key, "ora_drcp_used") ) { + retsv = newSViv(cnx_get_pool_used(aTHX_ dbh, imp_dbh)); } - else if (kl==13 && strEQ(key, "ora_taf_sleep") ) { - retsv = newSViv(imp_dbh->taf_sleep); +#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); + char * name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &name, + &namelen, OCI_ATTR_ACTION, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) retsv = newSVpv(name, namelen); + else (void)oci_error(dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_ACTION"); } +#endif else if (kl==21 && strEQ(key, "ora_client_identifier")) { - retsv = newSVpv((char *)imp_dbh->client_identifier,0); - } + char * name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &name, + &namelen, OCI_ATTR_CLIENT_IDENTIFIER, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) retsv = newSVpv(name, namelen); + else (void)oci_error(dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_CLIENT_IDENTIFIER"); + } +#ifdef OCI_ATTR_CLIENT_INFO else if (kl==15 && strEQ(key, "ora_client_info")) { - retsv = newSVpv((char *)imp_dbh->client_info,0); + char * name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &name, + &namelen, OCI_ATTR_CLIENT_INFO, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) retsv = newSVpv(name, namelen); + else (void)oci_error(dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_CLIENT_INFO"); } +#endif +#ifdef OCI_ATTR_MODULE else if (kl==15 && strEQ(key, "ora_module_name")) { - retsv = newSVpv((char *)imp_dbh->module_name,0); + char * name; + ub4 namelen; + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, &name, + &namelen, OCI_ATTR_MODULE, imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS) retsv = newSVpv(name, namelen); + else (void)oci_error(dbh, imp_dbh->errhp, status, + "OCIAttrGet OCI_ATTR_MODULE"); } +#endif else if (kl==20 && strEQ(key, "ora_oci_success_warn")) { retsv = newSViv (oci_warn); } @@ -1368,26 +1261,27 @@ createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){ len = SvLEN(source); bufp = SvPV(source, len); - if (DBIS->debug >=3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " creating xml from string that is %lu long\n",(unsigned long)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 (DBIS->debug >=5 || dbd_verbose >= 5 ) - PerlIO_printf(DBILOGFP, " use a temp lob locator for large xml \n"); + 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->envhp, &src_ptr, OCI_DTYPE_LOB); + OCIDescriptorAlloc_ok(imp_dbh, imp_dbh->envhp, &src_ptr, OCI_DTYPE_LOB); - OCILobCreateTemporary_log_stat(imp_dbh->svchp, imp_sth->errhp, + 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); + csid = (SvUTF8(source) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(imp_dbh, csform); buflen = len; - OCILobWriteAppend_log_stat(imp_dbh->svchp, imp_dbh->errhp, src_ptr, + 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); @@ -1398,8 +1292,9 @@ createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){ } else { src_type = OCI_XMLTYPE_CREATE_OCISTRING; - if (DBIS->debug >=5 || dbd_verbose >= 5 ) - PerlIO_printf(DBILOGFP, " use a OCIStringAssignText for small xml \n"); + 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, @@ -1409,13 +1304,15 @@ createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){ - status = OCIXMLTypeCreateFromSrc(imp_dbh->svchp, - imp_dbh->errhp, - (OCIDuration)OCI_DURATION_CALLOUT, - (ub1)src_type, - (dvoid *)src_ptr, - (sb4)OCI_IND_NOTNULL, - &xml); + 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"); @@ -1426,7 +1323,7 @@ createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){ OCILobFreeTemporary(imp_dbh->svchp, imp_dbh->errhp, (OCILobLocator*) src_ptr); - OCIDescriptorFree((dvoid *) src_ptr, (ub4) OCI_DTYPE_LOB); + OCIDescriptorFree_log(imp_dbh, (dvoid *) src_ptr, (ub4) OCI_DTYPE_LOB); } @@ -1454,7 +1351,7 @@ 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 */ - imp_sth->statement = (char*)safemalloc(strlen(statement) * 10); + Newz(0,imp_sth->statement,strlen(statement) * 10,char); /* initialise phs ready to be cloned per placeholder */ memset(&phs_tpl, 0, sizeof(phs_tpl)); @@ -1554,18 +1451,24 @@ phs_t *phs; 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); + /* allocate and copy enough for phs_tpl */ + phs_sv = newSVpvn((char*)&phs_tpl, sizeof(phs_tpl)); (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. */ + /* allocate extra room for the name (returns the PV) */ + phs = (phs_t*)(void*)SvGROW(phs_sv, sizeof(phs_tpl)+namelen+1); + phs->idx = idx-1; /* Will be 0 for :1, -1 for :foo. */ + /* tell the SV the full length */ + SvCUR_set(phs_sv, sizeof(phs_tpl)+namelen); + /* copy the name */ 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 (DBIS->debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", - (int)DBIc_NUM_PARAMS(imp_sth)); + 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)); } } @@ -1685,9 +1588,9 @@ int dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; - /*D_imp_dbh_from_sth ;*/ + D_imp_dbh_from_sth; sword status; - int trace_level = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; ub1 csform; ub2 csid; @@ -1702,7 +1605,8 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) arr=(AV*)(SvRV(phs->sv)); if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): array_numstruct=%d\n", + 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, @@ -1714,15 +1618,18 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if( numarrayentries >= 0 ){ phs->array_numstruct = numarrayentries+1; if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): array_numstruct=%d (calculated) \n", - phs->array_numstruct); + 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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): original csform=%d\n", - (int)csform); + 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 ); @@ -1745,7 +1652,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) sv_2pv(item, &length); } } else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */ - if(SvUPGRADE(item, SVt_PV)){} + (void)SvUPGRADE(item, SVt_PV); } } if( length == 0 ){ @@ -1755,31 +1662,40 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) maxlen=length+1; } if (trace_level >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n", - i,(int)length); + 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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i); + 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 */ + if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_NCHAR)) /* prefer NCHAR */ csform = SQLCS_NCHAR; - else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) + else if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT)) csform = SQLCS_IMPLICIT; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name, + 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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i); } } } @@ -1787,13 +1703,17 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if( phs->maxlen <=0 ){ phs->maxlen=maxlen; if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): phs->maxlen calculated =%ld\n", - (long)maxlen); + 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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n", - (long)maxlen); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + "dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n", + (long)maxlen); } } } @@ -1819,13 +1739,16 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) 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 ); + 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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n", - need_allocate_rows,buflen); - } + 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 @@ -1836,57 +1759,63 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) /* Fill array buffer with string data */ { - int i; /* Not to require C99 mode */ - for(i=0;i0) ){ + int i; /* Not to require C99 mode */ + for(i=0;i0) ){ /* 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(DBILOGFP, "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(DBILOGFP, "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(DBILOGFP, "dbd_rebind_ph_varchar2_table(): " - "Copying length=? array[%d]=NULL av_fetch failed.\n", i); - } - } - } + 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->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->array_buf, phs->maxlen, (ub2)SQLT_STR, phs->array_indicators, phs->array_lengths, /* ub2 *alen_ptr not needed with OCIBindDynamic */ - (ub2)0, + NULL, (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 */ @@ -1896,7 +1825,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) oci_error(sth, imp_sth->errhp, status, "OCIBindByName"); return 0; } - OCIBindArrayOfStruct_log_stat(phs->bndhp, imp_sth->errhp, + 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 */ @@ -1909,7 +1838,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) /* Fixup charset */ if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ - OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -1918,7 +1847,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) } if (!phs->csid_orig) { /* get the default csid Oracle would use */ - OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , + OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, NULL, OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } @@ -1930,7 +1859,9 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) csid = utf8_csid; /* not al32utf8_csid here on purpose */ if (trace_level >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): bind %s <== %s " + 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", @@ -1941,7 +1872,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (csid) { - OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -1950,7 +1881,7 @@ dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) } if (phs->maxdata_size) { - OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND, + 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)")); @@ -1964,10 +1895,10 @@ dbd_rebind_ph_varchar2_table(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(phs_t *phs){ +int dbd_phs_varchar_table_posy_exe(imp_sth_t *imp_sth, phs_t *phs){ dTHX; - int trace_level = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ @@ -1975,7 +1906,7 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ neatsvpv(phs->sv,0), phs->name); } if (trace_level >= 1 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + 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, @@ -2015,14 +1946,14 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ if( item ){ SvSetMagicSV(item,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + 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(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n",i); } } @@ -2031,7 +1962,7 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){ /* Truncation occurred */ if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): Placeholder '%s': data truncated at %d row.\n", phs->name,i); } @@ -2043,7 +1974,7 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ 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(DBILOGFP, + 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 @@ -2053,7 +1984,7 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ 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(DBILOGFP, + 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 @@ -2064,7 +1995,7 @@ int dbd_phs_varchar_table_posy_exe(phs_t *phs){ } } if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): scalar(@arr)=%ld.\n", (long)av_len(arr)+1); } @@ -2076,7 +2007,7 @@ 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 = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; int need_allocate_rows; int buflen; @@ -2084,25 +2015,27 @@ int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { /*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); + 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; + 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); - } + 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(DBILOGFP, "dbd_rebind_ph_number_table(): array_numstruct=%d\n", - phs->array_numstruct); + 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.*/ @@ -2112,7 +2045,9 @@ int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { if( numarrayentries >= 0 ){ phs->array_numstruct = numarrayentries+1; if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n", + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + "dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n", phs->array_numstruct); } } @@ -2122,16 +2057,18 @@ int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { * maxlen(double) = sizeof(double); */ switch( phs->ora_internal_type ){ - case SQLT_INT: + case SQLT_INT: phs->maxlen=sizeof(int); break; - case SQLT_FLT: - default: + case SQLT_FLT: + default: phs->maxlen=sizeof(double); } if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): phs->maxlen calculated =%ld\n", - (long)phs->maxlen); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + "dbd_rebind_ph_number_table(): phs->maxlen calculated =%ld\n", + (long)phs->maxlen); } if( phs->array_numstruct == 0 ){ @@ -2139,189 +2076,208 @@ int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { phs->array_numstruct=1; } if( phs->ora_maxarray_numentries== 0 ){ - /* Zero means "use current array length". */ + /* Zero means "use current array length". */ phs->ora_maxarray_numentries=phs->array_numstruct; if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): ora_maxarray_numentries assumed=phs->array_numstruct=%d\n", + 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(DBILOGFP, "dbd_rebind_ph_number_table(): ora_maxarray_numentries=%d\n", - phs->ora_maxarray_numentries); + 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; + 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 ); + 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(DBILOGFP, "dbd_rebind_ph_number_table(): ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n", - need_allocate_rows,buflen); - } + 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; + phs->array_numstruct = phs->ora_maxarray_numentries; } /* Fill array buffer with data */ { - int i; /* Not to require C99 mode */ - for(i=0;iora_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(DBILOGFP, "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(DBILOGFP, "dbd_rebind_ph_number_table(): " - "let (double) array[%d]=%lf - 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(DBILOGFP, "dbd_rebind_ph_number_table(): " - "let (double) array[%d]=\"%s\" =NaN. Set =0 - NOT NULL\n", - i, p ? p : "" ); - } - }else{ - /* NULL */ - phs->array_indicators[i]=1; - if (trace_level >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, "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(DBILOGFP, "dbd_rebind_ph_number_table(): " - "(double) array[%d]=%lf%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(DBILOGFP, "dbd_rebind_ph_number_table(): " - "Copying length=? array[%d]=NULL av_fetch failed.\n", i); - } - } - } + int i; /* Not to require C99 mode */ + for(i=0;iora_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 : "" ); + } + }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->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 - ); + 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, + NULL, + (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(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); + 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; + oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct"); + return 0; } if (phs->maxdata_size) { - OCIAttrSet_log_stat(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; - } + 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; @@ -2330,10 +2286,10 @@ int dbd_rebind_ph_number_table(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_number_table_post_exe(phs_t *phs){ +int dbd_phs_number_table_post_exe(imp_sth_t *imp_sth, phs_t *phs){ dTHX; - int trace_level = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ @@ -2341,7 +2297,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ neatsvpv(phs->sv,0), phs->name); } if (trace_level >= 1 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + 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, @@ -2387,7 +2343,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ if( item ){ SvSetMagicSV(item,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = undef; SvSetMagicSV(item,&PL_sv_undef);\n", i ); @@ -2395,7 +2351,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ }else{ av_store(arr,i,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n", i ); @@ -2405,7 +2361,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){ /* Truncation occurred */ if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): Placeholder '%s': data truncated at %d row.\n", phs->name,i); } @@ -2416,7 +2372,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ switch(phs->ora_internal_type){ case SQLT_INT: if (trace_level >= 4 || dbd_verbose >= 4 ){ - PerlIO_printf(DBILOGFP, + 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) ); @@ -2425,8 +2381,8 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ break; case SQLT_FLT: if (trace_level >= 4 || dbd_verbose >= 4 ){ - PerlIO_printf(DBILOGFP, - "dbd_phs_number_table_post_exe(): (double) set arr[%d] = %lf \n", + 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) ); } @@ -2435,7 +2391,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ if (trace_level >= 3 || dbd_verbose >= 3 ){ STRLEN l; char *str= SvPOK(item) ? SvPV(item,l) : "" ; - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n", i, str ? str : "" ); @@ -2444,7 +2400,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ switch(phs->ora_internal_type){ case SQLT_INT: if (trace_level >= 4 || dbd_verbose >= 4 ){ - PerlIO_printf(DBILOGFP, + 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) ); @@ -2453,8 +2409,8 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ break; case SQLT_FLT: if (trace_level >= 4 || dbd_verbose >= 4 ){ - PerlIO_printf(DBILOGFP, - "dbd_phs_number_table_post_exe(): (double) store new arr[%d] = %lf \n", + 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) ); } @@ -2468,7 +2424,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ item=*pitem; } str= item ? ( SvPOK(item) ? SvPV(item,l) : "" ) : ""; - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n", i, str ? str : "" ); @@ -2478,7 +2434,7 @@ int dbd_phs_number_table_post_exe(phs_t *phs){ } } if (trace_level >= 2 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, + PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): scalar(@arr)=%ld.\n", (long)av_len(arr)+1); } @@ -2502,19 +2458,26 @@ dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs) sv_2pv(phs->sv, &PL_na); } else /* ensure we're at least an SVt_PV (so SvPVX etc work) */ - if(SvUPGRADE(phs->sv, SVt_PV)){} /* For gcc not to warn on unused result)*/; + (void) SvUPGRADE(phs->sv, SVt_PV); } - if (DBIS->debug >= 2 || dbd_verbose >= 3 ) { + if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) { char *val = neatsvpv(phs->sv,10); - PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (1): bind %s <== %.1000s (", phs->name, val); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + "dbd_rebind_ph_char() (1): 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),(long)phs->maxlen); - PerlIO_printf(DBILOGFP, "ptype %d(%s), otype %d %s)\n",(int)SvTYPE(phs->sv), sql_typecode_name(phs->ftype),phs->ftype,(phs->is_inout) ? ", inout" : ""); - - + 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. */ @@ -2527,19 +2490,28 @@ dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs) 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); + 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", + (long)(phs->maxlen - 1), (long)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 */ - SvGROW(phs->sv, (STRLEN)(((unsigned int) phs->maxlen <= min_len) ? min_len : (unsigned int) phs->maxlen)+1/*for null*/); - + /* 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", + (long)(phs->maxlen +1), (long)SvLEN(phs->sv)); + } } } @@ -2569,7 +2541,11 @@ dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs) phs->maxlen = 4000; /* Just make is a varchar max should be ok for most things*/ } else { - phs->maxlen = ((IV)SvLEN(phs->sv)); /* avail buffer space (64bit safe) Logicaly maxlen should never change but it does why I know not*/ + if (DBIc_DBISTATE(imp_sth)->debug >= 6|| dbd_verbose >= 6 ) { + PerlIO_printf(DBIc_LOGPIO(imp_sth), + "Changing maxlen to %ld\n", (long)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 */ } @@ -2579,14 +2555,17 @@ dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs) phs->alen = value_len + phs->alen_incnull; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) { - UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen; + 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(DBILOGFP, "dbd_rebind_ph_char() (2): bind %s <== '%.*s' (size %ld/%ld, otype %d(%s), indp %d, at_exec %d)\n", + 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, - (int)(phs->alen > neatsvpvlen ? neatsvpvlen : phs->alen), (phs->progv) ? val: "", - (long)phs->alen, (long)phs->maxlen, phs->ftype,sql_typecode_name(phs->ftype), phs->indp, at_exec); + (long)phs->alen, (long)phs->maxlen, + phs->ftype,sql_typecode_name(phs->ftype), phs->indp, at_exec); } return 1; @@ -2607,10 +2586,15 @@ pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs) D_impdata(imp_sth_csr, imp_sth_t, sth_csr); sword status; - if (DBIS->debug >= 3 || dbd_verbose >= 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); + 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->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), &imp_sth_csr->stmhp, 0, @@ -2627,8 +2611,8 @@ pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs) return 0; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " pp_rebind_ph_rset_in: END\n"); + 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; } @@ -2637,41 +2621,40 @@ pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs) int pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec) { -dTHX; + dTHX; - if (pre_exec) { /* pre-execute - allocate a statement handle */ - dSP; - D_imp_dbh_from_sth; - HV *init_attr = newHV(); - int count; + if (pre_exec) { /* pre-execute - throw away previous descriptor and rebind */ sword status; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " pp_exec_rset bind %s - allocating new sth...\n", phs->name); - - /* extproc deallocates everything for us */ - if (is_extproc) - return 1; + 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); 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); + 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->envhp, &phs->desc_h, phs->desc_t, status); + 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->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, 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, @@ -2685,6 +2668,57 @@ dTHX; 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 + */ + } + 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); + } + + /* 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; + } + + /* Now we know we have an executed cursor create a new sth */ ENTER; SAVETMPS; PUSHMARK(SP); @@ -2703,46 +2737,50 @@ dTHX; PUTBACK; FREETMPS; LEAVE; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " pp_exec_rset bind %s - allocated %s...\n", - phs->name, neatsvpv(phs->sv, 0)); - - } - 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 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " bind %s - initialising new %s for cursor 0x%lx...\n", - phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv); - - /* 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; - } + 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%p...\n", + phs->name, neatsvpv(sth_csr,0), phs->progv); + + { + D_impdata(imp_sth_csr, imp_sth_t, sth_csr); /* TO_DO */ + + /* copy appropriate handles and attributes 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; + } + } } return 1; @@ -2758,8 +2796,8 @@ sword status; SV* ptr; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " in dbd_rebind_ph_xml\n"); + 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*/ @@ -2771,12 +2809,19 @@ sword status; /* ensure that the value is a support named object type */ /* (currently only OCIXMLType*) */ if ( sv_isa(phs->sv, "OCIXMLTypePtr") ) { - OCITypeByName(imp_sth->envhp, imp_sth->errhp, imp_sth->svchp, - (CONST text*)"SYS", 3, - (CONST text*)"XMLTYPE", 7, - (CONST text*)0, 0, - OCI_DURATION_CALLOUT, OCI_TYPEGET_HEADER, - &tdo); + /* 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*); @@ -2787,7 +2832,7 @@ sword status; /* bind by name */ - 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), (dvoid *) NULL, /* value supplied in BindObject later */ 0, @@ -2803,8 +2848,8 @@ sword status; oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY"); return 0; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " pp_rebind_ph_nty: END\n"); + 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 */ @@ -2824,17 +2869,23 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; /*ub2 *alen_ptr = NULL;*/ + D_imp_dbh_from_sth; sword status; int done = 0; int at_exec; - int trace_level = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; ub1 csform; ub2 csid; if (trace_level >= 5 || dbd_verbose >= 5 ) - PerlIO_printf(DBILOGFP, "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); + 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: @@ -2859,13 +2910,14 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself successfully */ if (trace_level >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " rebind %s done with ftype %d (%s)\n", + 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(DBILOGFP, " bind %s as ftype %d (%s)\n", + 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) { @@ -2875,7 +2927,7 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) 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 */ @@ -2892,7 +2944,7 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) 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); @@ -2908,12 +2960,14 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (!csform && SvUTF8(phs->sv)) { /* try to default csform to avoid translation through non-unicode */ - if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */ + if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT)) /* prefer IMPLICIT */ csform = SQLCS_IMPLICIT; - else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) + else if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_NCHAR)) csform = SQLCS_NCHAR; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3) - PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (2): rebinding %s with UTF8 value %s", phs->name, + 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"); @@ -2921,7 +2975,7 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ - OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -2930,7 +2984,7 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) } if (!phs->csid_orig) { /* get the default csid Oracle would use */ - OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , + OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, NULL, OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } @@ -2942,18 +2996,21 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) csid = utf8_csid; /* not al32utf8_csid here on purpose */ if (trace_level >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "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); - + 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(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -2962,7 +3019,7 @@ dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) } if (phs->maxdata_size) { - OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND, + 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)")); @@ -3020,15 +3077,16 @@ dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue, IV sql_typ 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 || dbd_verbose >= 3 ) { - PerlIO_printf(DBILOGFP, "dbd_bind_ph(1): bind %s <== %s (type %ld (%s)", + 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(DBILOGFP, ", inout 0x%lx, maxlen %ld", - (long)newvalue, (long)maxlen); + PerlIO_printf(DBIc_LOGPIO(imp_sth), ", inout 0x%p, maxlen %ld", + newvalue, (long)maxlen); if (attribs) - PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0)); - PerlIO_printf(DBILOGFP, ")\n"); + 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); @@ -3158,12 +3216,13 @@ dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue, IV sql_typ 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); + } else { + if (newvalue != phs->sv) { + if (phs->sv) + SvREFCNT_dec(phs->sv); - phs->sv = SvREFCNT_inc(newvalue); /* point to live var */ + phs->sv = SvREFCNT_inc(newvalue); /* point to live var */ + } } return dbd_rebind_ph(sth, imp_sth, phs); @@ -3173,9 +3232,10 @@ dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue, IV sql_typ /* --- 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) { dTHX; + D_imp_dbh_from_sth; char *note = ""; /* XXX doesn't check arcode for error, caller is expected to */ @@ -3194,6 +3254,13 @@ dbd_phs_sv_complete(phs_t *phs, SV *sv, I32 debug) SvCUR_set(sv, phs->alen); *SvEND(sv) = '\0'; SvPOK_only_UTF8(sv); + if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT)) { +#ifdef sv_utf8_decode + sv_utf8_decode(sv); +#else + SvUTF8_on(sv); +#endif + } } else { /* shouldn't happen */ debug = 2; @@ -3211,6 +3278,13 @@ dbd_phs_sv_complete(phs_t *phs, SV *sv, I32 debug) SvCUR_set(sv, phs->alen); *SvEND(sv) = '\0'; SvPOK_only_UTF8(sv); + if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT)) { +#ifdef sv_utf8_decode + sv_utf8_decode(sv); +#else + SvUTF8_on(sv); +#endif + } } else { /* shouldn't happen */ debug = 2; @@ -3237,14 +3311,15 @@ dbd_phs_sv_complete(phs_t *phs, SV *sv, I32 debug) } } 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) { dTHX; AV *av = (AV*)SvRV(phs->sv); SV *sv = *av_fetch(av, index, 1); - dbd_phs_sv_complete(phs, sv, 0); + dbd_phs_sv_complete(imp_sth, phs, sv, 0); if (debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_phs_avsv_complete out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n", + 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); } @@ -3258,7 +3333,7 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- dTHR; dTHX; ub4 row_count = 0; - int debug = DBIS->debug; + 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; @@ -3266,9 +3341,10 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- if (debug >= 2 || dbd_verbose >= 3 ) - 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); - + 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 */ @@ -3298,11 +3374,12 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- else if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { if (debug >= 2 || dbd_verbose >= 3 ) - 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)); + 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 @@ -3323,12 +3400,15 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- 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(DBILOGFP, - " with %s = '%.*s' (len %ld(%ld)/%ld, indp %d, otype %d, ptype %d)\n", + 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)); + (phs->indp == -1) ? "" : SvPVX(sv), + (long)phs->alen, (long)prev_alen, + (long)phs->maxlen, phs->indp, + phs->ftype, (int)SvTYPE(sv)); } } } @@ -3344,9 +3424,12 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- if (debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP,"Statement Execute Mode is %d (%s)\n",imp_sth->exe_mode,oci_exe_mode(imp_sth->exe_mode)); + 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->svchp, imp_sth->stmhp, imp_sth->errhp, + 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); @@ -3364,7 +3447,7 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- 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*/ + as we may have more than one exe on a prepare*/ rs_array_init(imp_sth); } else { @@ -3374,7 +3457,8 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- if (debug >= 2 || dbd_verbose >= 3 ) { ub2 sqlfncode; OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status); - PerlIO_printf(DBILOGFP, + 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), @@ -3399,16 +3483,18 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- 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(DBILOGFP, - "dbd_st_execute(): Analyzing inout a parameter '%s of type=%d name=%s'\n", + 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(phs); + dbd_phs_varchar_table_posy_exe(imp_sth, phs); continue; } if( phs->ftype == ORA_NUMBER_TABLE ){ - dbd_phs_number_table_post_exe(phs); + dbd_phs_number_table_post_exe(imp_sth, phs); continue; } @@ -3421,10 +3507,10 @@ dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (- AV *av = (AV*)SvRV(sv); I32 avlen = AvFILL(av); if (avlen >= 0) - dbd_phs_avsv_complete(phs, avlen, debug); + dbd_phs_avsv_complete(imp_sth, phs, avlen, debug); } else { - dbd_phs_sv_complete(phs, sv, debug); + dbd_phs_sv_complete(imp_sth, phs, sv, debug); } } } @@ -3443,15 +3529,16 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat int parma_index; { dTHX; + D_imp_dbh_from_sth; sword status; ub1 csform; ub2 csid; - int trace_level = DBIS->debug; + int trace_level = DBIc_DBISTATE(imp_sth)->debug; int i; - 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), 0, - phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */ + (sb4)phs->maxlen, (ub2)phs->ftype, 0, NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */ 0, @@ -3465,7 +3552,7 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat } - 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) { @@ -3478,12 +3565,14 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat if (!csform && (utf8 & ARRAY_BIND_UTF8)) { /* try to default csform to avoid translation through non-unicode */ - if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */ + if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT)) /* prefer IMPLICIT */ csform = SQLCS_IMPLICIT; - else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) + else if (CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_NCHAR)) csform = SQLCS_NCHAR; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "do_bind_array_exec() (2): rebinding %s with UTF8 value %s", phs->name, + 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"); @@ -3491,7 +3580,7 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ - OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -3500,7 +3589,7 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat } if (!phs->csid_orig) { /* get the default csid Oracle would use */ - OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , + OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, NULL, OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } @@ -3532,18 +3621,21 @@ do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_stat } if (trace_level >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, "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", + 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), + 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(phs->bndhp, (ub4) OCI_HTYPE_BIND, + 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)")); @@ -3584,7 +3676,7 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er dTHX; dTHR; ub4 row_count = 0; - int debug = DBIS->debug; + 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); @@ -3602,13 +3694,16 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er STRLEN len; int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0; int *utf8_flgs; - tuples_utf8_av=newAV(); + tuples_utf8_av = newAV(); + sv_2mortal((SV*)tuples_utf8_av); if (debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " 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)); + 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 " @@ -3661,10 +3756,8 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er Still ensures proper OCIBindByName*/ param_count=DBIc_NUM_PARAMS(imp_sth); - phs = safemalloc(param_count*sizeof(*phs)); - utf8_flgs = safemalloc(param_count*sizeof(int)); - memset(phs, 0, param_count*sizeof(*phs)); - memset(utf8_flgs, 0, param_count*sizeof(int)); + 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 @@ -3717,7 +3810,8 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er /*check to see if value sv is a null (undef) if it is upgrade it*/ if (!SvOK(sv)) { - if(SvUPGRADE(sv, SVt_PV)){} /* For GCC not to warn on unused result */ + (void)SvUPGRADE(sv, SVt_PV); + len = 0; } else { SvPV(sv, len); @@ -3753,8 +3847,6 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er } } } - Safefree(phs); - Safefree(utf8_flgs); /* Store array of bind typles, for use in OCIBindDynamic() callback. */ imp_sth->bind_tuples = tuples_av; imp_sth->rowwise = (columns_av == NULL); @@ -3763,7 +3855,7 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er if(autocommit) oci_mode |= OCI_COMMIT_ON_SUCCESS; - OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp, + OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp, exe_count, 0, 0, 0, oci_mode, exe_status); OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status); @@ -3785,7 +3877,7 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er AV *av = (AV*)SvRV(sv); I32 avlen = AvFILL(av); for (j=0;j<=avlen;j++){ - dbd_phs_avsv_complete(phs, j, debug); + dbd_phs_avsv_complete(imp_sth, phs, j, debug); } } } @@ -3794,8 +3886,13 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS, status); if (debug >= 6 || dbd_verbose >= 6 ) - PerlIO_printf(DBILOGFP, " ora_st_execute_array %d errors in batch.\n", - num_errs); + 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); + } if(num_errs && tuples_status_av) { OCIError *row_errhp, *tmp_errhp; @@ -3803,34 +3900,36 @@ ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, er SV *err_svs[3]; /*AV *err_av;*/ sb4 err_code; - sv_setiv(err_count,num_errs); + err_svs[0] = newSViv((IV)0); err_svs[1] = newSVpvn("", 0); err_svs[2] = newSVpvn("S1000",5); - OCIHandleAlloc_ok(imp_sth->envhp, &row_errhp, OCI_HTYPE_ERROR, status); - OCIHandleAlloc_ok(imp_sth->envhp, &tmp_errhp, OCI_HTYPE_ERROR, status); + 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->errhp, OCI_HTYPE_ERROR, + OCIParamGet_log_stat(imp_sth, imp_sth->errhp, OCI_HTYPE_ERROR, tmp_errhp, (dvoid *)&row_errhp, (ub4)i, status); - OCIAttrGet_log_stat(row_errhp, OCI_HTYPE_ERROR, &row_off, 0, + 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(DBILOGFP, " ora_st_execute_array error in row %d.\n", - row_off); + 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(row_errhp, exe_status, NULL, err_svs[1], debug); + 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(tmp_errhp, OCI_HTYPE_ERROR, status); - OCIHandleFree_log_stat(row_errhp, OCI_HTYPE_ERROR, status); + 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->svchp, imp_sth->errhp, + 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"); @@ -3856,6 +3955,7 @@ dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, dTHX; ub4 retl = 0; SV *bufsv; + D_imp_dbh_from_sth; imp_fbh_t *fbh = &imp_sth->fbh[field]; int ftype = fbh->ftype; @@ -3863,7 +3963,7 @@ dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, sv_setpvn(bufsv,"",0); /* ensure it's writable string */ #ifdef UTF8_SUPPORT - if (ftype == 112 && CS_IS_UTF8(ncharsetid) ) { + if (ftype == 112 && CS_IS_UTF8(imp_dbh->ncset) ) { return ora_blob_read_mb_piece(sth, imp_sth, fbh, bufsv, offset, len, destoffset); } @@ -3877,11 +3977,13 @@ dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, ora_free_templob(sth, imp_sth, (OCILobLocator*)fbh->desc_h); return 0; } - ftype = ftype; /* no unused */ + (void)ftype; /* no unused */ - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " blob_read field %d+1, ftype %d, offset %ld, len %ld, destoffset %ld, retlen %ld\n", + 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); @@ -3947,7 +4049,7 @@ dbd_st_finish(SV *sth, imp_sth_t *imp_sth) not sure if we need this for non scrolling cursors they should die on a OER(1403) no records)*/ - OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp, 0, + 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) { @@ -3959,25 +4061,45 @@ dbd_st_finish(SV *sth, imp_sth_t *imp_sth) void -ora_free_fbh_contents(imp_fbh_t *fbh) +ora_free_fbh_contents(SV *sth, imp_fbh_t *fbh) { 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); - if (fbh->desc_h) - OCIDescriptorFree_log(fbh->desc_h, fbh->desc_t); - if (fbh->obj) + + /* 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_t *phs) +ora_free_phs_contents(imp_sth_t *imp_sth, phs_t *phs) { dTHX; if (phs->desc_h) - OCIDescriptorFree_log(phs->desc_h, phs->desc_t); + OCIDescriptorFree_log(imp_sth, phs->desc_h, phs->desc_t); if( phs->array_buf ){ free(phs->array_buf); phs->array_buf=NULL; @@ -4004,17 +4126,19 @@ ora_free_templob(SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc) #if defined(OCI_HTYPE_DIRPATH_FN_CTX) /* >= 9.0 */ boolean is_temporary = 0; sword status; - OCILobIsTemporary_log_stat(imp_sth->envhp, imp_sth->errhp, lobloc, &is_temporary, 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) { - PerlIO_printf(DBILOGFP, " OCILobFreeTemporary %s\n", oci_status_name(status)); + 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->svchp, imp_sth->errhp, lobloc, 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; @@ -4031,6 +4155,7 @@ dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) int i; sword status; dTHX ; + D_imp_dbh_from_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 @@ -4041,13 +4166,12 @@ dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) /* 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->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); + if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY && DBIc_ACTIVE(imp_dbh)) { + OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); } if (imp_sth->dschp){ - OCIHandleFree_log_stat(imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); } @@ -4058,7 +4182,7 @@ dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) if (!PL_dirty) { /* XXX not ideal, leak may be a problem in some cases */ if (!imp_sth->nested_cursor) { - OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status); if (status != OCI_SUCCESS) oci_error(sth, imp_sth->errhp, status, "OCIHandleFree"); } @@ -4074,7 +4198,7 @@ dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) imp_sth->eod_errno = 1403; for(i=0; i < fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i]; - ora_free_fbh_contents(fbh); + ora_free_fbh_contents(sth, fbh); } Safefree(imp_sth->fbh); if (imp_sth->fbh_cbuf) @@ -4095,7 +4219,7 @@ dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) 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(phs); + ora_free_phs_contents(imp_sth, phs); } } sv_free((SV*)imp_sth->all_params_hv); @@ -4124,7 +4248,7 @@ dbd_st_STORE_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv) if (cachesv) /* cache value for later DBI 'quick' fetch? */ (void)hv_store((HV*)SvRV(sth), key, kl, cachesv, 0); - return TRUE; + return TRUE; } @@ -4132,6 +4256,7 @@ SV * dbd_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv) { dTHX; + D_imp_dbh_from_sth; STRLEN kl; char *key = SvPV(keysv,kl); int i; @@ -4158,10 +4283,20 @@ dbd_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv) 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)); + SV *x; + retsv = newRV(sv_2mortal((SV*)av)); + while(--i >= 0) { + x = newSVpv((char*)imp_sth->fbh[i].name,0); + if (CSFORM_IMPLIES_UTF8(imp_dbh, 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(); @@ -4317,24 +4452,65 @@ ora2sql_type(imp_fbh_t* fbh) { } static void -dump_env_to_trace() { +dump_env_to_trace(imp_dbh_t *imp_dbh) { dTHX; - PerlIO *fp = DBILOGFP; int i = 0; char *p; + char ** env; #if defined (__APPLE__) #include - #define environ (*_NSGetEnviron()) -#elif defined (__BORLANDC__) + env = *_NSGetEnviron(); +#else +#if defined (__BORLANDC__) extern char **environ; #endif + env = environ; +#endif - PerlIO_printf(fp, "Environment variables:\n"); - do { - p = (char*)environ[i++]; - PerlIO_printf(fp,"\t%s\n",p); - } while ((char*)environ[i] != '\0'); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Environment variables:\n"); + while(env[i] != NULL) + { + p = env[i++]; + PerlIO_printf(DBIc_LOGPIO(imp_dbh),"\t%s\n",p); + } } +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( pTHX_ SV *dbh, imp_dbh_t *imp_dbh) +{ + + boolean 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 + + if (!can_taf) + return local_error(aTHX_ dbh, + "You are attempting to enable TAF on a server that is not TAF Enabled"); + + + status = reg_taf_callback(dbh, imp_dbh); + if (status != OCI_SUCCESS) + return oci_error(dbh, NULL, status, "Setting TAF Callback Failed! "); + return 1; +} + + diff --git a/dbdimp.h b/dbdimp.h index 632e2814..67e444f3 100644 --- a/dbdimp.h +++ b/dbdimp.h @@ -11,16 +11,42 @@ typedef struct taf_callback_st taf_callback_t; struct taf_callback_st { - char *function; /*User supplied TAF functiomn*/ - int sleep; + SV *function; /*User supplied TAF function*/ + SV *dbh_ref; }; + +typedef struct box_st box_t; typedef struct imp_fbh_st imp_fbh_t; +/* this structure is used to communicate parameters of login */ +typedef struct dblogin_info_st dblogin_info_t; +struct dblogin_info_st { + SV * dbh; + imp_dbh_t * imp_dbh; + SV * pool_class; /* this and next SV * is "mortal" */ + SV * pool_tag; + char *dbname; + char *uid; + char *pwd; + char * cset; + char * ncset; + ub4 mode; + ub4 session_mode; +#ifdef ORA_OCI_112 + ub4 pool_min; + ub4 pool_max; + ub4 pool_incr; + ub4 pool_rlb; + ub4 driver_name_len; + char * driver_name; +#endif +}; + +/* Define implementation specific driver handle data structure */ struct imp_drh_st { dbih_drc_t com; /* MUST be first element in structure */ - OCIEnv *envhp; SV *ora_long; SV *ora_trunc; SV *ora_cache; @@ -28,56 +54,37 @@ struct imp_drh_st { }; -/* Define dbh implementor data structure */ +/* Define implementation specific database handle data structure */ struct imp_dbh_st { 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 ; -#endif - void *(*get_oci_handle) _((imp_dbh_t *imp_dbh, int handle_type, int flags)); - OCIEnv *envhp; /* copy of drh pointer */ + box_t *lock; /* this contains pointer to slot that holds lock */ + OCIEnv *envhp; /* session environment handler, this is mostly */ + /* a copy of imp_drh->envhp, see also connect */ + /* attr ora_envhp */ 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*/ - ub4 driver_namel; -#endif - taf_callback_t *taf_callback; - bool using_taf; /*TAF stuff*/ - char *taf_function; /*User supplied TAF functiomn*/ - int taf_sleep; - 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; + SV *taf_function; /*User supplied TAF function */ + taf_callback_t taf_ctx; 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 */ +#ifdef ORA_OCI_112 + SV * session_tag; +#endif + ub2 cset; + ub2 ncset; + ub1 ph_csform; /* default charset for placeholders */ +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + ub1 is_shared; +#endif }; #define DBH_DUP_OFF sizeof(dbih_dbc_t) @@ -88,7 +95,7 @@ struct imp_dbh_st { typedef struct lob_refetch_st lob_refetch_t; /* Define sth implementor data structure */ -/*statement structure */ +/* Define implementation specific statement data structure */ struct imp_sth_st { dbih_stc_t com; /* MUST be first element in structure */ @@ -134,7 +141,7 @@ struct imp_sth_st { int eod_errno; int est_width; /* est'd avg row width on-the-wire */ /* (In/)Out Parameter Details */ - bool has_inout_params; + int has_inout_params; /* execute mode*/ /* will be using this alot later me thinks */ ub4 exe_mode; @@ -179,17 +186,17 @@ struct fbh_obj_st { /* embedded object or table will work recursively*/ 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 typecode; /*object's OCI_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 */ + OCIRef *obj_ref; /*if an embedded object this is ref handle to its TDO*/ + OCIInd *obj_ind; /*Null indicator 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*/ + fbh_obj_t *next_subtype; /*There is stored information about subtypes for inherited 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*/ @@ -202,7 +209,7 @@ struct imp_fbh_st { /* field buffer EXPERIMENTAL */ /* Oracle's description of the field */ OCIParam *parmdp; OCIDefine *defnp; - void *desc_h; /* descriptor if needed (LOBs etc) */ + 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)); @@ -295,8 +302,6 @@ 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; @@ -311,17 +316,17 @@ extern ub2 al16utf16_csid; #define CS_IS_UTF16( cs ) ( cs == al16utf16_csid ) -#define CSFORM_IMPLIED_CSID(csform) \ - ((csform==SQLCS_NCHAR) ? ncharsetid : charsetid) +#define CSFORM_IMPLIED_CSID(imp_xxh, csform) \ + ((csform==SQLCS_NCHAR) ? (imp_xxh)->ncset : (imp_xxh)->cset) -#define CSFORM_IMPLIES_UTF8(csform) \ - CS_IS_UTF8( CSFORM_IMPLIED_CSID( csform ) ) +#define CSFORM_IMPLIES_UTF8(imp_xxh, csform) \ + CS_IS_UTF8( CSFORM_IMPLIED_CSID(imp_xxh, csform ) ) 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)); fb_ary_t *fb_ary_alloc _((ub4 bufl, int size)); @@ -329,8 +334,8 @@ 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)); 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)); @@ -366,17 +371,16 @@ int ora_st_execute_array _((SV *sth, imp_sth_t *imp_sth, SV *tuples, 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__ +#if defined(__CYGWIN__) || defined(__CYGWIN32__) void ora_cygwin_set_env(char *name, char *value); -#endif /* __CYGWIN32__ */ +#endif /* __CYGWIN__ */ sb4 dbd_phs_in _((dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp)); @@ -393,11 +397,43 @@ void fb_ary_free(fb_ary_t *fb_ary); void rs_array_init(imp_sth_t *imp_sth); ub4 ora_db_version _((SV *dbh, imp_dbh_t *imp_dbh)); -sb4 reg_taf_callback _((imp_dbh_t *imp_dbh)); +sb4 reg_taf_callback _((SV *dbh, imp_dbh_t *imp_dbh)); + +int cnx_establish (pTHX_ dblogin_info_t * ); +void cnx_drop_dr(pTHX_ imp_drh_t *); +void cnx_clean(pTHX_ imp_dbh_t * ); +void cnx_detach(pTHX_ imp_dbh_t * ); +void ora_shared_release(pTHX_ SV * ); + +#ifdef ORA_OCI_112 +int cnx_get_pool_mode(pTHX_ SV *, imp_dbh_t * ); +void cnx_pool_mode(pTHX_ SV * , imp_dbh_t * , ub4); + +#if OCI_MAJOR_VERSION > 18 +int cnx_get_pool_wait(pTHX_ SV *, imp_dbh_t * ); +void cnx_pool_wait(pTHX_ SV * , imp_dbh_t * , ub4); +#endif + +int cnx_get_pool_used(pTHX_ SV *, imp_dbh_t * ); + +int cnx_get_pool_rlb(pTHX_ SV *, imp_dbh_t * ); + +int cnx_get_pool_incr(pTHX_ SV *, imp_dbh_t * ); +void cnx_pool_incr(pTHX_ SV * , imp_dbh_t * , ub4); + +int cnx_get_pool_min(pTHX_ SV *, imp_dbh_t * ); +void cnx_pool_min(pTHX_ SV * , imp_dbh_t * , ub4); + +int cnx_get_pool_max(pTHX_ SV *, imp_dbh_t * ); +void cnx_pool_max(pTHX_ SV * , imp_dbh_t * , ub4); + +int cnx_is_pooled_session(pTHX_ SV *, imp_dbh_t *); +#endif /* These defines avoid name clashes for multiple statically linked DBD's */ #define dbd_init ora_init +#define dbd_dr_destroy ora_dr_destroy #define dbd_db_login ora_db_login #define dbd_db_login6 ora_db_login6 #define dbd_db_do ora_db_do @@ -406,6 +442,7 @@ sb4 reg_taf_callback _((imp_dbh_t *imp_dbh)); #define dbd_db_cancel ora_db_cancel #define dbd_db_disconnect ora_db_disconnect #define dbd_db_destroy ora_db_destroy +#define dbd_take_imp_data ora_take_imp_data #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 diff --git a/dist.ini b/dist.ini new file mode 100644 index 00000000..5844deb2 --- /dev/null +++ b/dist.ini @@ -0,0 +1,122 @@ +name = DBD-Oracle +author = Tim Bunce +author = John Scoles +author = Yanick Champoux +author = Martin J. Evans +license = Perl_5 +copyright_holder = Tim Bunce +copyright_year = 1994 +main_module = lib/DBD/Oracle.pm + +version = 1.91_2 + +; Generate files + +;[TemplateCJM] +;file = CONTRIBUTING.mkd + +[MakeMaker::Custom] + +[Git::Contributors] +[ContributorsFile] +[InstallGuide] +[MetaResources] +homepage = https://metacpan.org/pod/DBD::Oracle +bugtracker.web = https://github.com/perl5-dbi/DBD-Oracle/issues +repository.url = https://github.com/perl5-dbi/DBD-Oracle.git +repository.web = https://github.com/perl5-dbi/DBD-Oracle +repository.type = git + +[MetaJSON] +[PodWeaver] +[License] + +[NextRelease] +time_zone = UTC +format = %-9v %{yyyy-MM-dd}d + +[MetaProvides::Package] +[MatchManifest] +[ManifestSkip] + +[Git::GatherDir] +exclude_filename = cpanfile +exclude_filename = dist.ini +exclude_match = ^maint/ +[CopyFilesFromBuild] +copy = cpanfile + +[ExecDir] +[OurPkgVersion] +[AutoPrereqs] +[CheckChangesHasContent] +[PreviousVersion::Changelog] + +; Release Stuff + +[ConfirmRelease] +[Git::Check] +[Git::Commit] +[Git::Tag] + tag_format = v%v + branch = releases + +[UploadToCPAN] + +[InstallRelease] +install_command = cpanm . + +; Tests + +[RunExtraTests] +[MetaTests] +[Test::Compile] +[Test::Kwalitee] +[Test::EOF] +[Test::EOL] +[Test::NoBreakpoints] +[Test::NoTabs] +[Test::Portability] +[Test::ReportPrereqs] +[Test::UnusedVars] +[TestRelease] +[PodCoverageTests] +[PodSyntaxTests] + +[CPANFile] + +[CopyrightYearFromGit] + +[PruneCruft] + +[MinimumPerl] + +[Prereqs] +Data::Dumper = 0 +DBI = 1.623 +DynaLoader = 0 +Exporter = 0 + +[Prereqs / ConfigureRequires] +DBI = 1.623 + +[Prereqs / DevelopRequires] +DBI = 1.623 +Test::NoWarnings = 0 + +[Prereqs / BuildRequires] +Config = 0 +DBI = 1.623 + +[Prereqs / TestRequires] +warnings = 0 +strict = 0 +DBI = 1.623 +Devel::Peek = 0 +Encode = 0 +Math::BigInt = 0 +Test::More = 0 +Test::NoWarnings = 0 + +[HelpWanted] +positions = coder documentation tester diff --git a/err_bind/err_bind_param_inout_overrun_bug.msg b/err_bind/err_bind_param_inout_overrun_bug.msg deleted file mode 100644 index 83d9001f..00000000 --- a/err_bind/err_bind_param_inout_overrun_bug.msg +++ /dev/null @@ -1,108 +0,0 @@ -From dbi-users-return-215-Tim.Bunce=ig.co.uk@perl.org Mon Feb 5 23:03:29 2001 -Return-Path: -Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id XAA01289; Mon, 5 Feb 2001 23:03:27 GMT -Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) - id <06769-16@oink>; Fri, 6 Feb 1970 00:01:15 +0100 -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 981413584:20:24069:0; Mon, 05 Feb 2001 22:53:04 GMT -Received: from tmtowtdi.perl.org ([209.85.3.25]) by punt-2.mail.demon.net - id aa2024004; 5 Feb 2001 22:53 GMT -Received: (qmail 6267 invoked by uid 508); 5 Feb 2001 22:52:23 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 6247 invoked from network); 5 Feb 2001 22:52:22 -0000 -Received: from seeme.dare.feddata.com (38.186.101.66) by tmtowtdi.perl.org - with SMTP; 5 Feb 2001 22:52:22 -0000 -Received: by seeme.dare.feddata.com; id OAA05466; - Mon, 5 Feb 2001 14:55:56 -0800 (PST) -Received: from ifyou.dare.feddata.com(38.186.101.111) by seeme.dare.feddata.com - via smap (4.1) id xma005448; Mon, 5 Feb 01 14:55:39 -0800 -Sender: oscar@dare.feddata.com -Message-ID: <3A7F2FB0.A1507582@pasadena.feddata.com> -Date: Mon, 05 Feb 2001 14:56:48 -0800 -From: Oscar DeMartino -Organization: Federal Data Corporation -X-Mailer: Mozilla 4.61 [en] (X11; U; SunOS 5.6 sun4u) -X-Accept-Language: en -MIME-Version: 1.0 -To: dbi-users@perl.org -Subject: Undetected error - Binding and Stored Procedures -Content-Type: multipart/alternative; - boundary="------------E1028F7A8304BE268EB8F67B" -Status: RO -Content-Length: 2042 -Lines: 66 - ---------------E1028F7A8304BE268EB8F67B -Content-Type: text/plain; charset=us-ascii -Content-Transfer-Encoding: 7bit - -I am running Oracle 8.1.5 and am using many stored procedures. We -use returned cursors, and individual values. The problem is, when -a stored procedure is executed and the specified bound variable has not -be declared large enough to hold the returned value subsequent -bound variables do not get set and I cannot find any way to -automatically detect this. - -Example: - -The stored procedure takes 1-input value and returns three string -values. - -the stored procedure is prepared , so I get the statement handle. - -I bind the input variable, and then bind the three output variables (1, -2, & 3) -as 100 character strings. - -I then execute the statment handle. - -There do not appear to be any errors, after checking the returned value -(for the execute call), -and ->err and ->errstr are clean. - -variable 1 has the correct returned value. -BUT, output variable 2 & 3, have no value. - ------- -Executing the stored procedure using sqlplus (sql command line -interface) indicated: - -What really occured is that the returned output variables 1 & 3 were -under 100 characters long -output variable 2 was 120 characters long - ---------- - -I know I could make all output variables the max size allowed in the -database field -but this would seem to waste space in the perl code. Since the field in - -the database -is simply defined as a varchar2 with no size limitation (upto 32767). - ------ -Am I missing something about detecting that variables 2 & 3 did not get -stored correctly -by DBI::Oracle?? - - - --- -Oscar "Fred" DeMartino FFFFF DDDD CCC -320 N. Halstead Ave. Ste #160 F D D C C -Pasadena, CA 91107 FFF D D C -e-mail: Oscar.DeMartino@pasadena.feddata.com F D D C -Phone: (626)306-6649 F D D C C -Federal Data Corporation F DDDD CCC - - - ---------------E1028F7A8304BE268EB8F67B-- - diff --git a/err_bind/err_bindarrays.msg b/err_bind/err_bindarrays.msg deleted file mode 100644 index 8ca7a5d3..00000000 --- a/err_bind/err_bindarrays.msg +++ /dev/null @@ -1,241 +0,0 @@ -From cturner@redhat.com Tue Mar 27 06:01:56 2001 -Return-Path: -Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id GAA19714; Tue, 27 Mar 2001 06:01:56 +0100 (BST) -Received: from 194.217.242.7 by oink with SMTP (PP) id <13771-3@oink>; - Fri, 27 Mar 1970 06:00:50 +0100 -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 985668014:20:27605:3; Tue, 27 Mar 2001 04:40:14 GMT -Received: from host154.207-175-42.redhat.com ([207.175.42.154]) - by punt-2.mail.demon.net id ab2125244; 27 Mar 2001 4:39 GMT -Received: from japh.meridian.redhat.com (IDENT:root@japh.meridian.redhat.com [207.175.42.27]) - by lacrosse.corp.redhat.com (8.9.3/8.9.3) with ESMTP id XAA32289 - for ; Mon, 26 Mar 2001 23:39:38 -0500 -Received: (from cturner@localhost) by japh.meridian.redhat.com (8.11.0/8.11.0) - id f2R4bvT12929; Mon, 26 Mar 2001 23:37:57 -0500 -Sender: cturner@redhat.com -To: Tim.Bunce@ig.co.uk -Subject: DBD::Oracle and OCI bound arrays -From: Chip Turner -Date: 26 Mar 2001 23:37:57 -0500 -Message-ID: -User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/20.7 -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Status: A -Content-Length: 980 -Lines: 29 - - -Hey Tim, - -The need to have true OCI bound arrays for DBD::Oracle has come up, -and it looks like I get the fun job of implementing them. Basically, -this will allow DBD::Oracle to do something the DCOracle python -library does. The idea is: - -my $sth = $dbh->prepare("INSERT INTO FooBar (c1, c2) VALUES (?, ?)"); -my @c1 = 'aa' .. 'zz'; -my @c2 = 'aaa' .. 'azz'; -$sth->execute(\@c1, \@c2); - -In other words, it populates the table with a single execute call, -passing two (or more) equally sized arrays in as references for bound -parameters. This has the potential to save a good amount of time, -especially for large datasets. - -This would pretty much be a proprietary extension for Oracle, though -similar uses could be done in other DBD's. - -Just thought I'd let you know what I was intending to do, and to see -if you had any interest in receiving it as a patch after I'm done. - -Chip - --- -Chip Turner cturner@redhat.com - RHN Web Engineer - -From timbo Tue Mar 27 09:29:48 2001 -Return-Path: -Received: by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id JAA20809; Tue, 27 Mar 2001 09:29:42 +0100 (BST) -Date: Tue, 27 Mar 2001 09:29:41 +0100 -From: Tim Bunce -To: Chip Turner -Cc: Tim.Bunce@ig.co.uk, dbi-dev@perl.org -Subject: Re: DBD::Oracle and OCI bound arrays -Message-ID: <20010327092941.D20616@ig.co.uk> -References: -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Mailer: Mutt 0.95.3i -In-Reply-To: ; from Chip Turner on Mon, Mar 26, 2001 at 11:37:57PM -0500 -Content-Length: 1570 -Lines: 39 - -On Mon, Mar 26, 2001 at 11:37:57PM -0500, Chip Turner wrote: -> -> Hey Tim, -> -> The need to have true OCI bound arrays for DBD::Oracle has come up, -> and it looks like I get the fun job of implementing them. Basically, -> this will allow DBD::Oracle to do something the DCOracle python -> library does. The idea is: -> -> my $sth = $dbh->prepare("INSERT INTO FooBar (c1, c2) VALUES (?, ?)"); -> my @c1 = 'aa' .. 'zz'; -> my @c2 = 'aaa' .. 'azz'; -> $sth->execute(\@c1, \@c2); -> -> In other words, it populates the table with a single execute call, -> passing two (or more) equally sized arrays in as references for bound -> parameters. This has the potential to save a good amount of time, -> especially for large datasets. -> -> This would pretty much be a proprietary extension for Oracle, though -> similar uses could be done in other DBD's. -> -> Just thought I'd let you know what I was intending to do, and to see -> if you had any interest in receiving it as a patch after I'm done. - -I would *urge* you to discuss the implementation with me *before* -you get very far cutting code. - -And anyway, I think someone's already done much or all of the work. -Dig around in the dbi-dev archives. If you can't find the discussion -let me know. If you do, then ask them (via the dbi-dev list) what -the status is. - -I'm planning to make a DBI release next week and, hopefully, a -DBD::Oracle release the week after to cleare a backlog of patches I -have queued up. After that I'll be looking to add in the work of the -other guy (whose also implemented it for DBD::DB2 and DBD::ODBC). - -Tim. - -From cturner@redhat.com Wed Mar 28 02:01:21 2001 -Return-Path: -Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id CAA27336; Wed, 28 Mar 2001 02:01:21 +0100 (BST) -Received: from 194.217.242.7 by oink with SMTP (PP) id <17151-9@oink>; - Sat, 28 Mar 1970 01:59:47 +0100 -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 985739868:20:27318:0; Wed, 28 Mar 2001 00:37:48 GMT -Received: from host154.207-175-42.redhat.com ([207.175.42.154]) - by punt-2.mail.demon.net id ac2119835; 28 Mar 2001 0:37 GMT -Received: from japh.meridian.redhat.com (IDENT:root@japh.meridian.redhat.com [207.175.42.27]) - by lacrosse.corp.redhat.com (8.9.3/8.9.3) with ESMTP id TAA10445 - for ; Tue, 27 Mar 2001 19:37:35 -0500 -Received: (from cturner@localhost) by japh.meridian.redhat.com (8.11.0/8.11.0) - id f2S0ZoJ20115; Tue, 27 Mar 2001 19:35:50 -0500 -Sender: cturner@redhat.com -To: Tim Bunce -Subject: Re: DBD::Oracle and OCI bound arrays -References: <20010327092941.D20616@ig.co.uk> -From: Chip Turner -Date: 27 Mar 2001 19:35:50 -0500 -In-Reply-To: <20010327092941.D20616@ig.co.uk> -Message-ID: -User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/20.7 -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Status: A -Content-Length: 1495 -Lines: 35 - -Tim Bunce writes: - -> I would *urge* you to discuss the implementation with me *before* -> you get very far cutting code. - -Unfortunately, it's a little late for this; I've mostly finished the -change (at least, enough for our needs), except for some review and -cleanups. It seems to work quite well (400 times faster than repeated -looping over a dataset) and passes all of DBD::Oracle's test suite. - -> And anyway, I think someone's already done much or all of the work. -> Dig around in the dbi-dev archives. If you can't find the discussion -> let me know. If you do, then ask them (via the dbi-dev list) what -> the status is. - -I checked as you suggest, but couldn't find any code, just discussion -of it. I'll check again, but it didn't seem that the person had put -it anywhere I could get at it. - -> I'm planning to make a DBI release next week and, hopefully, a -> DBD::Oracle release the week after to cleare a backlog of patches I -> have queued up. After that I'll be looking to add in the work of the -> other guy (whose also implemented it for DBD::DB2 and DBD::ODBC). - -If you would like, the patch will probably be suitable for inclusion -by then, if you want it in by the next release. Should there be any -problems with it or its implementation, I'd be glad to clean it up if -you have interest in it (if not, that's cool too; we need it soon, -though, either way). - -Chip - --- -Chip Turner cturner@redhat.com - RHN Web Engineer - -From timbo Wed Mar 28 11:51:58 2001 -Return-Path: -Received: by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id LAA00444; Wed, 28 Mar 2001 11:51:51 +0100 (BST) -Date: Wed, 28 Mar 2001 11:51:51 +0100 -From: Tim Bunce -To: Chip Turner -Cc: Tim Bunce -Subject: Re: DBD::Oracle and OCI bound arrays -Message-ID: <20010328115151.D29769@ig.co.uk> -References: <20010327092941.D20616@ig.co.uk> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Mailer: Mutt 0.95.3i -In-Reply-To: ; from Chip Turner on Tue, Mar 27, 2001 at 07:35:50PM -0500 -Content-Length: 1786 -Lines: 40 - -On Tue, Mar 27, 2001 at 07:35:50PM -0500, Chip Turner wrote: -> Tim Bunce writes: -> -> > I would *urge* you to discuss the implementation with me *before* -> > you get very far cutting code. -> -> Unfortunately, it's a little late for this; I've mostly finished the -> change (at least, enough for our needs), except for some review and -> cleanups. It seems to work quite well (400 times faster than repeated -> looping over a dataset) and passes all of DBD::Oracle's test suite. - -I trust you've added some more tests for your new functionality! - -> > And anyway, I think someone's already done much or all of the work. -> > Dig around in the dbi-dev archives. If you can't find the discussion -> > let me know. If you do, then ask them (via the dbi-dev list) what -> > the status is. -> -> I checked as you suggest, but couldn't find any code, just discussion -> of it. I'll check again, but it didn't seem that the person had put -> it anywhere I could get at it. - -You could always ask them (CC me). - -> > I'm planning to make a DBI release next week and, hopefully, a -> > DBD::Oracle release the week after to cleare a backlog of patches I -> > have queued up. After that I'll be looking to add in the work of the -> > other guy (whose also implemented it for DBD::DB2 and DBD::ODBC). -> -> If you would like, the patch will probably be suitable for inclusion -> by then, if you want it in by the next release. Should there be any -> problems with it or its implementation, I'd be glad to clean it up if -> you have interest in it (if not, that's cool too; we need it soon, -> though, either way). - -Thanks for the clean-up offer. Send it to me after I make the next -DBD::Oracle release (as a fresh patch over that version please - but -there shouldn't be too many changes). - -Tim. - diff --git a/err_bind/err_bindclobleak.msg b/err_bind/err_bindclobleak.msg deleted file mode 100644 index 1a31c760..00000000 --- a/err_bind/err_bindclobleak.msg +++ /dev/null @@ -1,58 +0,0 @@ -From PGWeiss@arity.com Thu Mar 9 09:51:45 2000 -Return-Path: -Received: from oink by toad.ig.co.uk (SMI-8.6/SMI-SVR4) - id JAA14948; Thu, 9 Mar 2000 09:51:43 GMT -Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) - id <27566-0@oink>; Mon, 9 Mar 1970 10:51:10 +0100 -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 952595299:20:10439:68; Thu, 09 Mar 2000 09:48:19 GMT -Received: from image.arity.com ([140.239.104.130]) by punt-2.mail.demon.net - id aa2010598; 9 Mar 2000 9:47 GMT -Received: by image.arity.com with Internet Mail Service (5.5.2650.21) - id ; Thu, 9 Mar 2000 04:51:44 -0500 -Message-ID: -From: "Paul G. Weiss" -To: Perl-Win32-Database Mailing List , - "'Tim Bunce'" -Subject: Another CLOB related DBD::Oracle bug -Date: Thu, 9 Mar 2000 04:51:41 -0500 -MIME-Version: 1.0 -X-Mailer: Internet Mail Service (5.5.2650.21) -Content-Type: text/plain; charset="iso-8859-1" -Status: RO -Content-Length: 689 -Lines: 32 - -Binding a parameter to type ORA_CLOB causes a leak. -Consider: - -for (1..10000) -{ - for (1..100) - { - my $sth = $db->prepare('update item set descr = ? where id = ?'); - if ($leak) - { - $sth->bind_param(1, $descr, {ora_type => ORA_CLOB, -ora_field=>'DESCR'}); - $sth->bind_param(2, 12); - $sth->execute; - } - else - { - $sth->execute($descr,12); - } - } - sleep 1; -} - - -With $leak set to 1, i.e. binding the parameters explicitly the -program leaks. With $leak set to 0 it does not (but then I can't -set descr to anything greater than 4K nor can I set it to the -empty string). - -Is there a patch? - --P - diff --git a/err_bind/err_bindnullhash.msg b/err_bind/err_bindnullhash.msg deleted file mode 100644 index d9a98b9a..00000000 --- a/err_bind/err_bindnullhash.msg +++ /dev/null @@ -1,77 +0,0 @@ -From dbi-users-return-12580-Tim.Bunce=pobox.com@perl.org Thu Jul 11 17:49:35 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g6BGnYH11008 - for ; Thu, 11 Jul 2002 17:49:34 +0100 (BST) - (envelope-from dbi-users-return-12580-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.59] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 11 Jul 2002 17:49:34 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1026401921:10:09249:41; Thu, 11 Jul 2002 15:38:41 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1124337; 11 Jul 2002 15:38 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id B567C2BF65 - for ; Thu, 11 Jul 2002 11:38:05 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) - by dolly1.pobox.com (Postfix) with SMTP id 347792BF62 - for ; Thu, 11 Jul 2002 11:38:05 -0400 (EDT) -Received: (qmail 95914 invoked by uid 1005); 11 Jul 2002 15:38:04 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 95896 invoked by uid 76); 11 Jul 2002 15:38:04 -0000 -Received: from ironmail1.cc.lehigh.edu (HELO ironmail1.cc.lehigh.edu) (128.180.39.26) - by onion.perl.org (qpsmtpd/0.07b) with SMTP; Thu Jul 11 15:38:04 2002 -0000 -Received: from ([128.180.39.20]) - by ironmail1.cc.lehigh.edu with ESMTP with TLS; - Thu, 11 Jul 2002 11:35:06 -0400 (EDT) -Received: from lawrencework (pc-lfn0.dept.Lehigh.EDU [128.180.52.51]) - by rain.CC.Lehigh.EDU (8.12.4/8.12.4) with SMTP id g6BFZ6rr022463 - for ; Thu, 11 Jul 2002 11:35:06 -0400 -Message-ID: <0a0401c228f0$93feda10$3334b480@lawrencework> -From: "Phil R Lawrence" -To: -References: <083b01c22824$70357340$3334b480@lawrencework> <20020711140937.A568@dansat.data-plan.com> -Subject: Re: error msg suggestion -Date: Thu, 11 Jul 2002 11:35:20 -0400 -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-8859-1" -Content-Transfer-Encoding: 7bit -X-Priority: 3 -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook Express 6.00.2600.0000 -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2600.0000 -Status: RO -X-Status: A -Content-Length: 636 -Lines: 21 - -Tim Bunce wrote: -> Binding an undef should work and be treated as a NULL. -> -> Probably a bug in your code or the driver. But you didn't -> say which driver. - -Hmmm. quite right, undefs do bind as NULL. However, in this case I am -binding $hash{non-existent-key}, which autoinstantiates to an undef, and looks -like this in the trace: - undef (magic-sg:y) - -Of course it was my dumb fault for having the wrong key for lookup, but -nonetheless, perhaps this should work the same as a normal undef. - -# $DBI::VERSION = "1.14"; -# $DBD::ODBC::VERSION = '0.28'; -$DSN = 'driver=Microsoft Access Driver (*.mdb);dbq=StudyManager.mdb'; - -Thanks, -Phil - - diff --git a/err_bind/err_trailingblank.msg b/err_bind/err_trailingblank.msg deleted file mode 100644 index cdf34a32..00000000 --- a/err_bind/err_trailingblank.msg +++ /dev/null @@ -1,345 +0,0 @@ -From dbi-users-bounce@isc.org Mon May 1 21:12:02 2000 -Return-Path: -Received: from oink by toad.ig.co.uk (SMI-8.6/SMI-SVR4) - id VAA16051; Mon, 1 May 2000 21:12:00 +0100 -Received: from finch-punt-12.mail.demon.net by oink with SMTP (PP) - id <14295-42@oink>; Fri, 1 May 1970 21:06:08 +0100 -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 957208278:10:19133:4; Mon, 01 May 2000 19:11:18 GMT -Received: from pub3.rc.vix.com ([204.152.186.34]) by punt-1.mail.demon.net - id aa1123094; 1 May 2000 19:11 GMT -Received: from pub3.rc.vix.com (pub3.rc.vix.com [204.152.186.34]) - by pub3.rc.vix.com (Postfix) with ESMTP id B3CCF3FAA; - Mon, 1 May 2000 12:10:53 -0700 (PDT) -Received: with LISTAR (v0.129a; list dbi-users); - Mon, 01 May 2000 12:05:42 -0700 (PDT) -Received: from isrv3.isc.org (isrv3.isc.org [204.152.184.87]) - by pub3.rc.vix.com (Postfix) with ESMTP id A70763E34 - for ; Mon, 1 May 2000 12:05:30 -0700 (PDT) -Received: from scotth.emsphone.com (scotth.emsphone.com [199.67.51.179]) - by isrv3.isc.org (8.9.1/8.9.1) via ESMTP id MAA25897 - for ; - Mon, 1 May 2000 12:05:30 -0700 (PDT) env-from (shildret@scotth.emsphone.com) -Received: (from shildret@localhost) by scotth.emsphone.com (8.9.3/8.9.3) - id OAA50011 for dbi-users@isc.org; - Mon, 1 May 2000 14:05:48 -0500 (CDT) (envelope-from shildret) -Message-ID: -X-Mailer: XFMail 1.4.0 on FreeBSD -X-Priority: 3 (Normal) -Content-Type: text/plain; charset=us-ascii -Content-Transfer-Encoding: 8bit -MIME-Version: 1.0 -Resent-Date: Thu, 29 Jul 1999 22:07:08 +0100 -Resent-Message-Id: <19990729220708.G17723@ig.co.uk> -Resent-From: Tim Bunce -Resent-To: Tim Bunce -Date: Mon, 01 May 2000 14:05:48 -0500 (CDT) -Sender: shildret@scotth.emsphone.com -From: "Scott T. Hildreth" -To: "dbi-users@isc.org" -Subject: FW: Oracle & Trailing Blanks - possible change in DBD::Oracle -Resent-Sender: shildret@scotth.emsphone.com -Sender: dbi-users-bounce@isc.org -Errors-To: dbi-users-bounce@isc.org -X-original-sender: Tim.Bunce@ig.co.uk -Precedence: bulk -List-unsubscribe: -X-List-ID: -List-owner: -List-post: -Status: RO -Content-Length: 3885 -Lines: 94 - - -Here is the help, I got regarding the trailing spaces. - ------FW: <19990729220708.G17723@ig.co.uk>----- - -Date: Thu, 29 Jul 1999 22:07:08 +0100 -From: Tim Bunce -To: Tim Bunce -Subject: Oracle & Trailing Blanks - possible change in DBD::Oracle -Cc: "Scott T. HIldreth" , - dbi-users@isc.org - - *** From dbi-users -- To unsubscribe, see the end of this message. *** - -On Thu, Jul 29, 1999 at 09:49:38PM +0100, Tim Bunce wrote: -> *** From dbi-users -- To unsubscribe, see the end of this message. *** -> -> On Thu, Jul 29, 1999 at 09:33:55AM -0500, Scott T. HIldreth wrote: -> > -> > Hi all, I wonder if someone can let me know if I got this right. -> > I have a key to match which can contain trailing blanks. The -> > field in the database is CHAR(18). If I match the key with -> > sqlplus, Oracle finds a match, with or without the trailing -> > blank. When I do an sth->execute( $key ), the key is not -> > found. I abstract the key with substr, so the trailing blank -> > is in the key, but no match is found. Do I need to place qoutes -> > around the value in $key? -> -> Somewhat hiddedn in the Oraperl.pm docs it says this: -> -> --- -> B 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 -> --- -> -> Ignoring the Oraperl specifics there the key point is to use -> -> $csr->bind_param($idx, $value, { ora_type => 5 }); -> -> I'll add something to the DBD::Oracle docs. - -[You'll still need to blank-pad the string.] - -Looking at this issue again I've discovered that the key issue is that -type 1 strips trailing blanks whilst type 5 doesn't. - -I'rather m concerned by this. Since I'm against the DBI changing the -data in any way on principle and since Oraperl used to use type 5 -I'm strongly considering changing DBD::Oracle 'back' to using type 5. - -This would only affect anyone who relies on placeholders having -trailing blanks stripped off. (I'll provide a way to alter the -default with a single statement and/or env var for anyone affected). - -If that's you - speak up now! - -Tim. - ------------------------------------------------------------------------------- -To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html -If you are without web access, or if you are having trouble with the web page, -please send mail to dbi-users-request@isc.org with the subject line of -'unsubscribe'. ------------------------------------------------------------------------------- - - ---------------End of forwarded message------------------------- - ----------------------------------- -E-Mail: Scott T. Hildreth -Date: 01-May-00 -Time: 14:04:41 ----------------------------------- - - ------------------------------------------------------------------------------- -DBI HOME PAGE AND ARCHIVES: http://www.symbolstone.org/technology/perl/DBI/ -To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html -If you are without web access, or if you are having trouble with the web page, -please send mail to dbi-users-request@isc.org with the subject line of: -'unsubscribe'. ------------------------------------------------------------------------------- - -From joshua.horton@mail.tju.edu Fri May 23 07:43:09 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.6/8.12.6) with ESMTP id h4N6UY7T061880 - for ; Fri, 23 May 2003 07:43:09 +0100 (BST) - (envelope-from joshua.horton@mail.tju.edu) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 23 May 2003 07:43:09 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1053631164:10:02298:54; Thu, 22 May 2003 19:19:24 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1116141; 22 May 2003 19:19 GMT -Received: from dolly1.pobox.com (localhost [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id BD31E21C13C - for ; Thu, 22 May 2003 15:18:30 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail.tju.edu (fw-tr16.tju.edu [147.140.233.16]) - by dolly1.pobox.com (Postfix) with ESMTP id 615A521C06D - for ; Thu, 22 May 2003 15:18:22 -0400 (EDT) -Received: from PCSE447.tjh.tju.edu by mail.tju.edu for Tim.Bunce@pobox.com; Thu, 22 May 2003 15:17:54 -0400 -Message-Id: <031301c32096$de68f6f0$2310ae0a@PCSE447> -From: "Joshua Horton" -To: -Subject: Re: :Oracle and Oracle 9.2? -Date: Thu, 22 May 2003 15:18:03 -0400 -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-8859-1" -Content-Transfer-Encoding: 7bit -X-Priority: 3 -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook Express 5.50.4807.1700 -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 3511 -Lines: 99 - -Re: :Oracle and Oracle 9.2? - ----------------------------------------------------------------------------- ----- - - a.. From: Tim Bunce - b.. Subject: Re: :Oracle and Oracle 9.2? - c.. Date: Tue, 15 Apr 2003 07:36:55 -0700 - ----------------------------------------------------------------------------- ----- - -I'd appreciate it if other people with Oracle 9.2.x could let me -know if it passed or failed for them and what their exact oracle -version (four digits) and platform (operating system) is. - -Thanks. - -Tim. - -On Fri, Apr 04, 2003 at 01:48:36PM +0200, Smejkal Petr wrote: -> I have the same experience on Linux however on Windows all tests passes -(I'm not -> sure if it is related to different Oracle version - test of windows Perl -against -> Linux Oracle is OK). -> -> Linux Oracle: 9.2.0.2 -> Windows Oracle: 9.2.0.1 -> DBI: 1.35 -> DBD::Oracle: 1.14 -> -> -- Petr Smejkal -> -- Business Systems Analyst / Country IT Cz/Sk -> -- +420 284 059 639 -> -> > -----Original Message----- -> > From: Tom Malaher [mailto:[EMAIL PROTECTED] -> > Sent: Friday, April 04, 2003 1:35 AM -> > To: [EMAIL PROTECTED] -> > Subject: DBD::Oracle and Oracle 9.2? -> > -> > -> > My sysadmin is trying to install DBD::Oracle on a Solaris box running -> > Oracle 9.2. -> > -> > The ph_type.t test is failing with -> > -> > PERL_DL_NONLAZY=1 ./perl "-MExtUtils::Command::MM" "-e" -> > "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t -> > t/base.......ok -> > t/cursor.....ok -> > t/general....ok -> > t/long.......ok -> > t/meta.......ok -> > t/ph_type....NOK 12 expected 'trailing' but got 'trailing ' -> > for VARCHAR2 -> > t/ph_type....FAILED test 12 -> > Failed 1/19 tests, 94.74% okay -> > t/plsql......ok -> > t/reauth.....skipped -> > all skipped: no reason given -> > t/select.....ok -> > Failed Test Stat Wstat Total Fail Failed List of Failed -> > -------------------------------------------------------------- -> > ----------------- -> > t/ph_type.t 19 1 5.26% 12 -> > 1 test skipped. -> > Failed 1/9 test scripts, 88.89% okay. 1/314 subtests failed, -> > 99.68% okay. -> > *** Error code 29 -> > make: Fatal error: Command failed for target `test_static' -> > -> > Is there a known problem with DBD::Oracle and Oracle 9.x? -> > Has Oracle changed the behavior of trailing spaces in VARCHAR2 fields? -> > -> > I've run the same test script on an oracle 8 installation -> > using DBD::Oracle 1.06 and DBI 1.14, and it works fine (no trailing -> > space is returned). -> > -> > Tom -> > -My config:HP-UX 11.11 (64-bit) on rp5470 2x733 5GB RAMOracle 9.2.0.2.0 -Enterprise Edition (64-bit)Perl 5.8.0 custom compiled with -./Configure -Duse64bitall -Ubincompat5005 -Duselargefiles -Dprefix=/opt/perl -5 ; all other options defaultDBI-1.32 all passed some skippedDBD-Oracle-1.14 -: PERL_DL_NONLAZY=1 /opt/perl5/bin/perl "-MExtUtils::Command::MM" -"-e" "test_harness(0, 'blib/lib', 'blib/arch')" -t/*.tt/base.......okt/cursor.....okt/general....okt/long.......okt/meta..... -..okt/ph_type....ok 11/19 expected 'trailing' but got 'trailing ' for -VARCHAR2t/ph_type....FAILED test 12 Failed 1/19 tests, 94.74% -okayt/plsql......okt/reauth.....skipped all skipped: no reason -givent/select.....okFailed Test Stat Wstat Total Fail Failed List of -Failed---------------------------------------------------------------------- --------------------------------------------------------t/ph_type.t -19 1 5.26% 121 test skipped.Failed 1/9 test scripts, 88.89% okay. -1/314 subtests failed, 99.68% okay.*** Error exit code 2Stop.Thanks,Josh -Horton - - -From nobody@fsck.com Tue Dec 30 14:33:50 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id hBUEWNnP026077 - for ; Tue, 30 Dec 2003 14:33:50 GMT - (envelope-from nobody@fsck.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 30 Dec 2003 14:33:50 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AbJwa-0003ua-H6; - Tue, 30 Dec 2003 13:29:56 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by punt-3.mail.demon.net with esmtp id 1AbJwa-0003ua-H6 - for pobox@dbi.demon.co.uk; Tue, 30 Dec 2003 13:29:56 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 56DAD4C6 - for ; Tue, 30 Dec 2003 08:29:55 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 3B3564C8 - for ; Tue, 30 Dec 2003 08:29:55 -0500 (EST) -Received: from x1.develooper.com (x1.develooper.com [63.251.223.170]) - by boggle.pobox.com (Postfix) with SMTP - for ; Tue, 30 Dec 2003 08:29:54 -0500 (EST) -Received: (qmail 10988 invoked by uid 225); 30 Dec 2003 13:29:53 -0000 -Delivered-To: TIMB@cpan.org -Received: (qmail 10984 invoked by alias); 30 Dec 2003 13:29:52 -0000 -Received: from pallas.eruditorum.org (HELO pallas.eruditorum.org) (63.251.136.85) by la.mx.develooper.com (qpsmtpd/0.27-dev) with ESMTP; Tue, 30 Dec 2003 05:29:41 -0800 -Received: by pallas.eruditorum.org (Postfix, from userid 65534) id 8760D11153; Tue, 30 Dec 2003 08:29:37 -0500 (EST) -Subject: [cpan #4786] Oracle 9.2.0.0 fails a test in ph_types.t -From: "Guest via RT" -Reply-To: bug-DBD-Oracle@rt.cpan.org -In-Reply-To: -Message-ID: -Precedence: bulk -X-RT-Loop-Prevention: cpan -RT-Ticket: cpan #4786 -Managed-by: RT 2.0.15 (http://bestpractical.com/rt/) -RT-Originator: -To: "AdminCc of cpan Ticket #4786": ; -Date: Tue, 30 Dec 2003 08:29:37 -0500 (EST) -X-Spam-Check-By: la.mx.develooper.com -X-Spam-Status: No, hits=2.1 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,SPAM_PHRASE_01_02,SUPERLONG_LINE,TO_HAS_SPACES,TO_MALFORMED version=2.44 -Status: RO -Content-Length: 888 -Lines: 11 - - -This message about DBD-Oracle was sent to you by guest <> via rt.cpan.org - -Full context and any attached attachments can be found at: - - -Assuming that ORA_OCI() gets set correctly when compiling against 9.2, the attached patch will work. I also tried this in SQL*Plus and was able to insert a trailing space into a VARCHAR2. (I replicated the test in ph_types.t). - -I did not test my patch as I installed DBD::Oracle 1.14 by setting the chops_spaces value in %test_info to 0. When I did that, everything installed fine. However, I didn't think that my solution was the best for the module, so I figured ORA_OCI should do the trick. - -I'm running Perl5.8.0 for Solaris2.9 going against the full Oracle build for 9.2. (I did not run into this issue, surprisingly, on Redhat9 running Perl 5.8.2, but I built against Oracle 9.1 there ...) - diff --git a/err_build/err_aix64.msg b/err_build/err_aix64.msg deleted file mode 100644 index f952e29e..00000000 --- a/err_build/err_aix64.msg +++ /dev/null @@ -1,142 +0,0 @@ -From SRS0=KVnF=PW=perl.org=dbi-users-return-25388-Tim.Bunce=pobox.com@bounce2.pobox.com Fri Jan 7 16:11:33 2005 -Received: from localhost (localhost [IPv6:::1]) - by dansat.data-plan.com (8.13.1/8.13.1) with ESMTP id j07GAqfa044155 - for ; Fri, 7 Jan 2005 16:11:32 GMT - (envelope-from SRS0=KVnF=PW=perl.org=dbi-users-return-25388-Tim.Bunce=pobox.com@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Fri, 07 Jan 2005 16:11:32 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CmvQB-0003Po-Kf; - Fri, 07 Jan 2005 14:48:59 +0000 -Received: from [194.217.242.77] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CmvQB-0003Po-Kf - for pobox@data-plan.com; Fri, 07 Jan 2005 14:48:59 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1CmvQA-0002zW-VM - for pobox@data-plan.com; Fri, 07 Jan 2005 14:48:59 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 49778102ACC; - Fri, 7 Jan 2005 09:48:58 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from boggle (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 384E5FF808 - for ; Fri, 7 Jan 2005 09:48:58 -0500 (EST) -Received-SPF: pass (boggle.pobox.com: domain of dbi-users-return-25388-Tim.Bunce=pobox.com@perl.org designates 63.251.223.186 as permitted sender) -X-SPF-Guess: pass (seems reasonable for dbi-users-return-25388-Tim.Bunce=pobox.com@perl.org to mail through 63.251.223.186) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.186(x6.develooper.com) -Received: from lists.develooper.com (x6.develooper.com [63.251.223.186]) - by boggle.pobox.com (Postfix) with SMTP id A74B8F4090 - for ; Fri, 7 Jan 2005 09:48:57 -0500 (EST) -Received: (qmail 2690 invoked by uid 514); 7 Jan 2005 14:48:56 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 2622 invoked from network); 7 Jan 2005 14:48:55 -0000 -Received: from x1.develooper.com (63.251.223.170) - by lists.develooper.com with SMTP; 7 Jan 2005 14:48:55 -0000 -Received: (qmail 13078 invoked by uid 225); 7 Jan 2005 14:48:54 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 13048 invoked by alias); 7 Jan 2005 14:48:51 -0000 -X-Spam-Status: No, hits=-4.6 required=8.0 - tests=BAYES_00,HTML_MESSAGE,NO_REAL_NAME -X-Spam-Check-By: la.mx.develooper.com -Received-SPF: neutral (x1.develooper.com: local policy) -Received: from outmx020.isp.belgacom.be (HELO outmx020.isp.belgacom.be) (195.238.2.201) - by la.mx.develooper.com (qpsmtpd/0.28) with ESMTP; Fri, 07 Jan 2005 06:48:38 -0800 -Received: from outmx020.isp.belgacom.be (localhost [127.0.0.1]) - by outmx020.isp.belgacom.be (8.12.11/8.12.11/Skynet-OUT-2.22) with ESMTP id j07EmOgS020070 - for ; Fri, 7 Jan 2005 15:48:24 +0100 - (envelope-from ) -Received: from relaytwo.roularta.be (smtprelaytwo.roularta.be [194.78.177.23]) - by outmx020.isp.belgacom.be (8.12.11/8.12.11/Skynet-OUT-2.22) with ESMTP id j07EmMDA020034 - for ; Fri, 7 Jan 2005 15:48:22 +0100 - (envelope-from ) -Received: from rmgexch01.RMG.be ([89.0.35.150]) by roesfront3.RMG.be with Microsoft SMTPSVC(5.0.2195.6713); - Fri, 7 Jan 2005 15:47:50 +0100 -X-MimeOLE: Produced By Microsoft Exchange V6.5.7226.0 -Content-class: urn:content-classes:message -MIME-Version: 1.0 -Content-Type: multipart/alternative; - boundary="----_=_NextPart_001_01C4F4C7.EE810087" -Subject: A succesfull 64-bit build of Perl-DBI-DBD:Oracle on IBM AIX 5.2 -Date: Fri, 7 Jan 2005 15:48:21 +0100 -Message-ID: -X-MS-Has-Attach: -X-MS-TNEF-Correlator: -Thread-Topic: A succesfull 64-bit build of Perl-DBI-DBD:Oracle on IBM AIX 5.2 -Thread-Index: AcT0x+Y4G1R3vbX6Rh+QdPyNy/10eQ== -From: -To: -X-OriginalArrivalTime: 07 Jan 2005 14:47:50.0598 (UTC) FILETIME=[DC5D2E60:01C4F4C7] -Status: RO -Content-Length: 1678 -Lines: 62 - -------_=_NextPart_001_01C4F4C7.EE810087 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: quoted-printable - -Hi,=20 -=20 -I finally succeeded in installing a 64bit build of Perl and its modules -for Oracle 64-bit. We were running in 32bit but integrating Proc and -cobols in our perl scripts only worked when we changed environments to -64bit causing problems for the oracle connections in perl. It's nothing -special, no editing of makefiles ... I can't believe I lost so much time -on this one ;) ( Now that I look back to my problems, they were probably -caused by using a wrong perl build for compiling the modules, Aix has -its default perl now under /bin.. stupid me )=20 -=20 -perl 5.8.6 64bit ----------------- -./Configure -de -Dcc=3Dgcc -Duse64bitall=20 -make -make test -make install -=20 -DBI 1.46 --------- -!!Make sure you are using the newly installed perl!! - check with perl -v it should show :=20 - This is perl, v5.8.6 built for aix-64all -perl Makefile.PL -make -make test -make install=20 -=20 -DBD-Oracle 1.16 ---------------- -!!Use correct perl like above mentioned!!=20 -export ORACLE_HOME=3D=20 -export LIBPATH=3D$ORACLE_HOME/lib -export LD_LIBRARY_PATH=3D$ORACLE_HOME/lib -=20 -perl Makefile.PL=20 -make -make test ( some test may still fail, I had 85% success on tests )=20 -make install=20 -=20 -Test -----=20 -=20 -test with :=20 - use DBI; - $dbh=3DDBI->connect("dbi:Oracle:","system","manager")|| die -$DBI::errstr; - $stmt=3D$dbh->prepare("select * from tab"); - $rc=3D$stmt->execute() || die $DBI::errstr; - while (my($record)=3D$stmt->fetchrow()) - { - print $record; - } -=20 -Happy 64-bit perling ;)=20 - -------_=_NextPart_001_01C4F4C7.EE810087-- - diff --git a/err_build/err_hpux_ld.msg b/err_build/err_hpux_ld.msg deleted file mode 100644 index 27f9cd07..00000000 --- a/err_build/err_hpux_ld.msg +++ /dev/null @@ -1,89 +0,0 @@ -From SRS0=JbZc=U3=lincolnbaxter.com=lab@bounce2.pobox.com Tue Jun 21 05:02:19 2005 -Return-Path: -X-Original-To: timbo@localhost -Delivered-To: timbo@localhost.data-plan.com -Received: from localhost (localhost [127.0.0.1]) - by timac.data-plan.com (Postfix) with ESMTP id B016F2A3D98 - for ; Tue, 21 Jun 2005 05:02:19 +0100 (IST) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Tue, 21 Jun 2005 05:02:19 +0100 (IST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1DkYXK-0003m5-Mr; - Tue, 21 Jun 2005 02:30:50 +0000 -Received: from [194.217.242.223] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1DkYXK-0003m5-Mr - for pobox@data-plan.com; Tue, 21 Jun 2005 02:30:50 +0000 -Received: from [208.210.124.73] (helo=gold.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1DkYXJ-00006n-QE - for pobox@data-plan.com; Tue, 21 Jun 2005 02:30:50 +0000 -Received: from gold.pobox.com (localhost [127.0.0.1]) - by gold.pobox.com (Postfix) with ESMTP id AF60172691; - Mon, 20 Jun 2005 22:29:36 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from ms-smtp-04-eri0.southeast.rr.com (ms-smtp-04-lbl.southeast.rr.com [24.25.9.103]) - by gold.pobox.com (Postfix) with ESMTP id A3C1E7272E - for ; Mon, 20 Jun 2005 22:29:11 -0400 (EDT) -Received: from lincolnbaxter.com (cpe-069-132-010-126.carolina.res.rr.com [69.132.10.126]) - by ms-smtp-04-eri0.southeast.rr.com (8.12.10/8.12.7) with ESMTP id j5L2TIL4001864 - for ; Mon, 20 Jun 2005 22:29:18 -0400 (EDT) -Received: (qmail 5171 invoked from network); 20 Jun 2005 22:29:07 -0400 -Received: from lws (192.168.0.25) - by lws with SMTP; 20 Jun 2005 22:29:07 -0400 -Subject: Re: gcc options when building DBD:Oracle -From: "Lincoln A. Baxter" -Reply-To: lab@lincolnbaxter.com -To: jriekenberg@everestkc.net -Cc: Tim Bunce -In-Reply-To: -References: -Content-Type: text/plain -Date: Mon, 20 Jun 2005 22:29:07 -0400 -Message-Id: <1119320947.17452.484.camel@lws> -Mime-Version: 1.0 -X-Mailer: Evolution 2.2.1.1 -Content-Transfer-Encoding: 7bit -X-Virus-Scanned: Symantec AntiVirus Scan Engine -Status: RO -Content-Length: 2011 -Lines: 38 - -Hi Jan, - -This looks like something that might be relatively easy to fix in -Makefile.PL. But I no longer have access to HPUX systems, and never -built DBD-Oracle with gcc on that platform. I could add your message to -the README.hpux file, but it is becoming less and less necessary to read -this file with newer versions of DBD-Oracle, in which Makefile.PL has -been made much smarter. - -Would you consider sending Tim or me a patch to Makefile.PL that -generates the right $(LD) command (only on HP rp8400, and only for your -version of gcc or later? - -Lincoln - -On Mon, 2005-06-20 at 15:36 -0500, jriekenberg@everestkc.net wrote: -> Lincoln, -> -> I recently built DBD:Oracle on an HP rp8400. Everything worked as expected until I actually issued the "make" command. Make proceeded as expected until it reached "MakeMaker dynamic_lib" section. The gcc line in that section failed with the error in the attached text file. Apparently gcc was not correctly passing the "+b" option to ld. Instead, it was attempting to interpret the option itself. It assumed the "+b" was a filename, and that failed because gcc could not find the file. I ended up adding the "-Xlinker" option before the "+b" and before the "$(LD_RUN_PATH)" in the line in Makefile. The line now looks like this: -> -> $(LD) -Xlinker +b -Xlinker "$(LD_RUN_PATH)" $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) -> -> Running "make" now works correctly. -> -> Also, "make test" returned the following error when attempting to build the various tests: -> -> /usr/lib/dld.sl: Can't shl_load() a library containing Thread Local Storage: /usr/lib/libcl.2 -> -> Setting LD_PRELOAD with "export LD_PRELOAD=/usr/lib/libcl.2" corrected this problem, and "make test" worked correctly. -> -> -> I didn't see DBD::Oracle documentation on exactly this, so I'm sending this to you. You may be aware of these items already. If so, please disregard this. -> -> Jon Riekenberg -> -> -> - - diff --git a/err_build/err_hpuxsuccess.msg b/err_build/err_hpuxsuccess.msg deleted file mode 100644 index c6edd79f..00000000 --- a/err_build/err_hpuxsuccess.msg +++ /dev/null @@ -1,279 +0,0 @@ -From dbi-users-return-22430-Tim.Bunce=pobox.com@perl.org Tue Mar 23 17:00:25 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i2NGvAxX021862 - for ; Tue, 23 Mar 2004 17:00:23 GMT - (envelope-from dbi-users-return-22430-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 23 Mar 2004 17:00:23 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1B5oND-0000Ba-LH; - Tue, 23 Mar 2004 16:03:27 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1B5oND-0000Ba-LH - for pobox@dbi.demon.co.uk; Tue, 23 Mar 2004 16:03:27 +0000 -Received: from [208.210.124.70] (helo=majesty.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1B5oNC-00001d-92 - for pobox@dbi.demon.co.uk; Tue, 23 Mar 2004 16:03:26 +0000 -Received: from majesty.pobox.com (localhost [127.0.0.1]) - by majesty.pobox.com (Postfix) with ESMTP id 18033954B4 - for ; Tue, 23 Mar 2004 11:03:24 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by majesty.pobox.com (Postfix) with ESMTP id 3577D954BE - for ; Tue, 23 Mar 2004 11:03:21 -0500 (EST) -Received: from onion.perl.org (onion.develooper.com [63.251.223.166]) - by majesty.pobox.com (Postfix) with SMTP - for ; Tue, 23 Mar 2004 11:02:41 -0500 (EST) -Received: (qmail 6527 invoked by uid 1005); 23 Mar 2004 16:02:21 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 6510 invoked by uid 76); 23 Mar 2004 16:02:20 -0000 -Received: from x1.develooper.com (HELO x1.develooper.com) (63.251.223.170) - by onion.perl.org (qpsmtpd/0.27.1) with SMTP; Tue, 23 Mar 2004 08:02:20 -0800 -Received: (qmail 1985 invoked by uid 225); 23 Mar 2004 16:02:15 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 1893 invoked by alias); 23 Mar 2004 16:02:00 -0000 -X-Spam-Status: No, hits=0.0 required=7.0 - tests= -X-Spam-Check-By: la.mx.develooper.com -Received: from Unknown (HELO dundee.fpcc.net) (204.144.241.120) - by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Tue, 23 Mar 2004 08:01:44 -0800 -Received: from aberdeen.fpcc.net (aberdeen.fpcc.net [204.144.241.125]) - by dundee.fpcc.net (8.11.6/8.11.6) with ESMTP id i2NG1f111241; - Tue, 23 Mar 2004 09:01:41 -0700 -Received: from aberdeen.fpcc.net (localhost.localdomain [127.0.0.1]) - by aberdeen.fpcc.net (8.12.8/8.12.8) with ESMTP id i2NFrNOv024637; - Tue, 23 Mar 2004 08:53:23 -0700 -Received: (from laubster@localhost) - by aberdeen.fpcc.net (8.12.8/8.12.8/Submit) id i2NFrMOx024635; - Tue, 23 Mar 2004 08:53:22 -0700 -X-Authentication-Warning: aberdeen.fpcc.net: laubster set sender to dbiusers@laubster.org using -f -Date: Tue, 23 Mar 2004 08:53:22 -0700 -From: "J.D. Laub" -To: dbi-users@perl.org -Cc: lbaxter@fleetcc.com -Subject: SUCCESS: DBD::Oracle 1.15 on HP-UX 11.11 -Message-ID: <20040323155322.GA24576@aberdeen.fpcc.net> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.4.1i -Organization: The Psychiatric Ward of Terrors -X-Virus-Checked: Checked -Status: RO -Content-Length: 9105 -Lines: 206 - -I've just had success building DBD::Oracle 1.15 on HP-UX 11.11 -(against both oracle 8.1.7 & oracle 9.2.0) & thought I'd share my -experience. - -Disclaimer: these instructions relate to our environment. It may be -that our sysadmins/dbas chose to configure/install things a certain -way (i.e., our install of $ORACLE_HOME/bin/sqlplus was *chosen* -to be 1.1/32), and/or that we're running old versions of software -(i.e., perhaps later releases of gcc don't ignore -mpa-risc-1-1). -In fact, there are probably some mistruths in here; rest assured -they're not intentional. :-) - -I'm unsure how (if?) I should go about getting this information into -the DBD::Oracle README.hpux. Lincoln, please contact me with any -thoughts you have. - - -### The summary ################################ - -Use the ansic compiler (~US$800/cpu). - -Shell variables I used: - PATH=/bin:$PATH # use 32bit ar & nm since using a 32bit cc - PERLDEST=/opt/perl_ora8 # or "perl_ora9" for an ora9 build - PATH=$PERLDEST/bin:$PATH # for build of DBI, pick up new perl - export LDLOADLIBS='+b : +s' # handy for ORACLE_SID connections to ora7 - unset PERLLIB # important to avoid outdated cruft - export ORACLE_USERID=scott/tiger # insecure - consider using "/" - ORACLE_SID=orcl - ORAENV_ASK=NO - . oraenv # sets LD_LIBRARY_PATH and SHLIB_PATH - -For ora8: - sh ./Configure -d -e -Dprefix=$PERLDEST \ - -A prepend:libswanted='cl pthread ' \ - -A prepend:ccflags='+z +DAportable ' \ - -A prepend:ldflags='+z +DAportable ' - -For ora9: - sh ./Configure -d -e -Dprefix=$PERLDEST \ - -A prepend:libswanted='cl pthread ' \ - -A prepend:ccflags='+z +DA2.0W ' \ - -A prepend:ldflags='+z +DA2.0W ' \ - -Dlibpth='/usr/lib/pa20_64 /usr/local/pa20_64/lib' - -After you use the above to install perl, DBI & DBD::Oracle will -build in the normal fashion. - - -### General Notes ################################ - -* During "make test", I received 1 failure (on -lib/ExtUtils/t/Constant) for ora8, and 3 failures (on -lib/ExtUtils/t/Constant, lib/ExtUtils/t/recurs, and t/op/write) for -ora9. Nevertheless, things seem mostly OK. - -* These are the various combinations possible for a given compiled -file on HP-UX 11.11 (the quoted description is what gets kicked out -by the "file" command): - - PA-RISC1.1/32bit ("PA-RISC1.1 relocatable object") - (I'll call this 1.1/32) - PA-RISC2.0/32bit ("PA-RISC2.0 relocatable object") - (I'll call this 2.0/32) - PA-RISC2.0/64bit ("ELF 64-bit MSB relocatable, PA-RISC 2.0 (LP64)") - (I'll call this 2.0/64) - -* "perl -v" lies about the RISC level: -$ file ./perl -./perl: PA-RISC1.1 shared executable dynamically linked -not stripped -$ ./perl -v | grep RISC -This is perl, v5.8.3 built for PA-RISC2.0 - -* If you'll be linking against 2.0/64 libraries, you'll have to -build all your object modules that way. I've not yet found a way -to link 32bit executables to 64bit libraries (and vice versa). Run -the "file" command on your Oracle libraries to find out which path -you'll have to take. - -* Two environment variables control where libraries are -searched. LD_LIBRARY_PATH and SHLIB_PATH (in that order) are -used for 64bit executables, while SHLIB_PATH is used for 32bit -executables. - -* I tried attempts using aCC as well as the default (free) cc that -comes with hpux; both avenues were too problematic to continue -pursuing. - -* The format of compiled objects is specified by compiler options. -According to the ansic compiler docs, the options are "+DAportable" -(for 1.1/32), "+DA2.0" (for 2.0/32), and "+DA2.0W" (for 2.0/64). -For gcc, the corresponding switches are -mpa-risc-1-1 (for 1.1/32) -and -mpa-risc-2-0 (for 2.0/64), but I've found that -mpa-risc-1-1 -is ineffective. (According to the "file" command, you *always* get -2.0/64.) - -* Our gcc displays the behavior described at -http://sources.redhat.com/ml/binutils/2002-10/msg00586.html and -http://aspn.activestate.com/ASPN/Mail/Message/perl5-porters/1641238 -, so is therefore unusable anytime '-lcl' is to be specified. -Unfortunately, that library is required for DBD::Oracle builds. -(The workaround of adding the 3 declarations does seem to work, -but littering those throughout perl's Configure, main.c, etc. -seems a big task.) Attempts to get gcc to use the hp ld instead -of the gnu ld (by specifying -mno-gnu-ld and -fno-gnu-linker) were -unsuccessful. The first html link shown above indicates you have -to rebuild gcc to use the hp linker, and that was not an incredibly -desirable path to pursue. - -* Our default PATH was set to put /usr/local/pa20_64/bin ahead of -/bin. This caused problems because (I think) the 64bit versions -of either ar (the archiver) or nm (the symbol lister) do not play -well with /bin/cc (the 32bit compiler). The tweak to put /bin at -the head of PATH, so we get the 32bit versions, takes care of the -problem. - -* I ran into an intermittent quirk during the build of perl in which -typing "make" (just after the Configure) did nothing. It turns out -that only dependencies were being written to "makefile", and that -removing "makefile" (so it could be automatically rebuilt) solved -the problem. - -* Most of my research on finding the right compiler/linker switches -was done with a "hello world" C program, trying the various -compilers and options, and trying to link it with the oracle -libraries. This proved to be a good choice, as trying to test -compilers/switches against the perl source distribution would have -proved quite difficult. - - -### DBD::Oracle specific ################################ - -* ora8 delivers its libraries in 2 formats: 1.1/32 (under -$ORACLE_HOME/lib) and 2.0/64 (under $ORACLE_HOME/lib64). ora7 -delivers only 1.1/32, while ora9 delivers only 2.0/64. It may seem -a bit inconsistent considering the ora8 setup, but ora9 libraries -are found under $ORACLE_HOME/lib and not $ORACLE_HOME/lib64. - -* Under ora8, oraenv incorrectly sets LD_LIBRARY_PATH to include -$ORACLE_HOME/lib instead of $ORACLE_HOME/lib64, so you've got to -make an override in oraenv_local if you want to use 2.0/64. It -doesn't harm anything, but oraenv unnecessarily sets LD_LIBRARY_PATH -for ora7 (a 64bit environment variable for a 32bit application). - -* If you use shared libraries AND you'll be upgrading Oracle, you -should expect you'll need to rebuild DBD::Oracle unless you'll keep -the old Oracle libraries available. - -* If you're building against ora8, the setting of LDLOADLIBS -is recommended so that when oraenv set SHLIB_PATH to the -$ORACLE_HOME/lib for ora7, the code will still find the ora8 -libraries. - -* We expect to need local (ORACLE_SID) connections for ora8 & -ora9. We could have gone with a single 2.0/64 perl coupled with -2 DBD::Oracle installs and PERLLIB twiddling in oraenv_local to -get to the right one. Instead, we chose to do 2 perl installs -(/opt/perl_ora8 and /opt/perl_ora9) because we can also connect -locally to ora7 by using the 1.1/32 ora8 version, something that -isn't possible with a 2.0/64 version. Also, we've some older 1.1/32 -machines into which we'd like to plop a tarball of the perl stuff, -so a 1.1/32 executable was desirable. - -* Some tests I ran were hinting that with 2.0/64, specifying "+b :" -on the build of DBD::Oracle correctly configured Oracle.sl as far as -the chatr program is concerned, but it seemed that LD_LIBRARY_PATH -*always* needed to be set correctly. (I.e., the embedded path in -the library seemed to be ignored.) I didn't pursue researching this -since there's no way to get the ora9 compiled code to connect to -ora8, meaning LD_LIBRARY_PATH had to be set correctly anyway. - -Testing local (ORACLE_SID) connections: -builds against 1.1/32 ora8 can connect to ora7 -builds against 1.1/32 ora8 cannot connect to ora9: "ERROR OCIEnvInit" -builds against 2.0/64 ora8 cannot connect to ora9: "ERROR OCIEnvInit" -builds against 2.0/64 ora9 cannot connect to ora8 or ora7: "UNKNOWN - OCI STATUS 1804) OCIInitialize. Check ORACLE_HOME and NLS - settings etc." - -Testing remote (sqlnet) connections: -builds against 1.1/32 ora8 can connect to ora7 -builds against 1.1/32 ora8 can connect to ora9 -builds against 2.0/64 ora9 can connect to ora8 -builds against 2.0/64 ora9 cannot connect to ora7: "OCI-21500: internal - error code" - - -### Versions ################################ - -perl: 5.8.3 -dbi: 1.41 -dbd-oracle: 1.15 -$ strings /bin/cc | grep Compiler -HP92453-01 B.11.11.08 HP C Compiler -$ strings /bin/ld | grep linker -$Revision: 92453-07 linker linker crt0.o B.11.16 000601 $ -@(#)92453-07 linker command s800.sgs ld PA64 B.11.18 REL 000922 -$ gcc -v -Reading specs from /usr/local/pa20_64/lib/gcc-lib/hppa64-hp-hpux11.11/3.3.1/specs -Configured with: ../src/configure --enable-languages=c,c++ --prefix=/usr/local/pa20_64 --with-local-prefix=/usr/local/pa20_64 --with-gnu-as --with-as=/usr/local/pa20_64/bin/as --with-gnu-ld --with-ld=/usr/local/pa20_64/bin/ld --disable-shared --disable-nls --host=hppa64-hp-hpux11.11 -Thread model: single -gcc version 3.3.1 - --- -J.D. Laub (Laubster) |"Your leg's too long / Your skull's too strong / -dbiusers@laubster.org| Suppose your nose is wrong." - Renaldo & the Loaf - diff --git a/err_build/err_instantclient.msg b/err_build/err_instantclient.msg deleted file mode 100644 index f0e549eb..00000000 --- a/err_build/err_instantclient.msg +++ /dev/null @@ -1,207 +0,0 @@ -From SRS0=8E1j=QQ=perl.org=dbi-users-return-25638-Tim.Bunce=pobox.com@bounce2.pobox.com Wed Feb 2 10:11:05 2005 -Received: from localhost (localhost [IPv6:::1]) - by dansat.data-plan.com (8.13.1/8.13.1) with ESMTP id j12AAUZ6055956 - for ; Wed, 2 Feb 2005 10:11:05 GMT - (envelope-from SRS0=8E1j=QQ=perl.org=dbi-users-return-25638-Tim.Bunce=pobox.com@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Wed, 02 Feb 2005 10:11:05 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CwGaQ-0002Bn-H6; - Wed, 02 Feb 2005 09:14:10 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CwGaQ-0002Bn-H6 - for pobox@data-plan.com; Wed, 02 Feb 2005 09:14:10 +0000 -Received: from [207.8.226.2] (helo=kelvin.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1CwGaP-00042G-Vb - for pobox@data-plan.com; Wed, 02 Feb 2005 09:14:10 +0000 -Received: from kelvin.pobox.com (localhost [127.0.0.1]) - by kelvin.pobox.com (Postfix) with ESMTP id 9C3FB1E3946; - Wed, 2 Feb 2005 04:14:09 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from kelvin (localhost [127.0.0.1]) - by kelvin.pobox.com (Postfix) with ESMTP id 879981E3958 - for ; Wed, 2 Feb 2005 04:14:09 -0500 (EST) -Received-SPF: pass (kelvin.pobox.com: domain of dbi-users-return-25638-Tim.Bunce=pobox.com@perl.org designates 63.251.223.186 as permitted sender) -X-SPF-Guess: pass (seems reasonable for dbi-users-return-25638-Tim.Bunce=pobox.com@perl.org to mail through 63.251.223.186) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.186(x6.develooper.com) -Received: from lists.develooper.com (x6.develooper.com [63.251.223.186]) - by kelvin.pobox.com (Postfix) with SMTP id D0B001E3946 - for ; Wed, 2 Feb 2005 04:14:08 -0500 (EST) -Received: (qmail 7188 invoked by uid 514); 2 Feb 2005 09:14:05 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -List-Id: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 2531 invoked from network); 2 Feb 2005 04:10:16 -0000 -Delivered-To: dbi-users@perl.org -X-Spam-Status: No, hits=-2.6 required=8.0 - tests=BAYES_00,NO_REAL_NAME -X-Spam-Check-By: la.mx.develooper.com -Received-SPF: pass (x1.develooper.com: local policy) -From: snisim@sankyo.co.jp -X-Authentication-Warning: mailgw.shina.sankyo.co.jp: iscan owned process doing -bs -X-MimeOLE: Produced By Microsoft Exchange V6.5.6944.0 -Content-class: urn:content-classes:message -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-2022-jp" -Content-Transfer-Encoding: 7bit -Subject: Making DBD::Oracle with Instant Client 10.1.0.3 -Date: Wed, 2 Feb 2005 13:09:58 +0900 -Message-ID: <7C6FBEDC782B5642BEAF9C9FDF3F431D83CBE9@EVS001.sankyo.co.jp> -X-MS-Has-Attach: -X-MS-TNEF-Correlator: -Thread-Topic: Making DBD::Oracle with Instant Client 10.1.0.3 -Thread-Index: AcUI3Q64h9ykph8RSl6pF0OpBbTqJA== -To: -X-OriginalArrivalTime: 02 Feb 2005 04:09:59.0005 (UTC) FILETIME=[0F7508D0:01C508DD] -Status: RO -X-Status: A -Content-Length: 1692 -Lines: 44 - -Hi all, - -Thanks to the devel package, I've got succeeded in making DBD::Oracle -with the Oracle Instant Client 10.1.0.3, no *.mk files, in my linux box. -My recipe is: - -1) install both basic- and devel-10.1.0.3 rpm packages -2) export ORALCE_HOME="/usr/lib/oracle/10.1.0.3/client" -3) export LD_LIBRARY_PATH="$ORACLE_HOME/lib:$LD_LIBRARY_PATH" -4) modify the Makefile.PL file to bypass the find_headers() routine and - to pass a correct -I flag to cc (the attached dirty patch is FYI) -5) execute the Makefile.PL * with the -l option *, perl Makefile.PL -l -6) make && make test && make install -# I got many errors in t/30long.t (retrieving blobs ?) -# but it seems to work fairly. - -I hope this could help those who are annoyed with the "Unable to locate an -oracle.mk,..." error. - -Happy DBing, - -Satoshi - ---- Makefile.PL.orig 2004-10-22 18:07:04.000000000 +0900 -+++ Makefile.PL 2005-02-02 12:39:56.703125000 +0900 -@@ -276,7 +276,7 @@ - print "Oracle sysliblist: $syslibs\n"; - my $libdir = ora_libdir(); - $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" }; -- my @h_dirs = find_headers(); -+# my @h_dirs = find_headers(); - if ($client_version_full =~ /^8.0.6/ && $os eq 'hpux') { - $linkwith_msg = "-lextp -l$lib."; - $opts{LIBS} = [ "-L$OH/$libdir -lextp -l$lib $syslibs" ]; -@@ -286,7 +286,8 @@ - $linkwith_msg = "-l$lib."; - $opts{LIBS} = [ "-L$OH/$libdir -l$lib $syslibs" ]; - } -- my $inc = join " ", map { "-I$OH/$_" } @h_dirs; -+# my $inc = join " ", map { "-I$OH/$_" } @h_dirs; -+ my $inc = "-I/usr/include/oracle/10.1.0.3/client"; - $opts{INC} = "$inc -I$dbi_arch_dir"; - } - else { # --- trawl the guts of Oracle's make files looking the how it wants to link - -From SRS0=Kn57=QR=sankyo.co.jp=snisim@bounce2.pobox.com Thu Feb 3 08:10:48 2005 -Received: from localhost (localhost [IPv6:::1]) - by dansat.data-plan.com (8.13.1/8.13.1) with ESMTP id j138AMOi093146 - for ; Thu, 3 Feb 2005 08:10:48 GMT - (envelope-from SRS0=Kn57=QR=sankyo.co.jp=snisim@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Thu, 03 Feb 2005 08:10:48 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CwboD-0005ug-LV; - Thu, 03 Feb 2005 07:53:49 +0000 -Received: from [194.217.242.223] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CwboD-0005ug-LV - for pobox@data-plan.com; Thu, 03 Feb 2005 07:53:49 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1CwboD-0000Wn-82 - for pobox@data-plan.com; Thu, 03 Feb 2005 07:53:49 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 70999102D9F; - Thu, 3 Feb 2005 02:53:48 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from boggle (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 5F45E102DCC - for ; Thu, 3 Feb 2005 02:53:48 -0500 (EST) -X-Pobox-Antispam: Require PTR Record returned DENY: 210.81.52.253 has no PTR record -X-Pobox-Antispam: country/Japan returned DENY: sender address snisim@sankyo.co.jp matches TLD .jp (Japan) -Received-SPF: none (boggle.pobox.com: domain of snisim@sankyo.co.jp does not designate permitted sender hosts) -X-SPF-Guess: pass (seems reasonable for snisim@sankyo.co.jp to mail through 210.81.52.253) -Received: from mailgws.shina.sankyo.co.jp (unknown [210.81.52.253]) - by boggle.pobox.com (Postfix) with ESMTP id A38A5102E20 - for ; Thu, 3 Feb 2005 02:53:46 -0500 (EST) -Received: from es007.sankyo.co.jp (localhost [127.0.0.1]) - by mailgws.shina.sankyo.co.jp (8.9.3p2/3.7W) with ESMTP id LAA15117 - for ; Thu, 3 Feb 2005 11:45:39 +0900 (JST) -From: snisim@sankyo.co.jp -X-Authentication-Warning: mailgws.shina.sankyo.co.jp: iscan owned process doing -bs -Received: from EVS001.sankyo.co.jp ([10.14.121.200]) by es007.sankyo.co.jp with Microsoft SMTPSVC(6.0.3790.0); - Thu, 3 Feb 2005 11:45:39 +0900 -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-2022-jp" -Content-Transfer-Encoding: 7bit -Subject: RE: Making DBD::Oracle with Instant Client 10.1.0.3 -Content-class: urn:content-classes:message -X-MimeOLE: Produced By Microsoft Exchange V6.5.6944.0 -Date: Thu, 3 Feb 2005 11:46:07 +0900 -Message-ID: <7C6FBEDC782B5642BEAF9C9FDF3F431D83CBEC@EVS001.sankyo.co.jp> -X-MS-Has-Attach: -X-MS-TNEF-Correlator: -Thread-Topic: Making DBD::Oracle with Instant Client 10.1.0.3 -Thread-Index: AcUJEc1pQuIX++g2S8y4AE9WqWRYtQAhsK+Q -To: -X-OriginalArrivalTime: 03 Feb 2005 02:45:39.0123 (UTC) FILETIME=[71F21030:01C5099A] -Status: RO -Content-Length: 1192 -Lines: 36 - -Hi Tim, - -Thank you for your kind reply. - -I found my patch will cause a compilation error for the local variable -@h_dirs gets into undefined after commenting out the line 279. -It should be corrected as following: - ---- Makefile.PL.orig 2004-10-22 18:07:04.000000000 +0900 -+++ Makefile.PL 2005-02-02 12:39:56.703125000 +0900 -@@ -276,7 +276,7 @@ - print "Oracle sysliblist: $syslibs\n"; - my $libdir = ora_libdir(); - $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" }; -- my @h_dirs = find_headers(); -+ my @h_dirs; - if ($client_version_full =~ /^8.0.6/ && $os eq 'hpux') { - $linkwith_msg = "-lextp -l$lib."; - $opts{LIBS} = [ "-L$OH/$libdir -lextp -l$lib $syslibs" ]; -@@ -286,7 +286,8 @@ - $linkwith_msg = "-l$lib."; - $opts{LIBS} = [ "-L$OH/$libdir -l$lib $syslibs" ]; - } -- my $inc = join " ", map { "-I$OH/$_" } @h_dirs; -+# my $inc = join " ", map { "-I$OH/$_" } @h_dirs; -+ my $inc = "-I/usr/include/oracle/10.1.0.3/client" - $opts{INC} = "$inc -I$dbi_arch_dir"; - } - else { # --- trawl the guts of Oracle's make files looking the how it wants to link - -I'm not a dbi-users member so I can't reply my post... I wonder if you can do it. - -Thanks, - -Satoshi - - diff --git a/err_build/err_makefileundef.msg b/err_build/err_makefileundef.msg deleted file mode 100644 index b98d782a..00000000 --- a/err_build/err_makefileundef.msg +++ /dev/null @@ -1,87 +0,0 @@ -From timbo Tue Apr 26 09:19:54 2005 -Return-path: -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Tue, 26 Apr 2005 09:19:54 -0700 (PDT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1DQSgy-0006AU-4c; - Tue, 26 Apr 2005 16:13:44 +0000 -Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1DQSgy-0006AU-4c - for pobox@data-plan.com; Tue, 26 Apr 2005 16:13:44 +0000 -Received: from [207.8.226.2] (helo=kelvin.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1DQSgy-0003uM-1T - for pobox@data-plan.com; Tue, 26 Apr 2005 16:13:44 +0000 -Received: from kelvin.pobox.com (localhost [127.0.0.1]) - by kelvin.pobox.com (Postfix) with ESMTP id 759703B902A; - Tue, 26 Apr 2005 12:13:43 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from kelvin (localhost [127.0.0.1]) - by kelvin.pobox.com (Postfix) with ESMTP id 80C0A39F279 - for ; Tue, 26 Apr 2005 12:13:42 -0400 (EDT) -Received-SPF: none (kelvin.pobox.com: domain of lembark@wrkhors.com does not designate permitted sender hosts) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 66.246.154.128(mail-out.pilosoft.net) -Received: from mail.pilosoft.net (mail-out.pilosoft.net [66.246.154.128]) - by kelvin.pobox.com (Postfix) with ESMTP id 2ED743AB75B - for ; Tue, 26 Apr 2005 12:12:30 -0400 (EDT) -Received: from [192.168.1.2] (dsl-69-31-90-94.pilosoft.com [69.31.90.94]) - by mail.pilosoft.net (8.12.8/8.12.8) with ESMTP id j3QGA3u1014203 - for ; Tue, 26 Apr 2005 12:10:03 -0400 -Date: Tue, 26 Apr 2005 12:14:22 -0400 -From: Steven Lembark -Reply-To: lembark@wrkhors.com -To: Tim Bunce -Subject: Possible glitch in DBD::Oracle-1.48 Makefile.pl -Message-ID: <269F0144DC99100E7C80975F@[192.168.1.2]> -X-Mailer: Mulberry/3.1.3 (Linux/x86) -X-Workhorse: lembark 1.1 -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii; format=flowed -Content-Transfer-Encoding: 7bit -Content-Disposition: inline -X-Virus-Scanned: ClamAV version 0.83, clamav-milter version 0.83 on mail.pilosoft.net -X-Virus-Status: Clean -X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=failed version=3.0.2 -X-Spam-Level: 0.0 -X-Spam-Checker-Version: SpamAssassin 3.0.2 (2004-11-16) on cheeta.pilosoft.net -X-Status: A -Content-Length: 1342 -Lines: 36 - -Linking with OTHERLDFLAGS = -L/opt/oracle/product/9.2/lib/ --L/opt/oracle/product/9.2/rdbms/lib/ -lclntsh `cat -/opt/oracle/product/9.2/lib/sysliblist` -ldl -lm [from 'build' rule] - -Checking if your kit is complete... -Looks good -Use of uninitialized value in substitution (s///) at Makefile.PL line 1446. -LD_RUN_PATH=/opt/oracle/product/9.2/lib:/opt/oracle/product/9.2/rdbms/lib -Using DBD::Oracle 1.16. - - - sub const_loadlibs { - my $self = shift; - local($_) = $self->SUPER::const_loadlibs(@_); - # edit LD_RUN_PATH ... - my ($ldrp) = m/^LD_RUN_PATH\s*=\s*(.*)/m; - # remove redundant /lib or /usr/lib as it can cause problems --> $ldrp =~ s!:(/usr)?/lib$!!; - # 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"; - #print "ldrp=$ldrp\n"; - - # 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 "LD_RUN_PATH=$ldrp\n"; - return $_; - } - --- -Steven Lembark 85-09 90th Street -Workhorse Computing Woodhaven, NY 11421 -lembark@wrkhors.com 1 888 359 3508 - diff --git a/err_build/err_memleak.msg b/err_build/err_memleak.msg deleted file mode 100644 index d40913d7..00000000 --- a/err_build/err_memleak.msg +++ /dev/null @@ -1,95 +0,0 @@ -From SRS0=Dwok=LW=pallas.eruditorum.org=www-data@bounce2.pobox.com Wed Sep 1 16:31:37 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i81FRlpg021884 - for ; Wed, 1 Sep 2004 16:31:37 +0100 (BST) - (envelope-from SRS0=Dwok=LW=pallas.eruditorum.org=www-data@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 01 Sep 2004 16:31:37 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1C2WYO-00034m-M1; - Wed, 01 Sep 2004 14:57:40 +0000 -Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1C2WYO-00034m-M1 - for pobox@data-plan.com; Wed, 01 Sep 2004 14:57:40 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1C2WYO-0005CR-FY - for pobox@data-plan.com; Wed, 01 Sep 2004 14:57:40 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 1C1D6A758C; - Wed, 1 Sep 2004 10:57:36 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from boggle (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 184C8A7214 - for ; Wed, 1 Sep 2004 10:57:32 -0400 (EDT) -Received-SPF: fail (boggle.pobox.com: domain of www-data@pallas.eruditorum.org does not designate 63.251.223.170 as permitted sender) -X-SPF-Override: pass (client 63.251.223.170 was found in trusted-forwarder.org, overrides regular SPF fail) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.170(x1.develooper.com) -Received: from x1.develooper.com (x1.develooper.com [63.251.223.170]) - by boggle.pobox.com (Postfix) with SMTP id 7A6C9A7555 - for ; Wed, 1 Sep 2004 10:57:06 -0400 (EDT) -Received: (qmail 5427 invoked by uid 225); 1 Sep 2004 14:57:04 -0000 -Delivered-To: TIMB@cpan.org -Received: (qmail 5403 invoked by alias); 1 Sep 2004 14:57:02 -0000 -X-Spam-Status: No, hits=-4.9 required=8.0 - tests=BAYES_00 -X-Spam-Check-By: la.mx.develooper.com -Received: from pallas.eruditorum.org (HELO pallas.eruditorum.org) (63.251.136.85) - by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Wed, 01 Sep 2004 07:56:59 -0700 -Received: by pallas.eruditorum.org (Postfix, from userid 33) - id 1FDD784C0F5; Wed, 1 Sep 2004 10:56:41 -0400 (EDT) -Subject: [cpan #6245] Confirmed memory leak -From: "Guest via RT" -Reply-To: bug-DBD-Oracle@rt.cpan.org -In-Reply-To: -Message-ID: -Precedence: bulk -X-RT-Loop-Prevention: cpan -RT-Ticket: cpan #6245 -Managed-by: RT 2.0.15 (http://bestpractical.com/rt/) -RT-Originator: -Date: Wed, 1 Sep 2004 10:56:41 -0400 (EDT) -To: undisclosed-recipients: ; -Status: RO -Content-Length: 937 -Lines: 38 - - -This message about DBD-Oracle was sent to you by guest <> via rt.cpan.org - -Full context and any attached attachments can be found at: - - -I Using : -1. SunOS 5.6 Generic_105181-33 sun4u sparc SUNW,Ultra-Enterprise - Perl 5.005_03 - DBI 1.37 - DBD-Oracle 1.14 - Oracle Release 8.1.5.0.0 - - -2. Linux 2.4.18-17.7.xsmp #1 SMP i686 - Perl 5.6.1 - DBI 1.41 - DBD-Oracle 1.16 - Oracle Release 8.1.6.0.0 - -II The following code: - -use strict; -use DBI; - -foreach ( 1 .. 100 ) { - my $dbh = DBI->connect( 'dbi:Oracle:host=****', '***', '***' ); - $dbh->disconnect(); - sleep(1) -} - -III Leak about 4K every 10 seconds - - PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND -24927 aldo 15 0 8724 8720 2760 S 1.3 3.4 0:01 perl - - PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND -24927 aldo 15 0 8736 8732 2760 S 0.7 3.4 0:01 perl - diff --git a/err_build/err_solarisnotes.msg b/err_build/err_solarisnotes.msg deleted file mode 100644 index eaddc475..00000000 --- a/err_build/err_solarisnotes.msg +++ /dev/null @@ -1,482 +0,0 @@ -From SRS0=uAXy=PG=zorranlabs.com=alexzar@bounce2.pobox.com Wed Dec 22 08:11:00 2004 -Received: from localhost (localhost [IPv6:::1]) - by dansat.data-plan.com (8.13.1/8.13.1) with ESMTP id iBM8Aog0091816 - for ; Wed, 22 Dec 2004 08:11:00 GMT - (envelope-from SRS0=uAXy=PG=zorranlabs.com=alexzar@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-6.2.5) - for timbo@localhost (single-drop); Wed, 22 Dec 2004 08:11:00 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1Ch0it-0001A5-Rv; - Wed, 22 Dec 2004 07:15:51 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1Ch0it-0001A5-Rv - for pobox@data-plan.com; Wed, 22 Dec 2004 07:15:51 +0000 -Received: from [208.58.1.198] (helo=lime.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1Ch0is-0000To-R8 - for pobox@data-plan.com; Wed, 22 Dec 2004 07:15:51 +0000 -Received: from lime.pobox.com (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id F0F0DFE10C; - Wed, 22 Dec 2004 02:15:49 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from lime (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id 8B2AAFE1C3 - for ; Wed, 22 Dec 2004 02:15:49 -0500 (EST) -Received-SPF: none (lime.pobox.com: domain of alexzar@zorranlabs.com does not designate permitted sender hosts) -Received: from penguin.nocdirect.com (penguin.nocdirect.com [69.73.160.206]) - by lime.pobox.com (Postfix) with ESMTP id 2B41BFE159 - for ; Wed, 22 Dec 2004 02:13:17 -0500 (EST) -Received: from localhost ([127.0.0.1]) - by penguin.nocdirect.com with esmtps (TLSv1:DES-CBC3-SHA:168) - (Exim 4.43) - id 1Cgz53-0000fj-Bx; Tue, 21 Dec 2004 23:30:37 -0600 -Date: Tue, 21 Dec 2004 23:30:35 -0600 (CST) -From: Alex Zarutin -X-X-Sender: zorranla@penguin.nocdirect.com -To: Tim Bunce -Cc: dbi-users-help@perl.org -Subject: Step-by-Step installation manual of DBD-Oracle-1.16 on Sparc Solaris - 9 with Oracle 9.2.0.1.0 client. -Message-ID: -MIME-Version: 1.0 -Content-Type: TEXT/PLAIN; charset=US-ASCII -X-AntiAbuse: This header was added to track abuse, please include it with any abuse report -X-AntiAbuse: Primary Hostname - penguin.nocdirect.com -X-AntiAbuse: Original Domain - pobox.com -X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] -X-AntiAbuse: Sender Address Domain - zorranlabs.com -X-Source: -X-Source-Args: -X-Source-Dir: -Status: RO -X-Status: A -Content-Length: 15603 -Lines: 426 - - -Hi Tim, - -I have spent a couple days trying to install DBD-Oracle-1.16 (all -required stuff, such as GCC, DBI, etc has been installed before ) on -Sun-Fire v240 running Spark Solaris 9 with the Oracle 9.2.0.1.0 client -installed. The installation takes a couple minutes ONLY after you spend -days trying to make it workable. - -I wrote the log of what I do, in order to do not waste my time in -future. I am pretty sure that this log will be very useful for people -installing DBD-Oracle on Solaris. I published it on my log page, and left -link on it at http://cpanratings.perl.org/d/DBD-Oracle review page. I -would recommend you to add this log to the readme file of your next -releases. Log is written very detailed (step-by-step) with highlighted -typical mistakes. - -Environment: -Hardware/OS: bash-2.05# uname -a -SunOS qadmz41 5.9 Generic_117171-08 sun4u sparc SUNW,Sun-Fire-V240 -OS is actually "standard" Solaris 9 installation came on the box from -SUN - -Oracle Client: Oracle 9.2.0.1.0 -GCC: gcc version 3.3.2, installed to /usr/local/bin as a package from -http://www.sunfreeware.com/programlistsparc9.html -PERL: perl v5.8.5 built for sun4-solaris, installed to /usr/local/bin as -a package from http://www.sunfreeware.com/programlistsparc9.html -DBI: DBI-1.45, installed from http://search.cpan.org/~timb/DBI-1.45/ - -Step-by-Step Manual: - -Step 1: In order to install "DBD-Oracle-1.16" you need to download it, -set all appropriate environment variables (see readme for details) and -run <>. -I got an error that is mostly typical for Solaris installation: - -// ************************ Error 1 ***********************/ - -.... -Found header files in rdbms/demo. - -********************************************************* -I can't find the header files I need in your Oracle installation. -You probably need to install some more Oracle components. -I'll keep going, but the compile will probably fail. -See README.clients for more information. -********************************************************* -Checking for functioning wait.ph - -System: perl5.008005 sunos 5.9 generic sun4u sparc sunw,ultra-5_10 -solaris -Compiler: gcc -B/usr/ccs/bin/ -O -fno-strict-aliasing -pipe --I/usr/local/include -I/opt/gnu/include -D_LARGEFILE_SOURCE --D_FILE_OFFSET_BITS=64 - -.... -// *****************************************************/ - -Investigating this problem, I found that error message is thrown by the -"find_headers" sub of Makefile.PL, especially in this "if -(!$h_file{'oratypes.h'} || !$h_file{'ocidfn.h'})" evaluation. -So I checked these files to make sure that they are installed, but did -not find them under $ORACLE_HOME/rdbms -In the same time, I found an article saying about the similar problem -with DBD-Oracle on Linux, -http://baroti.homedns.org/steve/lost+found/cpan-install-DBD-Oracle-9-2-l -inux.html -They mentioned about two files, and since I was not sure about second -one, ociapr.h I copied both files. You should find its public.1.1.jar -file on the Disk3 of Oracle 9i installation set. - -bash-2.05# pwd -/ora_orig/Disk3/stage/Components/oracle.rdbms.oci/9.2.0.1.0/1/DataFiles - -bash-2.05# ls -al -total 970 -drwxr-xr-x 2 2840 42424 512 Aug 21 2002 . -drwxr-xr-x 3 2840 42424 512 Aug 21 2002 .. --rwxr-xr-x 1 2840 42424 2047 May 9 2002 bin.1.1.jar --rwxr-xr-x 1 2840 42424 206 May 9 2002 build.1.1.jar --rwxr-xr-x 1 2840 42424 135034 May 9 2002 demo.1.1.jar --rwxr-xr-x 1 2840 42424 329814 May 9 2002 public.1.1.jar - -You should just (as dba:oracle) to create the directory called public, -copy public.1.1.jar there and extract all files, since I would not guess -if the rest of them are used or not - -bash-2.05# mkdir $ORACLE_HOME/rdbms/public - -bash-2.05# ls -al $ORACLE_HOME/rdbms/public -total 3404 -drwxr-xr-x 2 oracle dba 512 Dec 21 12:12 . -drwxr-xr-x 10 oracle dba 512 Dec 21 12:05 .. -... --rw-r--r-- 1 oracle dba 6055 Mar 9 2002 ociapr.h --rw-r--r-- 1 oracle dba 10694 Jun 29 2000 ocidfn.h -... - -After that run <> again, and I hope process passes -fine. At least, it was fine in my case - -Step 2: You should <> the module, and as it appears on Solaris, -you will get typical problem. See my error log: - -// ************************ Error 2 ***********************/ -.... -rm -f blib/arch/auto/DBD/Oracle/Oracle.so -LD_RUN_PATH="/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32: -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/rdbms/lib32" gcc --B/usr/ccs/bin/ -G -L/usr/local/lib -L/opt/gnu/lib Oracle.o dbdimp.o -oci8.o -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib -laio --lposix4 -lm -lthread -o blib/arch/auto/DBD/Oracle/Oracle.so -ld: fatal: file -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib//libclntsh.so: -wrong ELF class: ELFCLASS64 -ld: fatal: File processing errors. No output written to -blib/arch/auto/DBD/Oracle/Oracle.so -collect2: ld returned 1 exit status -*** Error code 1 -make: Fatal error: Command failed for target -`blib/arch/auto/DBD/Oracle/Oracle.so' - -// *****************************************************/ - -So, as another set on Google' posts showed that it is a possibility of -missing libraries compiled with 64 bits and same libraries compiled with -32 bits suppoert. As I understood, all components of installation, such -as Oracle client, Perl, GCC should support only one type of libraries, -either 32 or 64 bits. I found that having all as 32 bits is easier to me -than recompile perl, gcc as 64 (may be I am wrong in this assumption). -In order to have all of them as 32 bits, I changed lib to lib32 in -Manifest file (not Manifest.PL). - -You should replace the following lines in the "MakeMaker const_loadlibs -section": - -EXTRALIBS = -L$(LIBHOME) -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib -laio --lposix4 -lm -lthread -LD_RUN_PATH=/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32:/ -export/home/oracle/u01/app/oracle/product/9.2.0.1.0/rdbms/lib32 - -By their lib32 clones: - -EXTRALIBS = -L$(LIBHOME) -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32 -laio --lposix4 -lm -lthread -LD_RUN_PATH=/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32:/ -export/home/oracle/u01/app/oracle/product/9.2.0.1.0/rdbms/lib32 - -And replace this line in "MakeMaker dynamic_lib section" (~~ line 491) - -OTHERLDFLAGS = -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib -laio --lposix4 -lm -lthread - -By its lib32 clone: - -OTHERLDFLAGS = -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32 -laio --lposix4 -lm -lthread - -I hope, that after that process passes without any errors. Here is last -part, that I got during <>: - -..... -rm -f blib/arch/auto/DBD/Oracle/Oracle.so -LD_RUN_PATH="/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32: -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/rdbms/lib32" gcc --B/usr/ccs/bin/ -G -L/usr/local/lib -L/opt/gnu/lib Oracle.o dbdimp.o -oci8.o -xarch=v9 --L/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ -lclntsh -`cat /export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/ldflags` -`cat -/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32/sysliblist` --R/export/home/oracle/u01/app/oracle/product/9.2.0.1.0/lib32 -laio --lposix4 -lm -lthread -o blib/arch/auto/DBD/Oracle/Oracle.so -chmod 755 blib/arch/auto/DBD/Oracle/Oracle.so -cp Oracle.bs blib/arch/auto/DBD/Oracle/Oracle.bs -chmod 644 blib/arch/auto/DBD/Oracle/Oracle.bs -/usr/local/bin/perl "-Iblib/arch" "-Iblib/lib" ora_explain.PL -ora_explain -Extracted ora_explain from ora_explain.PL with variable substitutions. -cp ora_explain blib/script/ora_explain -/usr/local/bin/perl "-MExtUtils::MY" -e "MY->fixin(shift)" -blib/script/ora_explain -Manifying blib/man1/ora_explain.1 -Manifying blib/man3/DBD::Oracle.3 -Manifying blib/man3/DBD::Oraperl.3 - -III. Once we build the module, we should test it, to make sure that it -works fine. You should run <> to do it: - -Check that you have ORACLE_HOME, ORACLE_USERID, ORACLE_SID environment -variables set, like this: - -ORACLE_HOME=="/export/home/oracle/u01/app/oracle/product/9.2.0.1.0 -ORACLE_USERID=STARSHIP/STARSHIP -ORACLE_SID=COLORADO - -When you run <>, you will probably get this errors: - -// ************************ Error 3 ***********************/ - -bash-2.05# make test -PERL_DL_NONLAZY=1 /usr/local/bin/perl "-MExtUtils::Command::MM" "-e" -"test_harness(0, 'blib/lib', 'blib/arch')" t/*.t -t/01base................ok -t/10general.............DBI connect('','STARSHIP/STARSHIP',...) failed: -ORA-12545: Connect failed because target host or object does not exist -(DBD ERROR: OCIServerAttach) at t/10general.t line 12 -Undefined subroutine &main::BAILOUT called at t/10general.t line 15. -# Looks like your test died before it could output anything. -t/10general.............dubious - Test returned status 255 (wstat 65280, 0xff00) -DIED. FAILED tests 1-31 - Failed 31/31 tests, 0.00% okay -..... - -// *****************************************************/ - -One more brainstorm, and I figured out another way to set ORACLE_USERID: - -ORACLE_USERID=STARSHIP/STARSHIP@COLORADO -ORACLE_SID=COLORADO - -Later, when tests finished, I was confirmed that it was probably -preferred way of setting ORACLE_USERID. -Tests did found correct settings, and "main" set of them returned the -following report: - -All tests successful, 1 test and 122 subtests skipped. -Files=18, Tests=1020, 24 wallclock secs (11.27 cusr + 1.34 csys = 12.61 -CPU) - -For the Extra test, less formal, but test anyway, I just commented these -two lines in test.pl file - -$dbname = $ARGV[0] || ''; # if '' it'll use TWO_TASK/ORACLE_SID -$dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; - -and set the same values in the same form to the $dbuser as it was in -ORACLE_USERID , and -left $dbname empty, - -$dbname = ''; -$dbuser = 'STARSHIP/STARSHIP@COLORADO'; - -and got pretty good report: - -Connecting - to '' (from command line, else uses ORACLE_SID or TWO_TASK - -recommended) - as 'STARSHIP/STARSHIP@COLORADO' (via ORACLE_USERID env var or default - -recommend name/passwd@dbname) -(ORACLE_SID='', TWO_TASK='') -Fields: 6 -Names: 'NUM_T' 'DATE_T' 'CHAR_T' 'ROWID_T' -'RAW_T' 'NULL_T' -Lengths: 172 76 121 21 3 1 -OraTypes: 2 12 1 104 23 1 -SQLTypes: 8 93 12 -9104 -2 12 -Scale: 0 0 0 0 0 0 -Precision: 126 75 120 20 2 0 -Nullable: 1 1 1 1 1 1 -Est row width: 32 -Data rows: - fetch: '7.2', '21-DEC-04', 'STARSHIP', 'AAAADeAABAAAAZSAAA', '7D', -undef - -ora_logoff... -lda out of scope... - -Testing repetitive connect/open/close/disconnect: -If this test hangs then read the README.help file. -Expect sequence of digits, no other messages: -1 2 3 4 5 - -Test interaction of explicit close/logoff and implicit DESTROYs -Expect just 'done.', no other messages: -done. - -Testing row cache (5). -Test completed in 0 seconds. - -Test complete (0 seconds). -If the tests above have produced the 'expected' output then they have -passed. - -IV. The last part is actually target of all steps above, installing -build module. < did not surprise me, and it it passed -smoothly. - -bash-2.05# make install -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/dbdimp -.h -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/ocitra -ce.h -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/Oracle -.h -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/mk.pm -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/Oracle -.so -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/Oracle -.bs -Files found in blib/arch: installing files in blib/lib into architecture -dependent library tree -Installing /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/oraperl.ph -Installing /usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/Oraperl.pm -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/DBD/Oracle.pm -Installing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/DBD/Oracle/GetInfo.pm -Installing /usr/local/share/man/man1/ora_explain.1 -Installing /usr/local/share/man/man3/DBD::Oracle.3 -Installing /usr/local/share/man/man3/DBD::Oraperl.3 -Installing /usr/local/bin/ora_explain -Writing -/usr/local/lib/perl5/site_perl/5.8.5/sun4-solaris/auto/DBD/Oracle/.packl -ist -Appending installation info to -/usr/local/lib/perl5/5.8.5/sun4-solaris/perllocal.pod - -V. This is actually it, and you do not need to do anything else. But -investigating different errors during the various steps, I found the -very simple "independent sanity" testdbi perl script written by Jeff -Hunter. This script is not related to standard process of -making/buildin/testing/installation. It just verifies that you can -access DB and run a couple queries against it. The code itself, -testdbi.pl can be found at -http://www.idevelopment.info/data/Oracle/DBA_tips/Programming/PROGRAMMIN -G_2.shtml - -You just should set connection information, similar to how I did it, - - $ORACLE_SID = "COLORADO"; - $ORACLE_USERID = "STARSHIP"; - $ORACLE_PASSWORD = "STARSHIP"; - - $ENV{'ORACLE_SID'} = "$ORACLE_SID"; - $ENV{'ORACLE_HOME'} = /u01/app/oracle/product/9.2.0.1.0"; - -run it as any perl script, <>, and see result: - -bash-2.05# perl testdbi.pl - -Running testdbi.pl... - - (*) Attempting Oracle Login ... - OK - (*) Creating table TEST_DBI ... - OK - (*) Insert into TEST_DBI ... - 1 rows inserted. - 1 rows inserted. - 1 rows inserted. - OK - (*) Select from TEST_DBI ... - - --> TEST_DBI_INTR_NO : 1000 - --> TEST_DBI_NAME : Jeff Hunter - - --> TEST_DBI_INTR_NO : 1001 - --> TEST_DBI_NAME : Melody Hunter - - --> TEST_DBI_INTR_NO : 1002 - --> TEST_DBI_NAME : Alex Hunter - OK - - (*) Delete from TEST_DBI ... - 3 rows deleted. - OK - - (*) Drop table TEST_DBI ... - OK - - (*) Select USER and SYSTEM ... - - --> USER : STARSHIP - --> SYSDATE : 21-DEC-2004 16:49:59 - OK - - (*) Attempting Oracle Logoff ... - OK - -Ending testdbi.pl... - -With the best regards, - -Alex Zarutin - -Software Engineer -4thpass A Motorola Company -Seattle, WA -www.4thpass.com - - - - diff --git a/err_build/err_testfailnotable.msg b/err_build/err_testfailnotable.msg deleted file mode 100644 index 687d5ed7..00000000 --- a/err_build/err_testfailnotable.msg +++ /dev/null @@ -1,97 +0,0 @@ -From SRS0=RhpE=NO=perl.org=dbi-dev-return-3750-Tim.Bunce=pobox.com@bounce2.pobox.com Wed Oct 27 18:10:51 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i9RHAOAK026067 - for ; Wed, 27 Oct 2004 18:10:51 +0100 (BST) - (envelope-from SRS0=RhpE=NO=perl.org=dbi-dev-return-3750-Tim.Bunce=pobox.com@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 27 Oct 2004 18:10:51 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CMp30-0000e2-Hh; - Wed, 27 Oct 2004 14:45:10 +0000 -Received: from [194.217.242.77] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CMp30-0000e2-Hh - for pobox@data-plan.com; Wed, 27 Oct 2004 14:45:10 +0000 -Received: from [208.210.124.73] (helo=gold.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1CMp30-0001QS-2p - for pobox@data-plan.com; Wed, 27 Oct 2004 14:45:10 +0000 -Received: from gold.pobox.com (localhost [127.0.0.1]) - by gold.pobox.com (Postfix) with ESMTP id 87C155A7D; - Wed, 27 Oct 2004 10:45:09 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from gold (localhost [127.0.0.1]) - by gold.pobox.com (Postfix) with ESMTP id 7779A59A1 - for ; Wed, 27 Oct 2004 10:45:09 -0400 (EDT) -Received-SPF: pass (gold.pobox.com: domain of dbi-dev-return-3750-Tim.Bunce=pobox.com@perl.org designates 63.251.223.186 as permitted sender) -X-SPF-Guess: pass (seems reasonable for dbi-dev-return-3750-Tim.Bunce=pobox.com@perl.org to mail through 63.251.223.186) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.186(x6.develooper.com) -Received: from lists.develooper.com (x6.develooper.com [63.251.223.186]) - by gold.pobox.com (Postfix) with SMTP id DC5795A4A - for ; Wed, 27 Oct 2004 10:45:07 -0400 (EDT) -Received: (qmail 18140 invoked by uid 514); 27 Oct 2004 14:45:04 -0000 -Mailing-List: contact dbi-dev-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-dev@perl.org -Received: (qmail 18131 invoked from network); 27 Oct 2004 14:45:04 -0000 -Received: from x1.develooper.com (63.251.223.170) - by lists.develooper.com with SMTP; 27 Oct 2004 14:45:04 -0000 -Received: (qmail 8663 invoked by uid 225); 27 Oct 2004 14:45:03 -0000 -Delivered-To: dbi-dev@perl.org -Received: (qmail 8659 invoked by alias); 27 Oct 2004 14:45:03 -0000 -X-Spam-Status: No, hits=-4.9 required=8.0 - tests=BAYES_00 -X-Spam-Check-By: la.mx.develooper.com -Received: from ns2.aramiska.net (HELO dmzms01.aramiska.net) (80.242.32.2) - by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Wed, 27 Oct 2004 07:45:01 -0700 -Received: from ip-80-242-36-115.aramiska-arc.aramiska.net (ip-80-242-36-115.aramiska-arc.aramiska.net [80.242.36.115]) - by dmzms01.aramiska.net (Postfix) with ESMTP - id 9F21E1100D9; Wed, 27 Oct 2004 14:44:55 +0000 (UTC) -Received: from localhost (localhost [127.0.0.1]) - by ip-80-242-36-115.aramiska-arc.aramiska.net (Postfix) with ESMTP - id E558E7C; Wed, 27 Oct 2004 14:44:52 +0000 (UTC) -Received: from dansat.data-plan.com (ip-192-168-0-3.internal.data-plan.aramiska.net [192.168.0.3]) - by ip-80-242-36-115.aramiska-arc.aramiska.net (Postfix) with ESMTP - id D8A5E71; Wed, 27 Oct 2004 14:44:50 +0000 (UTC) -Received: from dansat.data-plan.com (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i9REioAA023212; - Wed, 27 Oct 2004 15:44:50 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: (from timbo@localhost) - by dansat.data-plan.com (8.12.9/8.12.9/Submit) id i9REinmW023211; - Wed, 27 Oct 2004 15:44:49 +0100 (BST) -Date: Wed, 27 Oct 2004 15:44:49 +0100 -From: Tim Bunce -To: "H.Merijn Brand" -Cc: Tim Bunce , DBI developers -Subject: Re: ANNOUNCE: DBD::Oracle 1.16 -Message-ID: <20041027144449.GB19991@dansat.data-plan.com> -References: <20041022213625.GA22377@dansat.data-plan.com> <20041027093516.D001.H.M.BRAND@hccnet.nl> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <20041027093516.D001.H.M.BRAND@hccnet.nl> -User-Agent: Mutt/1.4i -X-Virus-Scanned: by Aramiska Arc -Status: RO -Content-Length: 634 -Lines: 14 - -On Wed, Oct 27, 2004 at 09:39:33AM +0200, H.Merijn Brand wrote: -> On Fri 22 Oct 2004 23:36, Tim Bunce wrote: -> > file: $CPAN/authors/id/T/TI/TIMB/DBD-Oracle-1.16.tar.gz -> > size: 235224 bytes -> > md5: 9711550ed0ebfc743920a6a357ed717c -> -> I know you can't blame the test for not being able to create a table for the -> reason this failure shows, but there might be a more user-friendly way to fail ... - -Yeap. Some tests behave better in that situation. Looks like those -two need improving. Patches welcome! (I'd happily not touch DBD::Oracle -for a few months after the pain of the last few months :) - -Tim. - diff --git a/err_docs/err_trace.msg b/err_docs/err_trace.msg deleted file mode 100644 index 3d7500fb..00000000 --- a/err_docs/err_trace.msg +++ /dev/null @@ -1,14 +0,0 @@ -Add this to the DBD::Oracle docs as a handy note: - -$dbh->do(q{alter session set events '65285 trace name errorstack level 3'}); - -A trace file should then be generated. - -Trace files are generated in the 'user_dump_destination' specified in init.ora. - -Try $ORACLE_BASE/admin/$ORACLE_SID/udump. - -or the location returned by -select value -from v$parameter -where name like '%user_dump%' diff --git a/err_lob/err_csr_clob.msg b/err_lob/err_csr_clob.msg deleted file mode 100644 index 397d53b3..00000000 --- a/err_lob/err_csr_clob.msg +++ /dev/null @@ -1,65 +0,0 @@ -From dbi-users-bounce@isc.org Thu Sep 21 20:27:21 2000 -Return-Path: -Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id UAA18945; Thu, 21 Sep 2000 20:27:20 +0100 (BST) -Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) - id <02709-1@oink>; Mon, 21 Sep 1970 20:26:40 +0100 -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 969564156:20:26825:1; Thu, 21 Sep 2000 19:22:36 GMT -Received: from pub3.rc.vix.com ([204.152.186.34]) by punt-2.mail.demon.net - id aa2026778; 21 Sep 2000 19:22 GMT -Received: from pub3.rc.vix.com (pub3.rc.vix.com [204.152.186.34]) - by pub3.rc.vix.com (Postfix) with ESMTP id 28A613E5D; - Thu, 21 Sep 2000 12:22:17 -0700 (PDT) -Received: with LISTAR (v1.0.0; list dbi-users); - Thu, 21 Sep 2000 12:17:37 -0700 (PDT) -Received: from isrv3.isc.org (isrv3.isc.org [204.152.184.87]) - by pub3.rc.vix.com (Postfix) with ESMTP id A59853E42 - for ; - Thu, 21 Sep 2000 12:17:32 -0700 (PDT) -Received: from wheel.cs.wisc.edu (wheel.cs.wisc.edu [128.105.121.12]) - by isrv3.isc.org (8.9.1/8.9.1) via ESMTP id MAA00855 - for ; - Thu, 21 Sep 2000 12:17:32 -0700 (PDT) env-from (horn@wheel.cs.wisc.edu) -Received: (from horn@localhost) by wheel.cs.wisc.edu (8.9.2/8.9.2) id OAA16413 - for dbi-users@isc.org; Thu, 21 Sep 2000 14:17:28 -0500 (CDT) -Date: Thu, 21 Sep 2000 14:17:28 -0500 (CDT) -From: Jeffrey Horn -Message-Id: <200009211917.OAA16413@wheel.cs.wisc.edu> -To: dbi-users@isc.org -Subject: Setting ORA_TYPE after the fact... -Sender: horn@wheel.cs.wisc.edu -Sender: dbi-users-bounce@isc.org -Errors-To: dbi-users-bounce@isc.org -X-original-sender: horn@cs.wisc.edu -Precedence: bulk -List-unsubscribe: -X-List-ID: -List-owner: -List-post: -Status: RO -X-Status: A -Content-Length: 969 -Lines: 20 - -I have a situation where I would like to return a cursor that contains a -CLOB as one of it's attributes from a PL/SQL procedure. What I get back is -a LOB locator and DBD doesn't actually read the CLOB but instead returns an -error. - -If I go through a bind/prepare/execute/fetch on a similar SQL statement all -is well. Is there any way that I can tell DBD that a given attribute of -a cursor is a CLOB once the cursor is already opened so that DBD will do the -right thing? - --- Jeff Horn - - ------------------------------------------------------------------------------- -DBI HOME PAGE AND ARCHIVES: http://www.symbolstone.org/technology/perl/DBI/ -To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html -If you are without web access, or if you are having trouble with the web page, -please send mail to dbi-users-request@isc.org with the subject line of: -'unsubscribe'. ------------------------------------------------------------------------------- - diff --git a/err_lob/err_loblenwide.msg b/err_lob/err_loblenwide.msg deleted file mode 100644 index 08023e97..00000000 --- a/err_lob/err_loblenwide.msg +++ /dev/null @@ -1,95 +0,0 @@ -From nobody@fsck.com Thu Dec 4 07:36:20 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id hB47Y2nE066844 - for ; Thu, 4 Dec 2003 07:36:20 GMT - (envelope-from nobody@fsck.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 04 Dec 2003 07:36:20 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1ARgrA-0005O4-5M; - Wed, 03 Dec 2003 23:56:32 +0000 -Received: from [207.8.214.2] (helo=icicle.pobox.com) - by punt-3.mail.demon.net with esmtp id 1ARgrA-0005O4-5M - for pobox@dbi.demon.co.uk; Wed, 03 Dec 2003 23:56:32 +0000 -Received: from icicle.pobox.com (localhost[127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 314AB9A28F - for ; Wed, 3 Dec 2003 18:56:32 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost[127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 188369A287 - for ; Wed, 3 Dec 2003 18:56:32 -0500 (EST) -Received: from x1.develooper.com (x1.develooper.com[63.251.223.170]) - by icicle.pobox.com (Postfix) with SMTP - for ; Wed, 3 Dec 2003 18:56:31 -0500 (EST) -Received: (qmail 3178 invoked by uid 225); 3 Dec 2003 23:56:30 -0000 -Delivered-To: TIMB@cpan.org -Received: (qmail 3174 invoked by alias); 3 Dec 2003 23:56:29 -0000 -Received: from pallas.eruditorum.org (HELO pallas.eruditorum.org) (63.251.136.85) by la.mx.develooper.com (qpsmtpd/0.27-dev) with ESMTP; Wed, 03 Dec 2003 15:56:18 -0800 -Received: by pallas.eruditorum.org (Postfix, from userid 65534) id 91512114F1; Wed, 3 Dec 2003 18:56:07 -0500 (EST) -Subject: [cpan #4564] Perl DBI bug handling CLOBs -From: "Jay Turner via RT" -Reply-To: bug-DBI@rt.cpan.org -In-Reply-To: -Message-ID: -Precedence: bulk -X-RT-Loop-Prevention: cpan -RT-Ticket: cpan #4564 -Managed-by: RT 2.0.15 (http://bestpractical.com/rt/) -RT-Originator: J.Turner@mdl.com -To: "AdminCc of cpan Ticket #4564": ; -Date: Wed, 3 Dec 2003 18:56:07 -0500 (EST) -X-Spam-Check-By: la.mx.develooper.com -X-Spam-Status: No, hits=2.1 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,SPAM_PHRASE_01_02,TO_HAS_SPACES,TO_MALFORMED version=2.44 -Status: RO -X-Status: A -Content-Length: 1853 -Lines: 46 - - -This message about DBI was sent to you by J.Turner@mdl.com via rt.cpan.org - -Full context and any attached attachments can be found at: - - - -Date: Fri, 28 Feb 2003 16:55:28 -0800 - -It has come to my attention that PERL DBI counts on OCILobGetLength -returning BYTES. It returns CHARACTERS instead, which is the count of -variable-width characters. For multi-byte character sets this results -in errors such as: - -DBD::Oracle::st fetch failed: ORA-03130: the buffer for the next piece -to be fetched is required (DBD ERROR: OCILobGetLength) at id rmsc01.pl -line 294. - -The correct way to read CLOBs is - -1) Query the LOB locator for the CSID and CSFRM (character set ID and -form). A character set >= 800 is a mulitbyte character set and csfrm -<> 0 is CLOB. - -2) Pass the CSID and CSFRM to OCILobRead with AMT=0 and pass your -buffer address and size. - -3) Your callback routine must either be capable of completing the I/O -by allocating additional buffers, or it must notify the caller of -OCILobRead to free the lob locator, since an incomplete read jams the -locator-you can't use it for anything else without finishing the read -(attempts to reuse the locator will result in errors). - -Likewise, with OCILobWrite, you have to pass the CSID and CSFRM, with -AMT=0 and the buffer size in bytes. The callback can just say it has -zero bytes and set piece=OCI_LAST_PIECE. - -You cannot use the return value of OCILobGetLength as the size of the -data that is being read. The actual size of the data is unknown for -variable-width characters, and the buffer has to be big enough to -accomplish the translation, so you can't just double or triple the -return value from OCILobGetLength (I have seen that approach fail). - -You can simulate the effects of a foreign character set by - -$ export NLS_LANG=Japanese - diff --git a/err_lob/err_lobtesttblfail.msg b/err_lob/err_lobtesttblfail.msg deleted file mode 100644 index 1333ee88..00000000 --- a/err_lob/err_lobtesttblfail.msg +++ /dev/null @@ -1,208 +0,0 @@ -From SRS0=sbeK=NO=perl.org=dbi-dev-return-3749-Tim.Bunce=pobox.com@bounce2.pobox.com Wed Oct 27 15:22:22 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i9RELAAO018624 - for ; Wed, 27 Oct 2004 15:22:22 +0100 (BST) - (envelope-from SRS0=sbeK=NO=perl.org=dbi-dev-return-3749-Tim.Bunce=pobox.com@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 27 Oct 2004 15:22:22 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CMiQ8-0000Eo-FG; - Wed, 27 Oct 2004 07:40:36 +0000 -Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CMiQ8-0000Eo-FG - for pobox@data-plan.com; Wed, 27 Oct 2004 07:40:36 +0000 -Received: from [207.8.226.3] (helo=icicle.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1CMiQ8-0006dS-9n - for pobox@data-plan.com; Wed, 27 Oct 2004 07:40:36 +0000 -Received: from icicle.pobox.com (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id B3BB911C325; - Wed, 27 Oct 2004 03:40:35 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from icicle (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 9947911C2CE - for ; Wed, 27 Oct 2004 03:40:35 -0400 (EDT) -Received-SPF: pass (icicle.pobox.com: domain of dbi-dev-return-3749-Tim.Bunce=pobox.com@perl.org designates 63.251.223.186 as permitted sender) -X-SPF-Guess: pass (seems reasonable for dbi-dev-return-3749-Tim.Bunce=pobox.com@perl.org to mail through 63.251.223.186) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.186(x6.develooper.com) -Received: from lists.develooper.com (x6.develooper.com [63.251.223.186]) - by icicle.pobox.com (Postfix) with SMTP id 5033611C34F - for ; Wed, 27 Oct 2004 03:39:46 -0400 (EDT) -Received: (qmail 12004 invoked by uid 514); 27 Oct 2004 07:39:43 -0000 -Mailing-List: contact dbi-dev-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-dev@perl.org -Received: (qmail 11995 invoked from network); 27 Oct 2004 07:39:43 -0000 -Received: from x1.develooper.com (63.251.223.170) - by lists.develooper.com with SMTP; 27 Oct 2004 07:39:43 -0000 -Received: (qmail 13565 invoked by uid 225); 27 Oct 2004 07:39:43 -0000 -Delivered-To: dbi-dev@perl.org -Received: (qmail 13560 invoked by alias); 27 Oct 2004 07:39:42 -0000 -X-Spam-Status: No, hits=-3.7 required=8.0 - tests=BAYES_00,LARGE_HEX -X-Spam-Check-By: la.mx.develooper.com -Received: from smtp-vbr15.xs4all.nl (HELO smtp-vbr15.xs4all.nl) (194.109.24.35) - by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Wed, 27 Oct 2004 00:39:40 -0700 -Received: from [127.0.0.1] (procura.xs4all.nl [213.84.163.145]) - by smtp-vbr15.xs4all.nl (8.12.11/8.12.11) with ESMTP id i9R7dWHI013040; - Wed, 27 Oct 2004 09:39:34 +0200 (CEST) - (envelope-from h.m.brand@hccnet.nl) -Date: Wed, 27 Oct 2004 09:39:33 +0200 -From: "H.Merijn Brand" -To: Tim Bunce -Subject: Re: ANNOUNCE: DBD::Oracle 1.16 -Cc: DBI developers -In-Reply-To: <20041022213625.GA22377@dansat.data-plan.com> -References: <20041022213625.GA22377@dansat.data-plan.com> -Message-Id: <20041027093516.D001.H.M.BRAND@hccnet.nl> -MIME-Version: 1.0 -Content-Type: text/plain; charset="US-ASCII" -X-Mailer: Becky! ver. 2.11.02 [en] -X-Virus-Scanned: by XS4ALL Virus Scanner -X-Virus-Checked: Checked -Content-Transfer-Encoding: 8bit -X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id i9RELAAO018624 -Status: RO -X-Status: A -Content-Length: 7175 -Lines: 134 - -On Fri 22 Oct 2004 23:36, Tim Bunce wrote: -> file: $CPAN/authors/id/T/TI/TIMB/DBD-Oracle-1.16.tar.gz -> size: 235224 bytes -> md5: 9711550ed0ebfc743920a6a357ed717c - -I know you can't blame the test for not being able to create a table for the -reason this failure shows, but there might be a more user-friendly way to fail ... - -I'll report back when the DBA has fixed the tablespace - -HP-UX 11.11/64 (11i) + Oracle-9.2.0/64 + perl-5.8.5-dor/64 - -PERL_DL_NONLAZY=1 /pro/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, -'blib/lib', 'blib/arch')" t/*.t -t/01base................ok -t/10general.............ok -t/15nls.................ok -t/20select..............ok -t/21nchar............... Database and client versions and character sets: -Database 9.2.0.1.0 CHAR set is US7ASCII (Non-Unicode), NCHAR set is AL16UTF16 ( -nicode) -Client 9.2.0.1 NLS_LANG is '', NLS_NCHAR is '' -t/21nchar...............ok -t/22nchar_al32utf8......ok -t/22nchar_utf8..........ok -t/23wide_db.............skipped - all skipped: Database character set is not Unicode -t/23wide_db_8bit........skipped - all skipped: Database character set is not Unicode -t/23wide_db_al32utf8....skipped - all skipped: Database character set is not Unicode -t/24implicit_utf8.......ok -t/25plsql...............ok -t/30long................ok 188/470DBD::Oracle::db do failed: ORA-03237: Initial -Extent of specified size cannot be allocated in tablespace (PROBEV) (DBD ERROR: -OCIStmtExecute) [for Statement "create table dbd_ora__drop_me ( idx integer, ln - NCLOB, dt date )"] at t/nchar_test_lib.pl line 356. -t/30long................ok 189/470DBD::Oracle::st execute failed: ORA-00942: ta -le or view does not exist (DBD ERROR: error possibly near <*> indicator at char -12 in 'insert into <*>dbd_ora__drop_me values (:p1, :p2, SYSDATE)') [for Statem -nt "insert into dbd_ora__drop_me values (?, ?, SYSDATE)" with ParamValues: :p1= -0, :p2='0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0 -x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0 -x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0 -x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0 -x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0.x.X0 -x.X...'] at t/30long.t line 153. -# Failed test (t/30long.t at line 153) -t/30long................NOK 190DBD::Oracle::st execute failed: ORA-00942: table -or view does not exist (DBD ERROR: error possibly near <*> indicator at char 12 -in 'insert into <*>dbd_ora__drop_me values (:p1, :p2, SYSDATE)') [for Statement -"insert into dbd_ora__drop_me values (?, ?, SYSDATE)" with ParamValues: :p1=41, -:p2='12345678901234567890123456789012345678901234567890123456789012345678901234 -6789012345678901234567890123456789012345678901234567890123456789012345678901234 -6789012345678901234567890123456789012345678901234567890123456789012345678901234 -6789012345678901234567890123456789012345678901234567890123456789012345678901234 -6789012345678901234567890123456789012345678901234567890123456789012345678901234 -...'] at t/30long.t line 154. -# Failed test (t/30long.t at line 154) -t/30long................NOK 191DBD::Oracle::st execute failed: ORA-00942: table -or view does not exist (DBD ERROR: error possibly near <*> indicator at char 12 -in 'insert into <*>dbd_ora__drop_me values (:p1, :p2, SYSDATE)') [for Statement -"insert into dbd_ora__drop_me values (?, ?, SYSDATE)" with ParamValues: :p1=42, -:p2='2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcd -fabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcd -fabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcd -fabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcd -fabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcdefabcd2bcd -...'] at t/30long.t line 155. -t/30long................NOK 192# Failed test (t/30long.t at line 155) -DBD::Oracle::st execute failed: ORA-00942: table or view does not exist (DBD ER -OR: error possibly near <*> indicator at char 12 in 'insert into <*>dbd_ora__dr -p_me values (:p1, :p2, SYSDATE)') [for Statement "insert into dbd_ora__drop_me -alues (?, ?, SYSDATE)" with ParamValues: :p1=43, :p2=undef] at t/30long.t line -56. -# Failed test (t/30long.t at line 156) -t/30long................NOK 193DBD::Oracle::db prepare failed: ORA-00942: table -or view does not exist (DBD ERROR: error possibly near <*> indicator at char 14 -in 'select * from <*>dbd_ora__drop_me order by idx') [for Statement "select * f -om dbd_ora__drop_me order by idx"] at t/30long.t line 170. -# Failed test (t/30long.t at line 170) -Can't call method "trace" on an undefined value at t/30long.t line 171. -t/30long................NOK 194# Looks like you planned 470 tests but only ran -94. -# Looks like your test died just after 194. -t/30long................dubious - Test returned status 255 (wstat 65280, 0xff00) -DIED. FAILED tests 190-470 - Failed 281/470 tests, 40.21% okay (less 122 skipped tests: 67 okay, 14. -6%) -t/31lob.................DBD::Oracle::db do failed: ORA-03237: Initial Extent of -specified size cannot be allocated in tablespace (PROBEV) (DBD ERROR: OCIStmtEx -cute) [for Statement " - CREATE TABLE dbd_ora__drop_me ( - id INTEGER NOT NULL, - data BLOB - ) - "] at t/31lob.t line 21. -DBD::Oracle::db do failed: ORA-00942: table or view does not exist (DBD ERROR: -rror possibly near <*> indicator at char 12 in 'INSERT INTO <*>dbd_ora__drop_me -(id,data) VALUES (1, EMPTY_BLOB())') [for Statement "INSERT INTO dbd_ora__drop_ -e (id,data) VALUES (1, EMPTY_BLOB())"] at t/31lob.t line 31. -DBD::Oracle::db prepare failed: ORA-00942: table or view does not exist (DBD ER -OR: error possibly near <*> indicator at char 17 in 'SELECT data FROM <*>dbd_or -__drop_me WHERE id = :p1') [for Statement "SELECT data FROM dbd_ora__drop_me WH -RE id = ?"] at t/31lob.t line 34. -Can't call method "bind_param" on an undefined value at t/31lob.t line 36. -# Looks like your test died before it could output anything. -t/31lob.................dubious - Test returned status 255 (wstat 65280, 0xff00) -DIED. FAILED tests 1-2 - Failed 2/2 tests, 0.00% okay -t/40ph_type.............ok -t/50cursor..............ok -t/60reauth..............ORACLE_USERID_2 not defined. Tests skipped. -skipped - all skipped: no reason given -t/70meta................ok -Failed Test Stat Wstat Total Fail Failed List of Failed -------------------------------------------------------------------------------- -t/30long.t 255 65280 470 557 118.51% 190-470 -t/31lob.t 255 65280 2 4 200.00% 1-2 -4 tests and 122 subtests skipped. -Failed 2/18 test scripts, 88.89% okay. 283/1883 subtests failed, 84.97% okay. -make: *** [test_dynamic] Error 255 - --- -H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/) -using perl-5.6.1, 5.8.0 & 633 on HP-UX 10.20 & 11.00, AIX 4.2, AIX 4.3, - WinNT 4, Win2K pro & WinCE 2.11 often with Tk800.024 &/| DBD-Unify -ftp://ftp.funet.fi/pub/languages/perl/CPAN/authors/id/H/HM/HMBRAND/ - - - - diff --git a/err_lob/err_nclob_form.msg b/err_lob/err_nclob_form.msg deleted file mode 100644 index 05587693..00000000 --- a/err_lob/err_nclob_form.msg +++ /dev/null @@ -1,189 +0,0 @@ -From dbi-users-return-19548-Tim.Bunce=pobox.com@perl.org Tue Jul 22 07:40:59 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id h6M6UUD7096422 - for ; Tue, 22 Jul 2003 07:40:58 +0100 (BST) - (envelope-from dbi-users-return-19548-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 22 Jul 2003 07:40:58 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1058814697:11:26523:33; Mon, 21 Jul 2003 19:11:37 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1126786; 21 Jul 2003 19:11 GMT -Received: from dolly1.pobox.com (localhost [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id E855B21C37F - for ; Mon, 21 Jul 2003 15:11:18 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) - by dolly1.pobox.com (Postfix) with SMTP id 9010121C236 - for ; Mon, 21 Jul 2003 15:11:17 -0400 (EDT) -Received: (qmail 66848 invoked by uid 1005); 21 Jul 2003 19:11:15 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 66832 invoked by uid 76); 21 Jul 2003 19:11:15 -0000 -Received: from qmailr@one.develooper.com (HELO ran-out.mx.develooper.com) (64.81.84.115) by onion.perl.org (qpsmtpd/0.26) with SMTP; Mon, 21 Jul 2003 12:11:15 -0700 -Received: (qmail 559 invoked by uid 225); 21 Jul 2003 19:11:08 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 552 invoked by uid 507); 21 Jul 2003 19:11:07 -0000 -Received-SPF: unknown -Received: from sneakemail.com (HELO monkey.sneakemail.com) (207.106.87.13) by one.develooper.com (qpsmtpd/0.27-dev) with SMTP; Mon, 21 Jul 2003 12:11:03 -0700 -Received: (qmail 22505 invoked by uid 501); 21 Jul 2003 19:10:57 -0000 -Received: (sneakemail censored 13502-46198 #3); 21 Jul 2003 19:10:57 -0000 -Received: (sneakemail censored 13502-46198 #2); 21 Jul 2003 19:10:57 -0000 -Received: (sneakemail censored 13502-46198 #1); 21 Jul 2003 19:10:57 -0000 -Date: Mon, 21 Jul 2003 21:10:53 +0200 -From: "Wolfgang Weisselberg" -To: dbi-users@perl.org -Subject: DBD::Oracle and unicode-NCLOBs leads to ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead) -Message-ID: <13502-46198@sneakemail.com> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.4.1i -X-SMTPD: qpsmtpd/0.27-dev, http://develooper.com/code/qpsmtpd/ -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=0.6 required=7.0 tests=CARRIAGE_RETURNS,FROM_ENDS_IN_NUMS,FROM_HAS_MIXED_NUMS,SPAM_PHRASE_00_01,USER_AGENT,USER_AGENT_MUTT version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Status: RO -X-Status: A -Content-Length: 6055 -Lines: 132 - -Hello all! - -Even after extensive googling and looking through the docs I fail -to fetch NCLOBs from an Oracle 9.2i database where the national -character set is unicode. - -I believe it has been done before, but I could not find anything ... -I would be grateful for any pointers. - - -NCLOBs work like CLOBs when the national character set is not -unicode, even with the old DBI 1.21 and DBD::Oracle 1.12 on an -Oracle 8 client. NVarchar2 and NChar work OK even with unicode. - -Setting NSL_LANG to AMERICAN_AMERICA.UTF8 or .AL32UTF8 does not -help, as I suspected. - -I tried using Oracle 9.2i (the DB is using 9.2i) on a Debian -Linux box. I upgraded DBI to 1.37 and DBD::Oracle to 1.14 (the -newest versions according to CPAN). I got zero errors on make -test with both. Perl is Debian's normal "perl5 (revision 5.0 -version 6 subversion 1)". - -A simple - select memo from unicode_test -(memo being the NCLOB field) fails (again, only with the national -charset being unicode). - -The relevant code snippet (RaiseError being set, of course): - -| $| = 1; -| print "DBI: $DBI::VERSION\n", -| "DBD::Oracle $DBD::Oracle::VERSION\n"; -| my $sth = $dbh->prepare("select memo from unicode_test"); -| $sth->execute(); -| -| while ( my ($memo) = $sth->fetchrow_array() ) { -| print Dumper $memo; -| } -| exit; - - -The output: - -| DBI: 1.37 -| DBD::Oracle 1.14 -| $VAR1 = ''; -| $VAR1 = ''; -| DBD::Oracle::st fetchrow_array failed: ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead) [for statement ``select memo from unicode_test'' with params: ]) at nclobtest.pl line 77. -| DBD::Oracle::st fetchrow_array failed: ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead) [for statement ``select memo from unicode_test'' with params: ]) at nclobtest.pl line 77. - - - -Running with tracelevel 3: - [...] -| dbd_st_prepare'd sql SELECT -| dbd_describe SELECT (EXPLICIT, lb 99999999)... -| fbh 1: 'MEMO' NO null , otype 112->112, dbsize 4000/4000, p0.s0 -| dbd_describe'd 1 columns (row bytes: 4000 max, 4000 est avg, cache: 6) -| <- prepare= DBI::st=HASH(0x831643c) at nclobtest.pl line 78 via nclobtest.pl line 60 -| -> execute for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -| dbd_st_execute SELECT (out0, lob0)... -| dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) -| <- execute= '0E0' at nclobtest.pl line 79 via nclobtest.pl line 60 -| -> fetchrow_array for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -| dbd_st_fetch 1 fields... -| dbih_setup_fbav for 1 fields => 0x82f8e34 -| dbd_st_fetch 1 fields SUCCESS -| OCILobRead field 2 SKIPPED: LOBlen 0, LongReadLen 99999999, BufLen 0, Got 0 -| <- fetchrow_array= ( '' ) [1 items] row1 at nclobtest.pl line 81 via nclobtest.pl line 60 -| $VAR1 = ''; -[EXACTLY the same "-> fetchrow_array" to "<- fetchrow_array" again] -| $VAR1 = ''; -| -> fetchrow_array for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -| dbd_st_fetch 1 fields... -| dbd_st_fetch 1 fields SUCCESS -| OCILobRead field 2 ERROR: LOBlen 6c, LongReadLen 99999999c, BufLen 24b, Got 6c -| !! ERROR: 24806 'ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead)' -| <- fetchrow_array= ( ) [0 items] row3 at nclobtest.pl line 81 via nclobtest.pl line 60 -| 1 -> FETCH for DBD::Oracle::st (DBI::st=HASH(0x82f8e28)~INNER 'ParamValues') -| error: 24806 'ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead)' -| 1 <- FETCH= HASH(0x831661c)0keys at nclobtest.pl line 81 via nclobtest.pl line 60 -| DBD::Oracle::st fetchrow_array failed: ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead) [for statement ``select memo from unicode_test'' with params: ]) at nclobtest.pl line 81. -| DBD::Oracle::st fetchrow_array failed: ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead) [for statement ``select memo from unicode_test'' with params: ]) at nclobtest.pl line 81. - - - -Tracelevel 9 (yes, it's a bit verbose :-/ ) - -[...] -| OCIDescriptorAlloc(0x831c058,0x8395228,OCI_DTYPE_LOB,0,0) -| fbh 1: 'MEMO' NO null , otype 112->112, dbsize 4000/4000, p0.s0 -| OCIAttrSet(0x8335b34,OCI_HTYPE_STMT,0xbffff30c,4,11,0x832d5a4)=SUCCESS -| OCIDefineByPos(0x8335b34,0x8395224,0x832d5a4,1,0x8395228,-1,112,0x83414e0,0x83414f0,0x8341500,0)=SUCCESS -| dbd_describe'd 1 columns (row bytes: 4000 max, 4000 est avg, cache: 6) -| <- prepare= DBI::st=HASH(0x831643c) at nclobtest.pl line 78 via nclobtest.pl line 60 -| -> execute for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -[...] -| -> fetchrow_array for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -| dbd_st_fetch 1 fields... -| OCIStmtFetch(0x8335b34,0x832d5a4,1,2,0)=SUCCESS -| dbih_setup_fbav for 1 fields => 0x82f8e34 -| dbd_st_fetch 1 fields SUCCESS -| OCILobGetLength(0x832d530,0x832d5a4,0x832c69c,0xbffff31c)=SUCCESS -| OCILobRead field 2 SKIPPED: LOBlen 0, LongReadLen 99999999, BufLen 0, Got 0 -| 0 (rc=0): '' -| <- fetchrow_array= ( '' ) [1 items] row1 at nclobtest.pl line 81 via nclobtest.pl line 60 -| $VAR1 = ''; -[EXACTLY the same "-> fetchrow_array" to "<- fetchrow_array" again] -| $VAR1 = ''; -| -> fetchrow_array for DBD::Oracle::st (DBI::st=HASH(0x831643c)~0x82f8e28) -| dbd_st_fetch 1 fields... -| OCIStmtFetch(0x8335b34,0x832d5a4,1,2,0)=SUCCESS -| dbd_st_fetch 1 fields SUCCESS -| OCILobGetLength(0x832d530,0x832d5a4,0x832c69c,0xbffff31c)=SUCCESS -| OCILobRead(0x832d530,0x832d5a4,0x832c69c,0xbffff318,1,0x8394da0,24,(nil),(nil),0,1)=ERROR -| OCILobRead field 2 ERROR: LOBlen 6c, LongReadLen 99999999c, BufLen 24b, Got 6c -| OCIErrorGet(0x832d5a4,1,"",0xbfffee88,"ORA-24806: LOB form mismatch -| ",1024,2)=SUCCESS -| OCIErrorGet after OCILobRead (er1:ok): -1, 24806: ORA-24806: LOB form mismatch -| -| OCIErrorGet(0x832d5a4,2,"",0xbfffee88,"ORA-24806: LOB form mismatch -| ",1024,2)=NO_DATA -| 0 (rc=0): undef -| !! ERROR: 24806 'ORA-24806: LOB form mismatch (DBD ERROR: OCILobRead)' -| <- fetchrow_array= ( ) [0 items] row3 at nclobtest.pl line 81 via nclobtest.pl line 60 -[gets and prints error message] - - -Any ideas anyone? - --Wolfgang - diff --git a/err_lob/err_nulllobsegv.msg b/err_lob/err_nulllobsegv.msg deleted file mode 100644 index 6de3c99b..00000000 --- a/err_lob/err_nulllobsegv.msg +++ /dev/null @@ -1,93 +0,0 @@ -From dbi-users-return-1743-Tim.Bunce=ig.co.uk@perl.org Wed Apr 11 04:00:48 2001 -Return-Path: -Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) - id EAA17912; Wed, 11 Apr 2001 04:00:48 +0100 (BST) -Received: from 194.217.242.36 by oink with SMTP (PP) id <02579-1@oink>; - Sat, 11 Apr 1970 04:00:28 +0100 -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 986956750:10:04398:0; Wed, 11 Apr 2001 02:39:10 GMT -Received: from tmtowtdi.perl.org ([209.85.3.25]) by punt-1.mail.demon.net - id aa1106187; 11 Apr 2001 2:39 GMT -Received: (qmail 32618 invoked by uid 508); 11 Apr 2001 02:39:06 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 32603 invoked from network); 11 Apr 2001 02:39:05 -0000 -Received: from owns.warpcore.org (216.81.249.18) by tmtowtdi.perl.org with SMTP; - 11 Apr 2001 02:39:05 -0000 -Received: (from thebrain@localhost) by owns.warpcore.org (8.11.1/8.11.1) - id f3B2cxH06298 for dbi-users@perl.org; - Tue, 10 Apr 2001 21:38:59 -0500 -Date: Tue, 10 Apr 2001 21:38:59 -0500 -From: Stephen Clouse -To: dbi-users@perl.org -Subject: Bizarre DBD::Oracle Segfault -Message-ID: <20010410213859.B2766@owns.warpcore.org> -Mail-Followup-To: dbi-users@perl.org -Mime-Version: 1.0 -Content-Type: text/plain -Content-Disposition: inline; filename="msg.pgp" -User-Agent: Mutt/1.2.5i -Status: RO -Content-Length: 1918 -Lines: 54 - ------BEGIN PGP SIGNED MESSAGE----- -Hash: SHA1 - -I sent an email to the dbi-users list about a number of DBD::Oracle CLOB -handling problems waaaaaaaaaaaaaaay back (end of January or so) that today -someone dug up and inquired if I had ever found fixes for what I had pointed -out. - -The problems outlined that day turned out to be the test script itself, which -was doing so much bizarre stuff on one statement that DBD::Oracle just went to -sleep instead (and so was the actual program that instigated the writing of the -test script). - -Well, all but one problem was the script. This, the most serious one, continues -to linger: - -my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); -$st->bind_param(3,undef,{ ora_type => ORA_CLOB }); -$st->execute('A','A',undef); - -On Linux, DBI 1.15, Oracle 8.1.6, and DBD::Oracle 1.06, this segfaults on the -execute. Unfortunately this manifests itself too deep in Oracle for me to -debug. - -The bizarre part is, either of the two snippets below will work: - -my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); -$st->bind_param(3,undef,{ ora_type => ORA_CLOB }); -$st->execute('A','A',''); -$st->execute('B','B',undef); - -my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); -$st->bind_param(3,undef,{ ora_type => ORA_CLOB }); -$st->execute('A','A',$lobvalue); -$st->execute('B','B',undef); - -It's only when binding undef as the LOB value in the very first execute of a -statement that the segfault occurs. At any other time, it's kosher. That -qualifies as bizarre in my book. - -Your guess is better than mine. - -- -- -Stephen Clouse -Senior Programmer, IQ Coordinator Project Lead -The IQ Group, Inc. - ------BEGIN PGP SIGNATURE----- -Version: PGP 6.5.8 - -iQA+AwUBOtPDwgOGqGs0PadnEQLmtgCeJHTStLu8Q8oFb9UQ4995f8vhZH8Al1p6 -RD5m0FEJH2tQiY0+b6542mQ= -=L0M+ ------END PGP SIGNATURE----- - diff --git a/err_lob/err_tmplobfree.msg b/err_lob/err_tmplobfree.msg deleted file mode 100644 index 0ec8f940..00000000 --- a/err_lob/err_tmplobfree.msg +++ /dev/null @@ -1,537 +0,0 @@ -From SRS0=VEIf=LP=genericom.de=pl@bounce2.pobox.com Wed Aug 25 17:53:58 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7PGpkpQ033405 - for ; Wed, 25 Aug 2004 17:53:57 +0100 (BST) - (envelope-from SRS0=VEIf=LP=genericom.de=pl@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 25 Aug 2004 17:53:57 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1Bzyve-0007kY-Gp; - Wed, 25 Aug 2004 14:39:10 +0000 -Received: from [194.217.242.223] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1Bzyve-0007kY-Gp - for pobox@data-plan.com; Wed, 25 Aug 2004 14:39:10 +0000 -Received: from [208.58.1.198] (helo=lime.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1Bzyvd-0000zb-Lg - for pobox@data-plan.com; Wed, 25 Aug 2004 14:39:10 +0000 -Received: from lime.pobox.com (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id AA6D8B0635; - Wed, 25 Aug 2004 10:39:08 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from lime (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id 9B2A1B0BB0 - for ; Wed, 25 Aug 2004 10:39:08 -0400 (EDT) -Received-SPF: none (lime.pobox.com: domain of pl@genericom.de does not designate permitted sender hosts) -Received: from natnoddy.rzone.de (natnoddy.rzone.de [81.169.145.166]) - by lime.pobox.com (Postfix) with ESMTP id 2AAB1B0635 - for ; Wed, 25 Aug 2004 10:39:06 -0400 (EDT) -Received: from genericom.de (pD95195AC.dip.t-dialin.net [217.81.149.172]) - by post.webmailer.de (8.12.10/8.12.10) with ESMTP id i7PEc05w018990 - for ; Wed, 25 Aug 2004 16:38:01 +0200 (MEST) -Sender: pl@post.webmailer.de -Message-ID: <412CA445.FC2F9EF2@genericom.de> -Date: Wed, 25 Aug 2004 16:37:57 +0200 -From: Philipp Lang -Organization: Genericom Software -X-Mailer: Mozilla 4.77 [en] (X11; U; Linux 2.4.24 i686) -X-Accept-Language: de, en -MIME-Version: 1.0 -To: Tim.Bunce@pobox.com -Subject: DBD::Oracle: Freeing a temporary blob -Content-Type: multipart/signed; protocol="application/x-pkcs7-signature"; micalg=sha1; boundary="------------ms4BC2D4519D41A502BB06559C" -Status: RO -X-Status: A -Content-Length: 4985 -Lines: 122 - -This is a cryptographically signed message in MIME format. - ---------------ms4BC2D4519D41A502BB06559C -Content-Type: text/plain; charset=us-ascii -Content-Transfer-Encoding: 7bit - -Dear Tim, - -first, I would really like to thank you for the great work you have done -with your DBI/DBD work. We are using it extensively in several projects -and we are highly pleased. - -Unfortunately I have now encountered a problem we need to fix urgently, -since our customer's production is seriously affected. - -We tried for many days to find a solution (google, newsgroups, -trial-and-error...), without luck. So my last chance is to contact you -directly, although I assume you have a lot work yourself. - ---- - -The problem: - -Our database contains a stored function "ReadUnitBlob()" that returns a -temporary blob: - -function ReadUnitBlob(UnitID_IN in integer) return blob -is -... -begin - ... - dbms_lob.createtemporary(retBlob, false, dbms_lob.call); - dbms_lob.loadfromfile(retBlob, bfileIn, fileLen); - ... - return retBlob; -end; - -We call this function in Perl in a big loop to fetch a lot of blobs (~ -100000) using something like: - -my $sth = $DBH->prepare("select ReadUnitBlob(:unitID) from dual", { -ora_auto_lob => 0 }); -$sth->bind_param(":unitID", $unitID); -$sth->execute(); -my ($loc) = $sth->fetchrow_array(); -$sth->finish(); -... -while(my $data = $DBH->ora_lob_read($loc, $offset, $chunk_size)) - ... - -Although this works, it has a big disadvantage: Oracle does not -automaticaly free the temporary blob, so it shortly runs out of temp. -space. (confirmed with "select * from v$temporary_lobs"). - -Acording to the Oracle docs this can be we solved by implicitly freeing -the temp. blob, e.g. by calling the PLSQL method -"dbms_lob.freetemporary()". I tried differnt ways to do this with -DBD::Oracle, but never succeeded. I just did not manage to fetch the LOB -locator from the my stored procedure and to pass it to a call of -"dbms_lob.freetemporary()": - -my $sth = $dbh->prepare("begin :bloc := ReadUnitBlob(:unitID); end;", { -ora_auto_lob => 0 }); -my $bloc; -$sth->bind_param_inout( ":bloc", \$bloc, ORA_BLOB); -$sth->bind_param(":unitID", $unitID); -$sth->execute(); - -obviously the "ORA_BLOB" type for bind_param_inout() is wrong here ;) - -Can you help me??? Do you know a way how to free the temp. blob using -DBD::Oracle (using Oracle::OCI is not possible, since the customer is -strinctly refusing to install it). - -Otherwise, would it be possible include an additional DBD::Oracle LOB -Locator Method "ora_lob_freetemporary()" that warps -"OCILobFreeTemporary" ? - -Any help is really appreciated! - -Greeting from Germany, - - Philipp - --- -Dipl. Inf. Philipp Lang Genericom Software GmbH -Tel. +49 (0)7031/8739-26 Tilsiter Str. 4-6 -Fax +49 (0)7031/8739-11 71065 Sindelfingen -pl@genericom.de www.genericom.de ---------------ms4BC2D4519D41A502BB06559C -Content-Type: application/x-pkcs7-signature; name="smime.p7s" -Content-Transfer-Encoding: base64 -Content-Disposition: attachment; filename="smime.p7s" -Content-Description: S/MIME Cryptographic Signature - -MIIFLgYJKoZIhvcNAQcCoIIFHzCCBRsCAQExCzAJBgUrDgMCGgUAMAsGCSqGSIb3DQEHAaCC -Aw0wggMJMIICcqADAgECAg4WKgAAAALXCfeUwksXHjANBgkqhkiG9w0BAQQFADCBvDELMAkG -A1UEBhMCREUxEDAOBgNVBAgTB0hhbWJ1cmcxEDAOBgNVBAcTB0hhbWJ1cmcxOjA4BgNVBAoT -MVRDIFRydXN0Q2VudGVyIGZvciBTZWN1cml0eSBpbiBEYXRhIE5ldHdvcmtzIEdtYkgxIjAg -BgNVBAsTGVRDIFRydXN0Q2VudGVyIENsYXNzIDEgQ0ExKTAnBgkqhkiG9w0BCQEWGmNlcnRp -ZmljYXRlQHRydXN0Y2VudGVyLmRlMB4XDTAzMTIwODA5NTQyNFoXDTA1MDEzMDA5NTQyNFow -RDELMAkGA1UEBhMCREUxFTATBgNVBAMTDFBoaWxpcHAgTGFuZzEeMBwGCSqGSIb3DQEJARYP -cGxAZ2VuZXJpY29tLmRlMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAJqCn5ZXevTm3KgAKlKk -tOMzn1utWbcKoyrjuUSUOk9hwKXqjCtlBrNUDfVCtJIFWTU/2diijqormxUCXYr60F8CAwEA -AaOByDCBxTAMBgNVHRMBAf8EAjAAMA4GA1UdDwEB/wQEAwIF4DAzBglghkgBhvhCAQgEJhYk -aHR0cDovL3d3dy50cnVzdGNlbnRlci5kZS9ndWlkZWxpbmVzMBEGCWCGSAGG+EIBAQQEAwIF -oDBdBglghkgBhvhCAQMEUBZOaHR0cHM6Ly93d3cudHJ1c3RjZW50ZXIuZGUvY2dpLWJpbi9j -aGVjay1yZXYuY2dpLzE2MkEwMDAwMDAwMkQ3MDlGNzk0QzI0QjE3MUU/MA0GCSqGSIb3DQEB -BAUAA4GBAI4bC7MGQQTY9Cp09FYwPychOQs8yFNKHrqYwFhXOirqVTqwo1wgxuSO5/fYWbcs -neWGio3swv0y+jn7o0gkrr/pHNbbm/YmCMuiGuwciH2y4GU2BOukFFP4Otke5UL9Yc9l13eG -Aoaf9ApqRrckhbhLhjz3+gyUM5XRYpoOZX0LMYIB6TCCAeUCAQEwgc8wgbwxCzAJBgNVBAYT -AkRFMRAwDgYDVQQIEwdIYW1idXJnMRAwDgYDVQQHEwdIYW1idXJnMTowOAYDVQQKEzFUQyBU -cnVzdENlbnRlciBmb3IgU2VjdXJpdHkgaW4gRGF0YSBOZXR3b3JrcyBHbWJIMSIwIAYDVQQL -ExlUQyBUcnVzdENlbnRlciBDbGFzcyAxIENBMSkwJwYJKoZIhvcNAQkBFhpjZXJ0aWZpY2F0 -ZUB0cnVzdGNlbnRlci5kZQIOFioAAAAC1wn3lMJLFx4wCQYFKw4DAhoFAKCBsTAYBgkqhkiG -9w0BCQMxCwYJKoZIhvcNAQcBMBwGCSqGSIb3DQEJBTEPFw0wNDA4MjUxNDM3NThaMCMGCSqG -SIb3DQEJBDEWBBS+u38esQAv19TdNkv4jgxlzsRqSzBSBgkqhkiG9w0BCQ8xRTBDMAoGCCqG -SIb3DQMHMA4GCCqGSIb3DQMCAgIAgDAHBgUrDgMCBzANBggqhkiG9w0DAgIBQDANBggqhkiG -9w0DAgIBKDANBgkqhkiG9w0BAQEFAARAJQgoN5ASnyjnB7bgrv1+V7Cu4ULKe1CkHs0IEZaB -KuJcm98U7kskRyC5g6YNopuJxFbr19K3q5rrJGoUscKjiw== ---------------ms4BC2D4519D41A502BB06559C-- - - -From SRS0=SXka=LP=dansat.data-plan.com=timbo@bounce2.pobox.com Wed Aug 25 22:47:05 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7PLjxpJ037568 - for ; Wed, 25 Aug 2004 22:47:04 +0100 (BST) - (envelope-from SRS0=SXka=LP=dansat.data-plan.com=timbo@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 25 Aug 2004 22:47:04 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1C04j1-00038v-Pz; - Wed, 25 Aug 2004 20:50:31 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1C04j1-00038v-Pz - for pobox@data-plan.com; Wed, 25 Aug 2004 20:50:31 +0000 -Received: from [208.210.124.73] (helo=gold.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1C04j0-00002I-FU - for pobox@data-plan.com; Wed, 25 Aug 2004 20:50:30 +0000 -Received: from gold.pobox.com (localhost [127.0.0.1]) - by gold.pobox.com (Postfix) with ESMTP id AD1815463; - Wed, 25 Aug 2004 16:50:29 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from gold (localhost [127.0.0.1]) - by gold.pobox.com (Postfix) with ESMTP id 85FFF55E7 - for ; Wed, 25 Aug 2004 16:50:29 -0400 (EDT) -Received-SPF: none (gold.pobox.com: domain of timbo@dansat.data-plan.com does not designate permitted sender hosts) -Received: from mail04.svc.cra.dublin.eircom.net (mail04.svc.cra.dublin.eircom.net [159.134.118.20]) - by gold.pobox.com (Postfix) with SMTP id 14C005463 - for ; Wed, 25 Aug 2004 16:50:25 -0400 (EDT) -Received: (qmail 5678 messnum 5046341 invoked from network[213.94.228.233/unknown]); 25 Aug 2004 20:50:23 -0000 -Received: from unknown (HELO dansat.data-plan.com) (213.94.228.233) - by mail04.svc.cra.dublin.eircom.net (qp 5678) with SMTP; 25 Aug 2004 20:50:23 -0000 -Received: from dansat.data-plan.com (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7PKsrof034865; - Wed, 25 Aug 2004 21:54:53 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: (from timbo@localhost) - by dansat.data-plan.com (8.12.9/8.12.9/Submit) id i7PKsqas034864; - Wed, 25 Aug 2004 21:54:52 +0100 (BST) -Date: Wed, 25 Aug 2004 21:54:52 +0100 -From: Tim Bunce -To: Philipp Lang -Cc: Tim.Bunce@pobox.com -Subject: Re: DBD::Oracle: Freeing a temporary blob -Message-ID: <20040825205452.GC34655@dansat.data-plan.com> -References: <412CA445.FC2F9EF2@genericom.de> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <412CA445.FC2F9EF2@genericom.de> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 4674 -Lines: 124 - -On Wed, Aug 25, 2004 at 04:37:57PM +0200, Philipp Lang wrote: -> Dear Tim, -> -> first, I would really like to thank you for the great work you have done -> with your DBI/DBD work. We are using it extensively in several projects -> and we are highly pleased. - -Thanks Philipp! - -> Unfortunately I have now encountered a problem we need to fix urgently, -> since our customer's production is seriously affected. -> -> We tried for many days to find a solution (google, newsgroups, -> trial-and-error...), without luck. So my last chance is to contact you -> directly, although I assume you have a lot work yourself. - -I am very busy and what little spare time I have for DBD::Oracle -is going into trying to get 1.16 released (which is proving to be -hard as we're tripping over Oracle bugs when an Oracle 8 client -talks to an Oracle 9+ server.) It's a major release that will help -many people so I need to give that priority. - -Separately I am exploring ways to fund DBI and DBD::Oracle development -so I can devote more time to it. There's is much that needs to be -done and much more that could be done beyond that. - -The Perl Foundation (TPF) have setup a way for people and companies -to make donations for DBI development [as yet unannounced so please -keep to yourself]. A note on the contribution could indicate that the -donor would like it used for a particular purpose, such as DBD::Oracle. - -Anyway, to cut a long story short, it would be much easier to devote -time to this if it could be funded in some way. - -I think the TPF setup is working so it could be done that way. -Alternatively you could contract me to do the work for you. -That would be quicker and simpler for you as TPF's non-profit -status doesn't make a difference to European donors. - -My standard daily rate for add-hoc consulting is 1600 Euro. -I'd expect to be able to sort this out inside a day, and prefer -fixed-price quotes anyway, so would 1600 Euro be okay? - -Of course, if you feel your company would like to either -make a general contribution to DBI/DBD::Oracle development beyond -that, or to fund the development of specific functionality that -would be of extra value to you then I'd be happy to talk about that. - -I hate asking for money, and would much rather dig into the code and -reply with a patch, but it's just not practical for me now. Sorry. - -Tim. - -> --- -> -> The problem: -> -> Our database contains a stored function "ReadUnitBlob()" that returns a -> temporary blob: -> -> function ReadUnitBlob(UnitID_IN in integer) return blob -> is -> ... -> begin -> ... -> dbms_lob.createtemporary(retBlob, false, dbms_lob.call); -> dbms_lob.loadfromfile(retBlob, bfileIn, fileLen); -> ... -> return retBlob; -> end; -> -> We call this function in Perl in a big loop to fetch a lot of blobs (~ -> 100000) using something like: -> -> my $sth = $DBH->prepare("select ReadUnitBlob(:unitID) from dual", { -> ora_auto_lob => 0 }); -> $sth->bind_param(":unitID", $unitID); -> $sth->execute(); -> my ($loc) = $sth->fetchrow_array(); -> $sth->finish(); -> ... -> while(my $data = $DBH->ora_lob_read($loc, $offset, $chunk_size)) -> ... -> -> Although this works, it has a big disadvantage: Oracle does not -> automaticaly free the temporary blob, so it shortly runs out of temp. -> space. (confirmed with "select * from v$temporary_lobs"). -> -> Acording to the Oracle docs this can be we solved by implicitly freeing -> the temp. blob, e.g. by calling the PLSQL method -> "dbms_lob.freetemporary()". I tried differnt ways to do this with -> DBD::Oracle, but never succeeded. I just did not manage to fetch the LOB -> locator from the my stored procedure and to pass it to a call of -> "dbms_lob.freetemporary()": -> -> my $sth = $dbh->prepare("begin :bloc := ReadUnitBlob(:unitID); end;", { -> ora_auto_lob => 0 }); -> my $bloc; -> $sth->bind_param_inout( ":bloc", \$bloc, ORA_BLOB); -> $sth->bind_param(":unitID", $unitID); -> $sth->execute(); -> -> obviously the "ORA_BLOB" type for bind_param_inout() is wrong here ;) -> -> Can you help me??? Do you know a way how to free the temp. blob using -> DBD::Oracle (using Oracle::OCI is not possible, since the customer is -> strinctly refusing to install it). -> -> Otherwise, would it be possible include an additional DBD::Oracle LOB -> Locator Method "ora_lob_freetemporary()" that warps -> "OCILobFreeTemporary" ? -> -> Any help is really appreciated! -> -> Greeting from Germany, -> -> Philipp -> -> -- -> Dipl. Inf. Philipp Lang Genericom Software GmbH -> Tel. +49 (0)7031/8739-26 Tilsiter Str. 4-6 -> Fax +49 (0)7031/8739-11 71065 Sindelfingen -> pl@genericom.de www.genericom.de - - -From SRS0=eIh3=LQ=genericom.de=pl@bounce2.pobox.com Thu Aug 26 14:06:45 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7QD6Som051890 - for ; Thu, 26 Aug 2004 14:06:45 +0100 (BST) - (envelope-from SRS0=eIh3=LQ=genericom.de=pl@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 26 Aug 2004 14:06:45 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1C0HX2-0003PB-Sd; - Thu, 26 Aug 2004 10:31:00 +0000 -Received: from [194.217.242.223] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1C0HX2-0003PB-Sd - for pobox@data-plan.com; Thu, 26 Aug 2004 10:31:00 +0000 -Received: from [208.58.1.198] (helo=lime.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1C0HX2-0003BR-F8 - for pobox@data-plan.com; Thu, 26 Aug 2004 10:31:00 +0000 -Received: from lime.pobox.com (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id DC4BFB0D27; - Thu, 26 Aug 2004 06:30:59 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from lime (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id CE95AB0D7D - for ; Thu, 26 Aug 2004 06:30:59 -0400 (EDT) -Received-SPF: none (lime.pobox.com: domain of pl@genericom.de does not designate permitted sender hosts) -X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 81.169.145.165(natsmtp00.rzone.de) -Received: from natsmtp00.rzone.de (natsmtp00.rzone.de [81.169.145.165]) - by lime.pobox.com (Postfix) with ESMTP id 71107B0D27 - for ; Thu, 26 Aug 2004 06:30:56 -0400 (EDT) -Received: from genericom.de (pD9E61E09.dip.t-dialin.net [217.230.30.9]) - by post.webmailer.de (8.12.10/8.12.10) with ESMTP id i7QAUoTY009695 - for ; Thu, 26 Aug 2004 12:30:51 +0200 (MEST) -Sender: pl@post.webmailer.de -Message-ID: <412DBBD7.2C124831@genericom.de> -Date: Thu, 26 Aug 2004 12:30:47 +0200 -From: Philipp Lang -Organization: Genericom Software -X-Mailer: Mozilla 4.77 [en] (X11; U; Linux 2.4.24 i686) -X-Accept-Language: de, en -MIME-Version: 1.0 -To: Tim Bunce -Subject: Re: DBD::Oracle: Freeing a temporary blob -References: <412CA445.FC2F9EF2@genericom.de> <20040825205452.GC34655@dansat.data-plan.com> -Content-Type: multipart/signed; protocol="application/x-pkcs7-signature"; micalg=sha1; boundary="------------msB92907D67E7D4C0121D50420" -Status: O -X-Status: A -Content-Length: 3040 -Lines: 58 - -This is a cryptographically signed message in MIME format. - ---------------msB92907D67E7D4C0121D50420 -Content-Type: text/plain; charset=us-ascii -Content-Transfer-Encoding: 7bit - -Tim Bunce wrote: -> -> I hate asking for money, and would much rather dig into the code and -> reply with a patch, but it's just not practical for me now. Sorry. - -Thanks for your quick reply. I can fully understand your position in -this issue. We will need to submit this issue to our customer, and -eventually it will be their decision, since a) the problem technically -originates in external components -and b) our work is payed on a time and material basis. - -Thanks again, - Philipp - --- -Dipl. Inf. Philipp Lang Genericom Software GmbH -Tel. +49 (0)7031/8739-26 Tilsiter Str. 4-6 -Fax +49 (0)7031/8739-11 71065 Sindelfingen -pl@genericom.de www.genericom.de ---------------msB92907D67E7D4C0121D50420 -Content-Type: application/x-pkcs7-signature; name="smime.p7s" -Content-Transfer-Encoding: base64 -Content-Disposition: attachment; filename="smime.p7s" -Content-Description: S/MIME Cryptographic Signature - -MIIFLgYJKoZIhvcNAQcCoIIFHzCCBRsCAQExCzAJBgUrDgMCGgUAMAsGCSqGSIb3DQEHAaCC -Aw0wggMJMIICcqADAgECAg4WKgAAAALXCfeUwksXHjANBgkqhkiG9w0BAQQFADCBvDELMAkG -A1UEBhMCREUxEDAOBgNVBAgTB0hhbWJ1cmcxEDAOBgNVBAcTB0hhbWJ1cmcxOjA4BgNVBAoT -MVRDIFRydXN0Q2VudGVyIGZvciBTZWN1cml0eSBpbiBEYXRhIE5ldHdvcmtzIEdtYkgxIjAg -BgNVBAsTGVRDIFRydXN0Q2VudGVyIENsYXNzIDEgQ0ExKTAnBgkqhkiG9w0BCQEWGmNlcnRp -ZmljYXRlQHRydXN0Y2VudGVyLmRlMB4XDTAzMTIwODA5NTQyNFoXDTA1MDEzMDA5NTQyNFow -RDELMAkGA1UEBhMCREUxFTATBgNVBAMTDFBoaWxpcHAgTGFuZzEeMBwGCSqGSIb3DQEJARYP -cGxAZ2VuZXJpY29tLmRlMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAJqCn5ZXevTm3KgAKlKk -tOMzn1utWbcKoyrjuUSUOk9hwKXqjCtlBrNUDfVCtJIFWTU/2diijqormxUCXYr60F8CAwEA -AaOByDCBxTAMBgNVHRMBAf8EAjAAMA4GA1UdDwEB/wQEAwIF4DAzBglghkgBhvhCAQgEJhYk -aHR0cDovL3d3dy50cnVzdGNlbnRlci5kZS9ndWlkZWxpbmVzMBEGCWCGSAGG+EIBAQQEAwIF -oDBdBglghkgBhvhCAQMEUBZOaHR0cHM6Ly93d3cudHJ1c3RjZW50ZXIuZGUvY2dpLWJpbi9j -aGVjay1yZXYuY2dpLzE2MkEwMDAwMDAwMkQ3MDlGNzk0QzI0QjE3MUU/MA0GCSqGSIb3DQEB -BAUAA4GBAI4bC7MGQQTY9Cp09FYwPychOQs8yFNKHrqYwFhXOirqVTqwo1wgxuSO5/fYWbcs -neWGio3swv0y+jn7o0gkrr/pHNbbm/YmCMuiGuwciH2y4GU2BOukFFP4Otke5UL9Yc9l13eG -Aoaf9ApqRrckhbhLhjz3+gyUM5XRYpoOZX0LMYIB6TCCAeUCAQEwgc8wgbwxCzAJBgNVBAYT -AkRFMRAwDgYDVQQIEwdIYW1idXJnMRAwDgYDVQQHEwdIYW1idXJnMTowOAYDVQQKEzFUQyBU -cnVzdENlbnRlciBmb3IgU2VjdXJpdHkgaW4gRGF0YSBOZXR3b3JrcyBHbWJIMSIwIAYDVQQL -ExlUQyBUcnVzdENlbnRlciBDbGFzcyAxIENBMSkwJwYJKoZIhvcNAQkBFhpjZXJ0aWZpY2F0 -ZUB0cnVzdGNlbnRlci5kZQIOFioAAAAC1wn3lMJLFx4wCQYFKw4DAhoFAKCBsTAYBgkqhkiG -9w0BCQMxCwYJKoZIhvcNAQcBMBwGCSqGSIb3DQEJBTEPFw0wNDA4MjYxMDMwNDhaMCMGCSqG -SIb3DQEJBDEWBBQbWUdl+peoD/lHpzCOnuQfzAsbJzBSBgkqhkiG9w0BCQ8xRTBDMAoGCCqG -SIb3DQMHMA4GCCqGSIb3DQMCAgIAgDAHBgUrDgMCBzANBggqhkiG9w0DAgIBQDANBggqhkiG -9w0DAgIBKDANBgkqhkiG9w0BAQEFAARAXzFame8ymLqgf+7nZ4V7L9e9J+aG6z5ipa+iv76v -EFAg5QObdHdvTnq5QEAjEnLKgeUGvdgpS6PA0h+beEIeIA== ---------------msB92907D67E7D4C0121D50420-- - - -From SRS0=T6ya=LQ=dansat.data-plan.com=timbo@bounce2.pobox.com Thu Aug 26 16:42:55 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7QFgKp1054926 - for ; Thu, 26 Aug 2004 16:42:55 +0100 (BST) - (envelope-from SRS0=T6ya=LQ=dansat.data-plan.com=timbo@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 26 Aug 2004 16:42:55 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1C0L1E-0005sL-5Z; - Thu, 26 Aug 2004 14:14:24 +0000 -Received: from [194.217.242.211] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1C0L1E-0005sL-5Z - for pobox@data-plan.com; Thu, 26 Aug 2004 14:14:24 +0000 -Received: from [208.58.1.198] (helo=lime.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1C0L1E-0001t1-Cm - for pobox@data-plan.com; Thu, 26 Aug 2004 14:14:24 +0000 -Received: from lime.pobox.com (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id 541E8AFAD6; - Thu, 26 Aug 2004 10:14:23 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from lime (localhost [127.0.0.1]) - by lime.pobox.com (Postfix) with ESMTP id 1C39FB0747 - for ; Thu, 26 Aug 2004 10:14:23 -0400 (EDT) -Received-SPF: none (lime.pobox.com: domain of timbo@dansat.data-plan.com does not designate permitted sender hosts) -Received: from mail01.svc.cra.dublin.eircom.net (mail01.svc.cra.dublin.eircom.net [159.134.118.17]) - by lime.pobox.com (Postfix) with SMTP id BFBB5AFAD6 - for ; Thu, 26 Aug 2004 10:14:19 -0400 (EDT) -Received: (qmail 12246 messnum 7731352 invoked from network[213.94.228.233/unknown]); 26 Aug 2004 14:14:17 -0000 -Received: from unknown (HELO dansat.data-plan.com) (213.94.228.233) - by mail01.svc.cra.dublin.eircom.net (qp 12246) with SMTP; 26 Aug 2004 14:14:17 -0000 -Received: from dansat.data-plan.com (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i7QEItof052863; - Thu, 26 Aug 2004 15:18:55 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: (from timbo@localhost) - by dansat.data-plan.com (8.12.9/8.12.9/Submit) id i7QEItr3052862; - Thu, 26 Aug 2004 15:18:55 +0100 (BST) -Date: Thu, 26 Aug 2004 15:18:55 +0100 -From: Tim Bunce -To: Philipp Lang -Cc: Tim Bunce -Subject: Re: DBD::Oracle: Freeing a temporary blob -Message-ID: <20040826141855.GC52359@dansat.data-plan.com> -References: <412CA445.FC2F9EF2@genericom.de> <20040825205452.GC34655@dansat.data-plan.com> <412DBBD7.2C124831@genericom.de> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <412DBBD7.2C124831@genericom.de> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 926 -Lines: 25 - -Okay. Thanks. Let me know how it turns out. - -Tim. - -On Thu, Aug 26, 2004 at 12:30:47PM +0200, Philipp Lang wrote: -> Tim Bunce wrote: -> > -> > I hate asking for money, and would much rather dig into the code and -> > reply with a patch, but it's just not practical for me now. Sorry. -> -> Thanks for your quick reply. I can fully understand your position in -> this issue. We will need to submit this issue to our customer, and -> eventually it will be their decision, since a) the problem technically -> originates in external components -> and b) our work is payed on a time and material basis. -> -> Thanks again, -> Philipp -> -> -- -> Dipl. Inf. Philipp Lang Genericom Software GmbH -> Tel. +49 (0)7031/8739-26 Tilsiter Str. 4-6 -> Fax +49 (0)7031/8739-11 71065 Sindelfingen -> pl@genericom.de www.genericom.de - - diff --git a/err_unicode/err_char.msg b/err_unicode/err_char.msg deleted file mode 100644 index d2a7a4a3..00000000 --- a/err_unicode/err_char.msg +++ /dev/null @@ -1,129 +0,0 @@ -From dbi-users-return-11724-Tim.Bunce=pobox.com@perl.org Fri May 31 15:39:50 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g4VEdno73229 - for ; Fri, 31 May 2002 15:39:49 +0100 (BST) - (envelope-from dbi-users-return-11724-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.22] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 31 May 2002 15:39:49 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1022854157:20:06570:1; Fri, 31 May 2002 14:09:17 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-2.mail.demon.net - id aa2005972; 31 May 2002 14:08 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 210F42BF43 - for ; Fri, 31 May 2002 10:08:39 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (unknown [64.70.54.95]) - by dolly1.pobox.com (Postfix) with SMTP id 8D88B2BF11 - for ; Fri, 31 May 2002 10:08:38 -0400 (EDT) -Received: (qmail 47355 invoked by uid 1005); 31 May 2002 14:07:42 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 47340 invoked by uid 76); 31 May 2002 14:07:41 -0000 -Received: from wsrgeh.wsr.ac.at (HELO wsrgeh.wsr.ac.at) (143.130.16.2) - by onion.perl.org (qpsmtpd/0.07b) with SMTP; Fri May 31 14:07:41 2002 -0000 -Received: from dialog.wsr.ac.at (dialog.wsr.ac.at [143.130.50.66]) - by wsrgeh.wsr.ac.at (8.11.6/8.11.6) with ESMTP id g4VE8Or11772 - for ; Fri, 31 May 2002 16:08:24 +0200 -Received: (from hjp@localhost) - by dialog.wsr.ac.at (8.11.6/8.11.6) id g4VE8Nf12538 - for dbi-users@perl.org; Fri, 31 May 2002 16:08:23 +0200 -Date: Fri, 31 May 2002 16:08:23 +0200 -From: "Peter J. Holzer" -To: dbi-users@perl.org -Subject: Re: Insert a blank value into Oracle -Message-ID: <20020531160823.F28779@wsr.ac.at> -Mail-Followup-To: "Peter J. Holzer" , - dbi-users@perl.org -References: <1797C3D07B8BD311BC9200A0C9C85E0F0369DCCF@mail.gss.com.tw> -Mime-Version: 1.0 -Content-Type: multipart/signed; micalg=pgp-md5; - protocol="application/pgp-signature"; boundary="aZoGpuMECXJckB41" -Content-Disposition: inline -User-Agent: Mutt/1.2.5.1i -In-Reply-To: <1797C3D07B8BD311BC9200A0C9C85E0F0369DCCF@mail.gss.com.tw>; from larry_wu@mail.gss.com.tw on Fri, May 31, 2002 at 06:38:45PM +0800 -Status: RO -Content-Length: 2819 -Lines: 74 - ---aZoGpuMECXJckB41 -Content-Type: text/plain; charset=iso-8859-1 -Content-Disposition: inline -Content-Transfer-Encoding: quoted-printable - -On 2002-05-31 18:38:45 +0800, Larry Wu (=A7d=A4l=B7=D3) wrote: -> I encountered a problem to insert a space value ( like ' ' ) into Oracle -> database. -[...] -> Unfortunately, I have a table A contained a not allow null column -> NotNullCol. Now I want to insert a row like below: ->=20 -> $sth =3D $dbh->prepare( qq{ insert into A ( KeyCol, NotNullCol ) -> values (?,?)} ); -> $sth->bind_param(1, '1'); -> $sth->bind_param(2, ' '); -> $sth->execute; ->=20 -> When I executed this file I got an error from Oracle: Can't insert NULL -> value into ( "A"."NotNullCol") (DBD ERROR: OCIStmtExecute). -> I think the space value was truncated in the process. Could any one tell = -me -> how to keep a blank space in my bind_param ? - -use DBD::Oracle qw(:ora_types); -[...] -$sth->bind_param(2, ' ', { ora_type =3D> ORA_CHAR }); - -This is a frequently asked question here. The default type for strings, -ORA_VARCHAR2, strips trailing blanks from strings. A few months ago, -during one of the diskussuions about this feature, Tim said that he -might add a way to change the default in a future version of -DBD::Oracle. If he doesn't, maybe a paragraph like the following should -be added to the doc (not sure where - it fits below "Using DBD::Oracle -with Oracle 8 - Features and Issues" but it isn't Oracle 8 specific): - - =3Dhead2 Inserting strings with trailing spaces - - OCI provides several string types which behave differently. - Unfortunately, none of them can store arbitrary perl strings. - By default, DBD::Oracle binds string variables as ORA_VARCHAR2, - which allows embedded NUL characters but strips trailing spaces. If - you need trailing spaces, but don't need embedded NUL characters, - you can explicetly bind the param to type ORA_CHAR with: - - $sth->bind_param(($field_num, $string_value, - { ora_type =3D> ORA_CHAR }); - - =20 - hp - ---=20 - _ | Peter J. Holzer | Aeltere Sources (also solche, die schon -|_|_) | Sysadmin WSR / LUGA | aelter als 12 Stunden sind) sollte man -| | | hjp@wsr.ac.at | bei Linux generell nicht einsetzen - -__/ | http://www.hjp.at/ | Real Time Linux?? -- Gerhard Schneider - ---aZoGpuMECXJckB41 -Content-Type: application/pgp-signature -Content-Disposition: inline - ------BEGIN PGP SIGNATURE----- -Version: GnuPG v1.0.6 (GNU/Linux) -Comment: For info see http://www.gnupg.org - -iQDQAwUBPPeD11LjemazOuKpAQEtNAXUC6rFL0C0v6MNW/K5ggXcSDY7Xvrj6Ed/ -jqjHq2Dx+h2rIMWXCDIGZVphSG74u4FL41AQF/rzGR/e56qH7aAxVmaiLdQE/DRi -zzsoOHoPEg96FhHljDtCZyxHzsz9sRJ1dfW1PELn5r2OSYPPsVzMoeR4iEXnVjvV -ZYH/OfbKRKhysIHjcNYKcyQL87GXdjzCEas3Xz+jyxW2vqzGAwUfTim4ySY9rF37 -c5vopwrTFCsi58r1LccFhQqEfw== -=Xe8d ------END PGP SIGNATURE----- - ---aZoGpuMECXJckB41-- - diff --git a/err_unicode/err_twolongstr.msg b/err_unicode/err_twolongstr.msg deleted file mode 100644 index 5d6c357d..00000000 --- a/err_unicode/err_twolongstr.msg +++ /dev/null @@ -1,1256 +0,0 @@ -From SRS0=YmHr=OD=systransoft.com=cassidy@bounce2.pobox.com Wed Nov 17 19:08:49 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id iAHJ8F8P027204 - for ; Wed, 17 Nov 2004 19:08:48 GMT - (envelope-from SRS0=YmHr=OD=systransoft.com=cassidy@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 17 Nov 2004 19:08:48 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CUUU6-0001mQ-FU; - Wed, 17 Nov 2004 18:24:50 +0000 -Received: from [194.217.242.71] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CUUU6-0001mQ-FU - for pobox@data-plan.com; Wed, 17 Nov 2004 18:24:50 +0000 -Received: from [207.8.226.3] (helo=icicle.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1CUUU6-0000DF-68 - for pobox@data-plan.com; Wed, 17 Nov 2004 18:24:50 +0000 -Received: from icicle.pobox.com (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 9D10A120BFA; - Wed, 17 Nov 2004 13:24:49 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from icicle (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 8C898120BEF - for ; Wed, 17 Nov 2004 13:24:49 -0500 (EST) -Received-SPF: none (icicle.pobox.com: domain of cassidy@systransoft.com does not designate permitted sender hosts) -X-SPF-Guess: pass (seems reasonable for cassidy@systransoft.com to mail through 66.185.164.3) -Received: from mailhost.systransoft.com (mailhost.systransoft.com [66.185.164.3]) - by icicle.pobox.com (Postfix) with ESMTP id 362C6120BEC - for ; Wed, 17 Nov 2004 13:24:46 -0500 (EST) -Received: from localhost (localhost [127.0.0.1]) - by mailhost.systransoft.com (Postfix) with ESMTP id 9C0CC244379 - for ; Wed, 17 Nov 2004 10:24:44 -0800 (PST) -Received: from mailhost.systransoft.com ([127.0.0.1]) - by localhost (mailhost.systransoft.com [127.0.0.1]) (amavisd-new, port 10024) - with ESMTP id 17196-06 for ; - Wed, 17 Nov 2004 10:24:44 -0800 (PST) -Received: from hapax (hapax [192.168.2.186]) - by mailhost.systransoft.com (Postfix) with ESMTP id 3131324406F - for ; Wed, 17 Nov 2004 10:24:44 -0800 (PST) -From: "Susan Cassidy" -To: "'Tim Bunce'" -Subject: RE: FW: DBD::Oracle and strange problem with Oracle error 'ORA-01461: can bind a LONG value only for insert into a LONG column' when data not LONG -Date: Wed, 17 Nov 2004 10:22:44 -0800 -Organization: SYSTRAN Software, Inc. -MIME-Version: 1.0 -Content-Type: multipart/mixed; - boundary="----=_NextPart_000_006A_01C4CC8F.60A4F6F0" -X-Mailer: Microsoft Office Outlook, Build 11.0.5510 -In-Reply-To: <20041117173321.GA6272@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441 -Thread-Index: AcTMy6HoelzJHh9WSPaTpCdfuF1C4gABpsZg -Message-Id: <20041117182444.3131324406F@mailhost.systransoft.com> -X-Virus-Scanned: by amavisd-new at systransoft.com -Status: RO -Content-Length: 16865 -Lines: 527 - -This is a multi-part message in MIME format. - -------=_NextPart_000_006A_01C4CC8F.60A4F6F0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit - -I did - it is attached to the posting. However, I will attach it again -here. - -Thanks, -Susan - -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Wednesday, November 17, 2004 9:33 AM -> To: Susan Cassidy -> Cc: dbi-users@perl.org -> Subject: Re: FW: DBD::Oracle and strange problem with Oracle error 'ORA- -> 01461: can bind a LONG value only for insert into a LONG column' when data -> not LONG -> -> If you can post a small self-contained example that demonstrates -> the problem then I'll take a look. -> -> Tim. -> -> On Wed, Nov 17, 2004 at 09:15:52AM -0800, Susan Cassidy wrote: -> > I never got any response to my question about this problem. I -> thought I'd try again. -> > -> > -> > -> > This is DBD::Oracle 1.16, DBI 1.45, Oracle 9i (9.2), Linux, Perl -> 5.8.5. -> > -> > -> > -> > Thanks, -> > -> > Susan -> > -> > -> > -> > --------------------------------------------------------------------- -> ----------------------------------- -> > -> > From: Susan Cassidy [mailto:cassidy@systransoft.com] -> > Sent: Friday, November 05, 2004 10:23 AM -> > To: 'dbi-users@perl.org' -> > Subject: DBD::Oracle and strange problem with Oracle error 'ORA- -> 01461: can bind a LONG value only for -> > insert into a LONG column' when data not LONG -> > -> > -> > -> > I had an application that was processing a bunch of xml and inserting -> into a table with a bunch of -> > VARCHAR2(4000) columns. -> > -> > -> > -> > A couple of the entries I was processing caused the 'ORA-01461: can -> bind a LONG value only for insert -> > into a LONG column' error. -> > -> > -> > -> > I put checks in for the length of the data, and nothing approached -> 4000 bytes in length. -> > -> > -> > -> > I tracked down some of the entries causing problems, and on certain -> specific data, if 2 columns -> > containing specific data are inserted together, I get this error. If -> only one of the 2 is inserted, I -> > do not get the error, regardless of which one of the two I insert. -> > -> > -> > -> > The lengths of the pieces of data are 1399 and 1397 characters. -> > -> > -> > -> > The data is somewhat odd-looking (we suspect some odd data is in this -> file), but there is no reason for -> > the error message to appear. -> > -> > -> > -> > Trace shows nothing helpful - it thinks the data is the right length. -> > -> > -> > -> > We've successfully inserted thousands of other, similar entries with -> no trouble. -> > -> > -> > -> > The basics are: -> > -> > #create table test_table (item1 varchar2(4000), item2 -> varchar2(4000)); -> > -> > -> > -> > my $statement="INSERT INTO test_table (item1,item2) VALUES (?, ?)"; -> > -> > -> > -> > $sth=$dbh->prepare($statement) || -> > -> > errexit("bad prepare for stmt $statement, error: $DBI::errstr"); -> > -> > my $rc=$sth->execute(@vals) || -> > -> > errexit("can't execute statement: error: $DBI::errstr\n"); -> > -> > -> > -> > Trace shows: -> > -> > -> > -> > DBI 1.45-ithread default trace level set to 0x0/2 (pid 6230) -> > -> > -> prepare for DBD::Oracle::db (DBI::db=HASH(0x82d4178)~0x82d6580 -> 'INSERT INTO test_table -> > (item1,item2) VALUES (?, ?) -> > -> > ') thr#8148ff0 -> > -> > dbd_preparse scanned 2 distinct placeholders -> > -> > <- prepare= DBI::st=HASH(0x82d6640) at test_insert_large.pl line -> 40 -> > -> > -> execute for DBD::Oracle::st (DBI::st=HASH(0x82d6640)~0x8149dcc -> 'version 11.2no service -> > password-encryptionservice -> > -> > udp-small-serversservice tcp-small-servers!hostname router1!!no ip -> domain-lookupip inspect name mysite -> > ftpip inspect name -> > -> > mysite smtpip inspect name mysite tcp!interface Ethernet0ip address -> 10.10.10.2 255.255.255.0ip -> > access-group 101 inip ins -> > -> > pect mysite inip inspect mysite outno keepalive!interface Serial0no -> ip addressencapsulation -> > frame-relay...' 'version 11.2 -> > -> > no service password-encryptionservice udp-small-serversservice tcp- -> small-servers!hostname router1!!no ip -> > domain-lookupip -> > -> > inspect name mysite ftpip inspect name mysite smtpip inspect name -> mysite tcp!interface Ethernet0ip -> > address 10.10.10.2 255 -> > -> > .255.255.0ip access-group 101 inip inspect mysiteinip inspect mysite -> outno keepalive!interface Serial0no -> > ip addressencaps -> > -> > ulation frame-relayn...') thr#8148ff0 -> > -> > bind :p1 <== 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostnam -> > -> > e router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface E -> > -> > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysite inip inspect mysite -> > outno keepalive!in -> > -> > terface Serial0no ip addressencapsulation frame-relay...' (type 0) -> > -> > bind :p1 <== 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostnam -> > -> > e router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface E -> > -> > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysite inip inspect mysite -> > outno keepalive!in -> > -> > terface Serial0no ip addressencapsulation frame-relay...' (size -> 1399/1400/0, ptype 4, otype 1) -> > -> > bind :p2 <== 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostnam -> > -> > e router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface E -> > -> > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysiteinip inspect mysite -> > outno keepalive!int -> > -> > erface Serial0no ip addressencapsulation frame-relayn...' (type 0) -> > -> > bind :p2 <== 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostnam -> > -> > e router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface E -> > -> > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysiteinip inspect mysite -> > outno keepalive!int -> > -> > erface Serial0no ip addressencapsulation frame-relayn...' (size -> 1397/1398/0, ptype 4, otype 1) -> > -> > dbd_st_execute INSERT (out0, lob0)... -> > -> > !! ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> insert into a LONG column (DBD ERROR: -> > OCIStmtExecute)' (e -> > -> > rr#1) -> > -> > <- execute= undef at test_insert_large.pl line 42 -> > -> > 1 -> FETCH for DBD::Oracle::st (DBI::st=HASH(0x8149dcc)~INNER -> 'ParamValues') thr#8148ff0 -> > -> > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> insert into a LONG column (DBD ERROR: -> > OCIStmtExecute)' (e -> > -> > rr#1) -> > -> > 1 <- FETCH= HASH(0x83487e0)2keys at test_insert_large.pl line 42 -> > -> > -> $DBI::errstr (&) FETCH from lasth=HASH -> > -> > >> DBD::Oracle::st::errstr -> > -> > <- $DBI::errstr= 'ORA-01461: can bind a LONG value only for -> insert into a LONG column (DBD ERROR: -> > OCIStmtExecute)' -> > -> > -- DBI::END -> > -> > -> disconnect_all for DBD::Oracle::dr -> (DBI::dr=HASH(0x824771c)~0x82d419c) thr#8148ff0 -> > -> > <- disconnect_all= (not implemented) at DBI.pm line 673 -> > -> > Connect done -> > -> > stmt: INSERT INTO test_table (item1,item2) VALUES (?, ?) -> > -> > Size of vals is 2 -> > -> > val 1 size 1399, is: 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostna -> > -> > me router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface -> > -> > Ethernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysite inip inspect mysite -> > outno keepalive!i -> > -> > nterface Serial0no ip addressencapsulation frame-relayno fair- -> queue!interface Serial0.1 point-to-pointip -> > address 10.10.11 -> > -> > .2 255.255.255.252ip access-group 102 inframe-relay interface-dlci -> 200 IETF!router eigrp 69network -> > 10.0.0.0no auto-summar -> > -> > y!ip default-gateway 10.10.11.1no ip classlessip route 0.0.0.0 -> 0.0.0.0 10.10.11.1access-list 101 permit -> > tcp 10.10.10.0 0. -> > -> > 0.0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 anyaccess- -> list 101 permit icmp 10.10.10.0 -> > 0.0.0.255 anyaccess- -> > -> > list 101 deny ip any anyaccess-list 102 permit eigrp any anyaccess- -> list 102 permit icmp any 10.10.10.0 -> > 0.0.0.255 echo-rep -> > -> > lyaccess-list 102 permit icmp any 10.10.10.0 0.0.0.255 -> unreachableaccess-list 102 permit icmp any -> > 10.10.10.0 0.0.0.255 ad -> > -> > ministratively-prohibitedaccess-list 102 permit icmp any 10.10.10.0 -> 0.0.0.255 packet-too-bigaccess-list -> > 102 permit icmp a -> > -> > ny 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any -> 10.10.10.0 0.0.0.255 -> > time-exceededaccess-list 102 permit tcp -> > -> > any host 10.10.10.1 eq smtpaccess-list 102 deny ip any any!line con -> 0line vty 0 4login!end' -> > -> > val 2 size 1397, is: 'version 11.2no service password- -> encryptionservice udp-small-serversservice -> > tcp-small-servers!hostna -> > -> > me router1!!no ip domain-lookupip inspect name mysite ftpip inspect -> name mysite smtpip inspect name -> > mysite tcp!interface -> > -> > Ethernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 inip -> inspect mysiteinip inspect mysite -> > outno keepalive!in -> > -> > terface Serial0no ip addressencapsulation frame-relayno fair- -> queue!interface Serial0.1 point-to-pointip -> > address 10.10.11. -> > -> > 2 255.255.255.252ip access-group 102 inframe-relay interface-dlci 200 -> IETF!router eigrp 69network -> > 10.0.0.0no auto-summary -> > -> > !ip default-gateway 10.10.11.1no ip classlessip route 0.0.0.0 0.0.0.0 -> 10.10.11.1access-list 101 permit -> > tcp 10.10.10.0 0.0 -> > -> > .0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 anyaccess- -> list 101 permiticmp 10.10.10.0 -> > 0.0.0.255 anyaccess-li -> > -> > st 101 deny ip any anyaccess-list 102 permit eigrp any anyaccess-list -> 102 permit icmp any 10.10.10.0 -> > 0.0.0.255 echo-reply -> > -> > access-list 102 permit icmp any 10.10.10.0 0.0.0.255 -> unreachableaccess-list 102 permit icmp any -> > 10.10.10.0 0.0.0.255 admi -> > -> > nistratively-prohibitedaccess-list 102 permit icmp any 10.10.10.0 -> 0.0.0.255 packet-too-bigaccess-list -> > 102 permit icmp any -> > -> > 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any 10.10.10.0 -> 0.0.0.255 time-exceededaccess-list -> > 102 permit tcp an -> > -> > y host 10.10.10.1 eq smtpaccess-list 102 deny ip any any!line con -> 0line vty 0 4login!end' -> > -> > can't execute statement: error: ORA-01461: can bind a LONG value only -> for insert into a LONG column (DBD -> > ERROR: OCIStmtEx -> > -> > ecute) -> > -> > -> > -> > ! -> DESTROY for DBD::Oracle::db (DBI::db=HASH(0x82d6580)~INNER) -> thr#8148ff0 -> > -> > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> insert into a LONG column (DBD ERROR: -> > OCIStmtExecute)' (e -> > -> > rr#0) -> > -> > ! <- DESTROY= undef during global destruction -> > -> > ! -> DESTROY in DBD::_::common for DBD::Oracle::dr -> (DBI::dr=HASH(0x82d419c)~INNER) thr#8148ff0 -> > -> > ! <- DESTROY= undef during global destruction -> > -> > ! -> DESTROY for DBD::Oracle::st (DBI::st=HASH(0x8149dcc)~INNER) -> thr#8148ff0 -> > -> > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> insert into a LONG column (DBD ERROR: -> > OCIStmtExecute)' (e -> > -> > rr#1) -> > -> > ! <- DESTROY= undef during global destruction -> > -> > -> > -> > I will attach the test program. Somehow it seems to think the -> datatype is LONG instead of VARCHAR. -> > -> > -> > -> > -> > -> > Anyone with ideas? -> > -> > -> > -> > -> > -> > Thanks, -> > -> > Susan -> - - -------=_NextPart_000_006A_01C4CC8F.60A4F6F0 -Content-Type: application/octet-stream; - name="test_insert_large.pl" -Content-Transfer-Encoding: quoted-printable -Content-Disposition: attachment; - filename="test_insert_large.pl" - -#!/usr/local/bin/perl -w=0A= -=0A= -use DBI;=0A= -=0A= -our $dbh;=0A= -our $sth;=0A= -=0A= -$dbuser=3D"proj1";=0A= -$dbpasswd=3D"proj1";=0A= -=0A= -$dbserver=3D'oracledev';=0A= -$db_sid=3D'AL32UTF8';=0A= -=0A= -##=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D connect to database = -=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= -=3D=3D=3D=3D=0A= -=0A= -$dbh=3D DBI->connect("dbi:Oracle:host=3D$dbserver;sid=3D$db_sid", = -$dbuser, $dbpasswd,=0A= - {PrintError =3D> 0, AutoCommit =3D> 1}) or=0A= - errexit( "Unable to connect to $dbserver: $DBI::errstr");=0A= -print "Connect done\n";=0A= -=0A= -#create table test_table (item1 varchar2(4000), item2 varchar2(4000));=0A= -=0A= -=0A= -my $statement=3D"INSERT INTO test_table (item1,item2) VALUES (?, ?)";=0A= -print "stmt: $statement\n";=0A= -=0A= -@vals=3D(=0A= - 'version 11.2no service password-encryptionservice = -udp-small-serversservice tcp-small-servers!hostname router1!!no ip = -domain-lookupip inspect name mysite ftpip inspect name mysite smtpip = -inspect name mysite tcp!interface Ethernet0ip address 10.10.10.2 = -255.255.255.0ip access-group 101 inip inspect mysite inip inspect mysite = -outno keepalive!interface Serial0no ip addressencapsulation = -frame-relayno fair-queue!interface Serial0.1 point-to-pointip address = -10.10.11.2 255.255.255.252ip access-group 102 inframe-relay = -interface-dlci 200 IETF!router eigrp 69network 10.0.0.0no = -auto-summary!ip default-gateway 10.10.11.1no ip classlessip route = -0.0.0.0 0.0.0.0 10.10.11.1access-list 101 permit tcp 10.10.10.0 = -0.0.0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 = -anyaccess-list 101 permit icmp 10.10.10.0 0.0.0.255 anyaccess-list 101 = -deny ip any anyaccess-list 102 permit eigrp any anyaccess-list 102 = -permit icmp any 10.10.10.0 0.0.0.255 echo-replyaccess-list 102 permit = -icmp any 10.10.10.0 0.0.0.255 unreachableaccess-list 102 permit icmp any = -10.10.10.0 0.0.0.255 administratively-prohibitedaccess-list 102 permit = -icmp any 10.10.10.0 0.0.0.255 packet-too-bigaccess-list 102 permit icmp = -any 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any 10.10.10.0 = -0.0.0.255 time-exceededaccess-list 102 permit tcp any host 10.10.10.1 eq = -smtpaccess-list 102 deny ip any any!line con 0line vty 0 4login!end',=0A= - 'version 11.2no service password-encryptionservice = -udp-small-serversservice tcp-small-servers!hostname router1!!no ip = -domain-lookupip inspect name mysite ftpip inspect name mysite smtpip = -inspect name mysite tcp!interface Ethernet0ip address 10.10.10.2 = -255.255.255.0ip access-group 101 inip inspect mysiteinip inspect mysite = -outno keepalive!interface Serial0no ip addressencapsulation = -frame-relayno fair-queue!interface Serial0.1 point-to-pointip address = -10.10.11.2 255.255.255.252ip access-group 102 inframe-relay = -interface-dlci 200 IETF!router eigrp 69network 10.0.0.0no = -auto-summary!ip default-gateway 10.10.11.1no ip classlessip route = -0.0.0.0 0.0.0.0 10.10.11.1access-list 101 permit tcp 10.10.10.0 = -0.0.0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 = -anyaccess-list 101 permiticmp 10.10.10.0 0.0.0.255 anyaccess-list 101 = -deny ip any anyaccess-list 102 permit eigrp any anyaccess-list 102 = -permit icmp any 10.10.10.0 0.0.0.255 echo-replyaccess-list 102 permit = -icmp any 10.10.10.0 0.0.0.255 unreachableaccess-list 102 permit icmp any = -10.10.10.0 0.0.0.255 administratively-prohibitedaccess-list 102 permit = -icmp any 10.10.10.0 0.0.0.255 packet-too-bigaccess-list 102 permit icmp = -any 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any 10.10.10.0 = -0.0.0.255 time-exceededaccess-list 102 permit tcp any host 10.10.10.1 eq = -smtpaccess-list 102 deny ip any any!line con 0line vty 0 4login!end',=0A= -);=0A= -=0A= -print "Size of vals is ",scalar @vals,"\n";=0A= -my $z=3D0;=0A= -foreach my $x (@vals) {=0A= - my $len=3Dlength($x);=0A= - print "val ",++$z, " size $len, is: '$x'\n";=0A= -}=0A= -=0A= -DBI->trace(2);=0A= - $sth=3D$dbh->prepare($statement) ||=0A= - errexit("bad prepare for stmt $statement, error: $DBI::errstr");=0A= - my $rc=3D$sth->execute(@vals) ||=0A= - errexit("can't execute statement: error: $DBI::errstr\n");=0A= -=0A= -print "Done\n";=0A= -exit;=0A= -=0A= -=0A= -sub errexit {=0A= - my (@msg)=3D@_;=0A= - print @msg,"\n";=0A= - exit 1;=0A= -}=0A= -=0A= -=0A= -=0A= - -------=_NextPart_000_006A_01C4CC8F.60A4F6F0-- - - -From SRS0=YmHr=OD=systransoft.com=cassidy@bounce2.pobox.com Thu Nov 18 00:15:21 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id iAI0FC8G049539 - for ; Thu, 18 Nov 2004 00:15:21 GMT - (envelope-from SRS0=YmHr=OD=systransoft.com=cassidy@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 18 Nov 2004 00:15:21 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CUVdd-0002Nv-CF; - Wed, 17 Nov 2004 19:38:45 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CUVdd-0002Nv-CF - for pobox@data-plan.com; Wed, 17 Nov 2004 19:38:45 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1CUVdc-0005lu-Rs - for pobox@data-plan.com; Wed, 17 Nov 2004 19:38:45 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 4A256ADD6F; - Wed, 17 Nov 2004 14:38:44 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from boggle (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 3D82CADD64 - for ; Wed, 17 Nov 2004 14:38:44 -0500 (EST) -Received-SPF: none (boggle.pobox.com: domain of cassidy@systransoft.com does not designate permitted sender hosts) -X-SPF-Guess: pass (seems reasonable for cassidy@systransoft.com to mail through 66.185.164.3) -Received: from mailhost.systransoft.com (mailhost.systransoft.com [66.185.164.3]) - by boggle.pobox.com (Postfix) with ESMTP id B23D4ADCF6 - for ; Wed, 17 Nov 2004 14:38:15 -0500 (EST) -Received: from localhost (localhost [127.0.0.1]) - by mailhost.systransoft.com (Postfix) with ESMTP id 0C9DF24435B - for ; Wed, 17 Nov 2004 11:38:14 -0800 (PST) -Received: from mailhost.systransoft.com ([127.0.0.1]) - by localhost (mailhost.systransoft.com [127.0.0.1]) (amavisd-new, port 10024) - with ESMTP id 18475-01 for ; - Wed, 17 Nov 2004 11:38:13 -0800 (PST) -Received: from hapax (hapax [192.168.2.186]) - by mailhost.systransoft.com (Postfix) with ESMTP id ACF0424406F - for ; Wed, 17 Nov 2004 11:38:13 -0800 (PST) -From: "Susan Cassidy" -To: "'Tim Bunce'" -Subject: RE: FW: DBD::Oracle and strange problem with Oracle error 'ORA-01461: can bind a LONG value only for insert into a LONG column' when data not LONG -Date: Wed, 17 Nov 2004 11:36:14 -0800 -Organization: SYSTRAN Software, Inc. -MIME-Version: 1.0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit -X-Mailer: Microsoft Office Outlook, Build 11.0.5510 -In-Reply-To: <20041117192902.GA31595@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441 -Thread-Index: AcTM27+9yfJDVs3WQIWAKc6DR3EgdQAAKfgw -Message-Id: <20041117193813.ACF0424406F@mailhost.systransoft.com> -X-Virus-Scanned: by amavisd-new at systransoft.com -Status: RO -X-Status: A -Content-Length: 14671 -Lines: 489 - -NLS_LANG=.UTF8 -ORA_NLS33=/home/oracle/product/9.2.0/ocommon/nls/admin/data -ORA_NLS33=/home/oracle/product/9.2.0/ocommon/nls/admin/data -ORACLE_HOME=/home/oracle/product/9.2.0 -ORACLE_SID=AL32UTF8 -ORACLE_BASE=/home/oracle - -NLS_NCHAR is not set, because we are not using any NVARCHAR data item, and -haven't needed it. - -Susan - -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Wednesday, November 17, 2004 11:29 AM -> To: Susan Cassidy -> Cc: 'Tim Bunce' -> Subject: Re: FW: DBD::Oracle and strange problem with Oracle error 'ORA- -> 01461: can bind a LONG value only for insert into a LONG column' when data -> not LONG -> -> Thanks. What are your client side NLS_LANG and NLS_NCHAR settings? -> -> Tim. -> -> On Wed, Nov 17, 2004 at 10:22:44AM -0800, Susan Cassidy wrote: -> > I did - it is attached to the posting. However, I will attach it again -> > here. -> > -> > Thanks, -> > Susan -> > -> > > -----Original Message----- -> > > From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> > > Sent: Wednesday, November 17, 2004 9:33 AM -> > > To: Susan Cassidy -> > > Cc: dbi-users@perl.org -> > > Subject: Re: FW: DBD::Oracle and strange problem with Oracle error -> 'ORA- -> > > 01461: can bind a LONG value only for insert into a LONG column' when -> data -> > > not LONG -> > > -> > > If you can post a small self-contained example that demonstrates -> > > the problem then I'll take a look. -> > > -> > > Tim. -> > > -> > > On Wed, Nov 17, 2004 at 09:15:52AM -0800, Susan Cassidy wrote: -> > > > I never got any response to my question about this problem. I -> > > thought I'd try again. -> > > > -> > > > -> > > > -> > > > This is DBD::Oracle 1.16, DBI 1.45, Oracle 9i (9.2), Linux, Perl -> > > 5.8.5. -> > > > -> > > > -> > > > -> > > > Thanks, -> > > > -> > > > Susan -> > > > -> > > > -> > > > -> > > > ----------------------------------------------------------------- -> ---- -> > > ----------------------------------- -> > > > -> > > > From: Susan Cassidy [mailto:cassidy@systransoft.com] -> > > > Sent: Friday, November 05, 2004 10:23 AM -> > > > To: 'dbi-users@perl.org' -> > > > Subject: DBD::Oracle and strange problem with Oracle error 'ORA- -> > > 01461: can bind a LONG value only for -> > > > insert into a LONG column' when data not LONG -> > > > -> > > > -> > > > -> > > > I had an application that was processing a bunch of xml and -> inserting -> > > into a table with a bunch of -> > > > VARCHAR2(4000) columns. -> > > > -> > > > -> > > > -> > > > A couple of the entries I was processing caused the 'ORA-01461: -> can -> > > bind a LONG value only for insert -> > > > into a LONG column' error. -> > > > -> > > > -> > > > -> > > > I put checks in for the length of the data, and nothing -> approached -> > > 4000 bytes in length. -> > > > -> > > > -> > > > -> > > > I tracked down some of the entries causing problems, and on -> certain -> > > specific data, if 2 columns -> > > > containing specific data are inserted together, I get this error. -> If -> > > only one of the 2 is inserted, I -> > > > do not get the error, regardless of which one of the two I -> insert. -> > > > -> > > > -> > > > -> > > > The lengths of the pieces of data are 1399 and 1397 characters. -> > > > -> > > > -> > > > -> > > > The data is somewhat odd-looking (we suspect some odd data is in -> this -> > > file), but there is no reason for -> > > > the error message to appear. -> > > > -> > > > -> > > > -> > > > Trace shows nothing helpful - it thinks the data is the right -> length. -> > > > -> > > > -> > > > -> > > > We've successfully inserted thousands of other, similar entries -> with -> > > no trouble. -> > > > -> > > > -> > > > -> > > > The basics are: -> > > > -> > > > #create table test_table (item1 varchar2(4000), item2 -> > > varchar2(4000)); -> > > > -> > > > -> > > > -> > > > my $statement="INSERT INTO test_table (item1,item2) VALUES (?, -> ?)"; -> > > > -> > > > -> > > > -> > > > $sth=$dbh->prepare($statement) || -> > > > -> > > > errexit("bad prepare for stmt $statement, error: -> $DBI::errstr"); -> > > > -> > > > my $rc=$sth->execute(@vals) || -> > > > -> > > > errexit("can't execute statement: error: $DBI::errstr\n"); -> > > > -> > > > -> > > > -> > > > Trace shows: -> > > > -> > > > -> > > > -> > > > DBI 1.45-ithread default trace level set to 0x0/2 (pid 6230) -> > > > -> > > > -> prepare for DBD::Oracle::db -> (DBI::db=HASH(0x82d4178)~0x82d6580 -> > > 'INSERT INTO test_table -> > > > (item1,item2) VALUES (?, ?) -> > > > -> > > > ') thr#8148ff0 -> > > > -> > > > dbd_preparse scanned 2 distinct placeholders -> > > > -> > > > <- prepare= DBI::st=HASH(0x82d6640) at test_insert_large.pl -> line -> > > 40 -> > > > -> > > > -> execute for DBD::Oracle::st -> (DBI::st=HASH(0x82d6640)~0x8149dcc -> > > 'version 11.2no service -> > > > password-encryptionservice -> > > > -> > > > udp-small-serversservice tcp-small-servers!hostname router1!!no -> ip -> > > domain-lookupip inspect name mysite -> > > > ftpip inspect name -> > > > -> > > > mysite smtpip inspect name mysite tcp!interface Ethernet0ip -> address -> > > 10.10.10.2 255.255.255.0ip -> > > > access-group 101 inip ins -> > > > -> > > > pect mysite inip inspect mysite outno keepalive!interface -> Serial0no -> > > ip addressencapsulation -> > > > frame-relay...' 'version 11.2 -> > > > -> > > > no service password-encryptionservice udp-small-serversservice -> tcp- -> > > small-servers!hostname router1!!no ip -> > > > domain-lookupip -> > > > -> > > > inspect name mysite ftpip inspect name mysite smtpip inspect name -> > > mysite tcp!interface Ethernet0ip -> > > > address 10.10.10.2 255 -> > > > -> > > > .255.255.0ip access-group 101 inip inspect mysiteinip inspect -> mysite -> > > outno keepalive!interface Serial0no -> > > > ip addressencaps -> > > > -> > > > ulation frame-relayn...') thr#8148ff0 -> > > > -> > > > bind :p1 <== 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostnam -> > > > -> > > > e router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface E -> > > > -> > > > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysite inip inspect mysite -> > > > outno keepalive!in -> > > > -> > > > terface Serial0no ip addressencapsulation frame-relay...' (type -> 0) -> > > > -> > > > bind :p1 <== 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostnam -> > > > -> > > > e router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface E -> > > > -> > > > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysite inip inspect mysite -> > > > outno keepalive!in -> > > > -> > > > terface Serial0no ip addressencapsulation frame-relay...' (size -> > > 1399/1400/0, ptype 4, otype 1) -> > > > -> > > > bind :p2 <== 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostnam -> > > > -> > > > e router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface E -> > > > -> > > > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysiteinip inspect mysite -> > > > outno keepalive!int -> > > > -> > > > erface Serial0no ip addressencapsulation frame-relayn...' (type -> 0) -> > > > -> > > > bind :p2 <== 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostnam -> > > > -> > > > e router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface E -> > > > -> > > > thernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysiteinip inspect mysite -> > > > outno keepalive!int -> > > > -> > > > erface Serial0no ip addressencapsulation frame-relayn...' (size -> > > 1397/1398/0, ptype 4, otype 1) -> > > > -> > > > dbd_st_execute INSERT (out0, lob0)... -> > > > -> > > > !! ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> > > insert into a LONG column (DBD ERROR: -> > > > OCIStmtExecute)' (e -> > > > -> > > > rr#1) -> > > > -> > > > <- execute= undef at test_insert_large.pl line 42 -> > > > -> > > > 1 -> FETCH for DBD::Oracle::st (DBI::st=HASH(0x8149dcc)~INNER -> > > 'ParamValues') thr#8148ff0 -> > > > -> > > > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> > > insert into a LONG column (DBD ERROR: -> > > > OCIStmtExecute)' (e -> > > > -> > > > rr#1) -> > > > -> > > > 1 <- FETCH= HASH(0x83487e0)2keys at test_insert_large.pl line -> 42 -> > > > -> > > > -> $DBI::errstr (&) FETCH from lasth=HASH -> > > > -> > > > >> DBD::Oracle::st::errstr -> > > > -> > > > <- $DBI::errstr= 'ORA-01461: can bind a LONG value only for -> > > insert into a LONG column (DBD ERROR: -> > > > OCIStmtExecute)' -> > > > -> > > > -- DBI::END -> > > > -> > > > -> disconnect_all for DBD::Oracle::dr -> > > (DBI::dr=HASH(0x824771c)~0x82d419c) thr#8148ff0 -> > > > -> > > > <- disconnect_all= (not implemented) at DBI.pm line 673 -> > > > -> > > > Connect done -> > > > -> > > > stmt: INSERT INTO test_table (item1,item2) VALUES (?, ?) -> > > > -> > > > Size of vals is 2 -> > > > -> > > > val 1 size 1399, is: 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostna -> > > > -> > > > me router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface -> > > > -> > > > Ethernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysite inip inspect mysite -> > > > outno keepalive!i -> > > > -> > > > nterface Serial0no ip addressencapsulation frame-relayno fair- -> > > queue!interface Serial0.1 point-to-pointip -> > > > address 10.10.11 -> > > > -> > > > .2 255.255.255.252ip access-group 102 inframe-relay interface- -> dlci -> > > 200 IETF!router eigrp 69network -> > > > 10.0.0.0no auto-summar -> > > > -> > > > y!ip default-gateway 10.10.11.1no ip classlessip route 0.0.0.0 -> > > 0.0.0.0 10.10.11.1access-list 101 permit -> > > > tcp 10.10.10.0 0. -> > > > -> > > > 0.0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 -> anyaccess- -> > > list 101 permit icmp 10.10.10.0 -> > > > 0.0.0.255 anyaccess- -> > > > -> > > > list 101 deny ip any anyaccess-list 102 permit eigrp any -> anyaccess- -> > > list 102 permit icmp any 10.10.10.0 -> > > > 0.0.0.255 echo-rep -> > > > -> > > > lyaccess-list 102 permit icmp any 10.10.10.0 0.0.0.255 -> > > unreachableaccess-list 102 permit icmp any -> > > > 10.10.10.0 0.0.0.255 ad -> > > > -> > > > ministratively-prohibitedaccess-list 102 permit icmp any -> 10.10.10.0 -> > > 0.0.0.255 packet-too-bigaccess-list -> > > > 102 permit icmp a -> > > > -> > > > ny 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any -> > > 10.10.10.0 0.0.0.255 -> > > > time-exceededaccess-list 102 permit tcp -> > > > -> > > > any host 10.10.10.1 eq smtpaccess-list 102 deny ip any any!line -> con -> > > 0line vty 0 4login!end' -> > > > -> > > > val 2 size 1397, is: 'version 11.2no service password- -> > > encryptionservice udp-small-serversservice -> > > > tcp-small-servers!hostna -> > > > -> > > > me router1!!no ip domain-lookupip inspect name mysite ftpip -> inspect -> > > name mysite smtpip inspect name -> > > > mysite tcp!interface -> > > > -> > > > Ethernet0ip address 10.10.10.2 255.255.255.0ip access-group 101 -> inip -> > > inspect mysiteinip inspect mysite -> > > > outno keepalive!in -> > > > -> > > > terface Serial0no ip addressencapsulation frame-relayno fair- -> > > queue!interface Serial0.1 point-to-pointip -> > > > address 10.10.11. -> > > > -> > > > 2 255.255.255.252ip access-group 102 inframe-relay interface-dlci -> 200 -> > > IETF!router eigrp 69network -> > > > 10.0.0.0no auto-summary -> > > > -> > > > !ip default-gateway 10.10.11.1no ip classlessip route 0.0.0.0 -> 0.0.0.0 -> > > 10.10.11.1access-list 101 permit -> > > > tcp 10.10.10.0 0.0 -> > > > -> > > > .0.255 anyaccess-list 101 permit udp 10.10.10.0 0.0.0.255 -> anyaccess- -> > > list 101 permiticmp 10.10.10.0 -> > > > 0.0.0.255 anyaccess-li -> > > > -> > > > st 101 deny ip any anyaccess-list 102 permit eigrp any anyaccess- -> list -> > > 102 permit icmp any 10.10.10.0 -> > > > 0.0.0.255 echo-reply -> > > > -> > > > access-list 102 permit icmp any 10.10.10.0 0.0.0.255 -> > > unreachableaccess-list 102 permit icmp any -> > > > 10.10.10.0 0.0.0.255 admi -> > > > -> > > > nistratively-prohibitedaccess-list 102 permit icmp any 10.10.10.0 -> > > 0.0.0.255 packet-too-bigaccess-list -> > > > 102 permit icmp any -> > > > -> > > > 10.10.10.0 0.0.0.255 echoaccess-list 102 permit icmp any -> 10.10.10.0 -> > > 0.0.0.255 time-exceededaccess-list -> > > > 102 permit tcp an -> > > > -> > > > y host 10.10.10.1 eq smtpaccess-list 102 deny ip any any!line con -> > > 0line vty 0 4login!end' -> > > > -> > > > can't execute statement: error: ORA-01461: can bind a LONG value -> only -> > > for insert into a LONG column (DBD -> > > > ERROR: OCIStmtEx -> > > > -> > > > ecute) -> > > > -> > > > -> > > > -> > > > ! -> DESTROY for DBD::Oracle::db -> (DBI::db=HASH(0x82d6580)~INNER) -> > > thr#8148ff0 -> > > > -> > > > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> > > insert into a LONG column (DBD ERROR: -> > > > OCIStmtExecute)' (e -> > > > -> > > > rr#0) -> > > > -> > > > ! <- DESTROY= undef during global destruction -> > > > -> > > > ! -> DESTROY in DBD::_::common for DBD::Oracle::dr -> > > (DBI::dr=HASH(0x82d419c)~INNER) thr#8148ff0 -> > > > -> > > > ! <- DESTROY= undef during global destruction -> > > > -> > > > ! -> DESTROY for DBD::Oracle::st -> (DBI::st=HASH(0x8149dcc)~INNER) -> > > thr#8148ff0 -> > > > -> > > > ERROR: '1461' 'ORA-01461: can bind a LONG value only for -> > > insert into a LONG column (DBD ERROR: -> > > > OCIStmtExecute)' (e -> > > > -> > > > rr#1) -> > > > -> > > > ! <- DESTROY= undef during global destruction -> > > > -> > > > -> > > > -> > > > I will attach the test program. Somehow it seems to think the -> > > datatype is LONG instead of VARCHAR. -> > > > -> > > > -> > > > -> > > > -> > > > -> > > > Anyone with ideas? -> > > > -> > > > -> > > > -> > > > -> > > > -> > > > Thanks, -> > > > -> > > > Susan -> > > -> > -> - - - -From SRS0=xs68=OE=systransoft.com=cassidy@bounce2.pobox.com Thu Nov 18 07:11:03 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id iAI7Ar8G057950 - for ; Thu, 18 Nov 2004 07:11:03 GMT - (envelope-from SRS0=xs68=OE=systransoft.com=cassidy@bounce2.pobox.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 18 Nov 2004 07:11:03 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@data-plan.com id 1CUaCR-0002mS-7P; - Thu, 18 Nov 2004 00:30:59 +0000 -Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1CUaCR-0002mS-7P - for pobox@data-plan.com; Thu, 18 Nov 2004 00:30:59 +0000 -Received: from [208.58.1.194] (helo=integer.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1CUaCQ-0004JQ-R5 - for pobox@data-plan.com; Thu, 18 Nov 2004 00:30:59 +0000 -Received: from integer.pobox.com (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id 17ACAA3F35; - Wed, 17 Nov 2004 19:30:58 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from integer (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id 04F8DA3EAC - for ; Wed, 17 Nov 2004 19:30:58 -0500 (EST) -Received-SPF: none (integer.pobox.com: domain of cassidy@systransoft.com does not designate permitted sender hosts) -X-SPF-Guess: pass (seems reasonable for cassidy@systransoft.com to mail through 66.185.164.3) -Received: from mailhost.systransoft.com (mailhost.systransoft.com [66.185.164.3]) - by integer.pobox.com (Postfix) with ESMTP id A9FC6A3F4D - for ; Wed, 17 Nov 2004 19:30:43 -0500 (EST) -Received: from localhost (localhost [127.0.0.1]) - by mailhost.systransoft.com (Postfix) with ESMTP id DEA102441A9 - for ; Wed, 17 Nov 2004 16:30:41 -0800 (PST) -Received: from mailhost.systransoft.com ([127.0.0.1]) - by localhost (mailhost.systransoft.com [127.0.0.1]) (amavisd-new, port 10024) - with ESMTP id 22204-10 for ; - Wed, 17 Nov 2004 16:30:41 -0800 (PST) -Received: from hapax (hapax [192.168.2.186]) - by mailhost.systransoft.com (Postfix) with ESMTP id 7AD52244370 - for ; Wed, 17 Nov 2004 16:30:40 -0800 (PST) -From: "Susan Cassidy" -To: "'Tim Bunce'" -Subject: RE: FW: DBD::Oracle and strange problem with Oracle error 'ORA-01461: can bind a LONG value only for insert into a LONG column' when data not LONG -Date: Wed, 17 Nov 2004 16:28:41 -0800 -Organization: SYSTRAN Software, Inc. -MIME-Version: 1.0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit -X-Mailer: Microsoft Office Outlook, Build 11.0.5510 -In-Reply-To: <20041118001712.GB49519@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1441 -Thread-Index: AcTNA/o7HZXghXaJRbyz8M5kVQMQmwAAUBjg -Message-Id: <20041118003040.7AD52244370@mailhost.systransoft.com> -X-Virus-Scanned: by amavisd-new at systransoft.com -Status: RO -Content-Length: 1789 -Lines: 63 - -Hi, - -I set NLS_LANG to .US7ASCII, ran it again, and I get the same error. - -Of course, I could not use that in production. - -The really strange part, to me, was that if I just insert one of the 2 -problematic columns, it worked, but both together failed. - -Thanks, -Susan - -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Wednesday, November 17, 2004 4:17 PM -> To: Susan Cassidy -> Cc: 'Tim Bunce' -> Subject: Re: FW: DBD::Oracle and strange problem with Oracle error 'ORA- -> 01461: can bind a LONG value only for insert into a LONG column' when data -> not LONG -> -> And does the problem go away if NLS_LANG is set to a non-unicode charset? -> -> Tim. -> -> On Wed, Nov 17, 2004 at 11:36:14AM -0800, Susan Cassidy wrote: -> > NLS_LANG=.UTF8 -> > ORA_NLS33=/home/oracle/product/9.2.0/ocommon/nls/admin/data -> > ORA_NLS33=/home/oracle/product/9.2.0/ocommon/nls/admin/data -> > ORACLE_HOME=/home/oracle/product/9.2.0 -> > ORACLE_SID=AL32UTF8 -> > ORACLE_BASE=/home/oracle -> > -> > NLS_NCHAR is not set, because we are not using any NVARCHAR data item, -> and -> > haven't needed it. -> > -> > Susan -> > -> > > -----Original Message----- -> > > From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> > > Sent: Wednesday, November 17, 2004 11:29 AM -> > > To: Susan Cassidy -> > > Cc: 'Tim Bunce' -> > > Subject: Re: FW: DBD::Oracle and strange problem with Oracle error -> 'ORA- -> > > 01461: can bind a LONG value only for insert into a LONG column' when -> data -> > > not LONG -> > > -> > > Thanks. What are your client side NLS_LANG and NLS_NCHAR settings? -> > > -> > > Tim. -> > > -> > > On Wed, Nov 17, 2004 at 10:22:44AM -0800, Susan Cassidy wrote: -> > > > I did - it is attached to the posting. However, I will attach it -> again -> > > > here. -> > > > -> > > > Thanks, -> > > > Susan -> > > > - - diff --git a/err_unsorted/err_etherreal.msg b/err_unsorted/err_etherreal.msg deleted file mode 100644 index 1ad5c78e..00000000 --- a/err_unsorted/err_etherreal.msg +++ /dev/null @@ -1,90 +0,0 @@ -From dbi-users-return-11185-Tim.Bunce=pobox.com@perl.org Tue Apr 30 14:47:44 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3UDliR22576 - for ; Tue, 30 Apr 2002 14:47:44 +0100 (BST) - (envelope-from dbi-users-return-11185-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.23] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 30 Apr 2002 14:47:44 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020172466:10:24548:59; Tue, 30 Apr 2002 13:14:26 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1023391; 30 Apr 2002 13:13 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id A94562C075 - for ; Tue, 30 Apr 2002 09:12:33 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) - by dolly1.pobox.com (Postfix) with SMTP id F24B22BFBE - for ; Tue, 30 Apr 2002 09:12:32 -0400 (EDT) -Received: (qmail 36589 invoked by uid 1005); 30 Apr 2002 13:12:28 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 36168 invoked by uid 76); 30 Apr 2002 13:10:41 -0000 -Content-Type: text/plain; - charset="iso-8859-1" -From: Calin Medianu -To: Tim Bunce -Subject: Re: DBD::Oracle Slow cursors -Date: Tue, 30 Apr 2002 16:04:47 +0300 -X-Mailer: KMail [version 1.3.2] -References: <20020429201853.52283.qmail@web10007.mail.yahoo.com> <20020429233138.E16831@dansat.data-plan.com> -In-Reply-To: <20020429233138.E16831@dansat.data-plan.com> -Cc: dbi-users@perl.org -MIME-Version: 1.0 -Message-Id: <20020430131233.F24B22BFBE@dolly1.pobox.com> -Content-Transfer-Encoding: 8bit -X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id g3UDliR22576 -Status: RO -X-Status: A -Content-Length: 1213 -Lines: 38 - -[Add note to DBD::Oracle docs about using ethereal to sniff Oracle packets] -[Not sure if this bug got fixed yet. Maybe not.] - -Me again with the slow cursors. - -I modified both queries to only return 10 rows. -I ran a sniffer (ethereal) on the NIC. It is pretty cool, it also decodes TNS. - -when I am using the SQL, it works like this, there are about 7 packets -received by my workstation to set up the session, then all 10 rows are in the -same packet, then there is another packet probably saying goodbye. - -When I am using the REF cursor, each row comes in it's own TNS packet, that -is why it is so slow! - -Any idea how to fix it? - -thanks a lot, - -Calin - -> On Mon, Apr 29, 2002 at 01:18:53PM -0700, Calin Medianu wrote: -> > Hello, -> > -> > I did the following. Wrote a perl script that retreves -> > data via a straight select from the database. Then I -> > wrote a stored procedure returning a ref cursor open -> > on the same select statement and retrieved the data as -> > well. Using the REF CURSOR/ sotred procedure was about -> > 3 time slower, that is 40 seconds instead of around -> > 10. -> > -> > Is this normal? Is this a problem with oracle or with -> > DBD::Oracle? -> -> DBD::Oracle. It probably isn't setting up a row cache for the ref cursor. -> -> Get a level 3 trace and look for the "dbd_describe'd" line for the -> ref cursor. -> -> Tim. - diff --git a/err_unsorted/err_memleak2.msg b/err_unsorted/err_memleak2.msg deleted file mode 100644 index 97501852..00000000 --- a/err_unsorted/err_memleak2.msg +++ /dev/null @@ -1,476 +0,0 @@ -From mike@boom.net Fri Nov 28 22:23:33 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id hASMLLnY018698 - for ; Fri, 28 Nov 2003 22:23:33 GMT - (envelope-from mike@boom.net) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 28 Nov 2003 22:23:33 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1APmgW-0006iM-9g; - Fri, 28 Nov 2003 17:45:40 +0000 -Received: from [207.8.214.2] (helo=icicle.pobox.com) - by punt-3.mail.demon.net with esmtp id 1APmgW-0006iM-9g - for pobox@dbi.demon.co.uk; Fri, 28 Nov 2003 17:45:40 +0000 -Received: from icicle.pobox.com (localhost[127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id E82CD95E03 - for ; Fri, 28 Nov 2003 12:45:38 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost[127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id B1EE595DFB - for ; Fri, 28 Nov 2003 12:45:38 -0500 (EST) -Received: from abort.boom.net (abort.boom.net[69.36.241.24]) - by icicle.pobox.com (Postfix) with ESMTP - for ; Fri, 28 Nov 2003 12:45:38 -0500 (EST) -Received: by abort.boom.net (Postfix, from userid 530) - id E3C8B8517A; Fri, 28 Nov 2003 09:45:36 -0800 (PST) -Date: Fri, 28 Nov 2003 09:45:36 -0800 -From: Mike Hedlund -To: dbi-users@perl.org -Cc: Tim.Bunce@pobox.com -Subject: Memory leak in DBD::Oracle 1.14 ... ? -Message-ID: <20031128174536.GJ10609@boom.net> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.5.4i -Content-Transfer-Encoding: 8bit -X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id hASMLLnY018698 -Content-Length: 24309 -Lines: 434 - -I've attached a little script which replicates the problem on my machine as well as the build session log for DBD::Oracle 1.14. - -I've tested it using DBI 1.38 and DBI 1.28 with both DBD::Oracle 1.12 and 1.14. - -Regardless of the DBI version, DBD::Oracle 1.14 leaks on my system and DBD::Oracle 1.12 does not. I've noticed the leak when calling connect_cached(), do() (or prepare()/execute()/commit/finish). - --mike - - --------------------- script --------------- -#!/usr/bin/perl -use strict; -use DBI; - -my($dbp) = "dbi:Oracle:host=weirdo.com;port=1521;sid=SID"; -my($dbu) = "username"; -my($dbpass) = "password"; - -while (1) { - my($sth); - my(@row); - my($dbh) = DBI->connect_cached($dbp,$dbu,$dbpass) || die "Couldn't connect to oracle db: $DBI::errstr\n"; - -## -## uncomment these and it just leaks faster. -## -# $sth = $dbh->prepare("SELECT * from FROM_STATS"); -# $sth->execute; -# while(@row = $sth->fetchrow_array) { - ##print "row: @row\n"; -# } -# $sth->finish; -} -exit; ------------------------- end script -------------------- - - ------------- log --------------------------------------- -Script started on Fri 28 Nov 2003 09:11:15 AM PST -[mike@commando DBD-Oracle-1.14]$ setenv ORACLE_HOME /home/orahome -[mike@commando DBD-Oracle-1.14]$ make realclean -rm -f blib/script/ora_explain -rm -rf Oracle.c Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def ora_explain mk.pm ./blib Makefile.aperl blib/arch/auto/DBD/Oracle/extralibs.all perlmain.c tmon.out mon.out so_locations pm_to_blib *.o *.a perl.exe perl perl Oracle.bs Oracle.bso Oracle.def libOracle.def Oracle.exp Oracle.x core core.*perl.*.? *perl.core -mv Makefile Makefile.old > /dev/null 2>&1 -rm -rf blib/lib/auto/DBD/Oracle blib/arch/auto/DBD/Oracle -rm -rf DBD-Oracle-1.14 -rm -f blib/arch/auto/DBD/Oracle/Oracle.so blib/arch/auto/DBD/Oracle/Oracle.bs -rm -f blib/arch/auto/DBD/Oracle/Oracle.a -rm -f blib/lib/DBD/Oracle.pm blib/arch/auto/DBD/Oracle/dbdimp.h blib/lib/oraperl.ph -rm -f blib/arch/auto/DBD/Oracle/ocitrace.h blib/lib/Oraperl.pm -rm -f blib/arch/auto/DBD/Oracle/Oracle.h blib/arch/auto/DBD/Oracle/mk.pm -rm -f blib/lib/DBD/Oracle/GetInfo.pm -rm -rf Makefile Makefile.old -[mike@commando DBD-Oracle-1.14]$ perl Makefile.PL -v -Using DBI 1.38 installed in /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI - - Configuring DBD::Oracle ... - ->>> Remember to actually *READ* the README file! - Especially if you have any problems. - -Using Oracle in /home/orahome - -WARNING: could not decode oracle version from -/home/orahome/orainst/inspdver, or /home/orahome/install/unix.rgs -or from ORACLE_HOME path /home/orahome. -Oracle version based logic in Makefile.PL may produce erroneous results. - -Found header files in rdbms/public rdbms/demo. -Found /home/orahome/rdbms/demo/demo_rdbms.mk -Found /home/orahome/otrace/demo/atmoci.mk -Found /home/orahome/precomp/demo/proc/demo_proc.mk -Using /home/orahome/rdbms/demo/demo_rdbms.mk -Reading /home/orahome/rdbms/demo/demo_rdbms.mk -Reading /home/orahome/rdbms/lib/env_rdbms.mk -Read a total of 2202 lines from /home/orahome/rdbms/lib/env_rdbms.mk (including inclusions) -Read a total of 2493 lines from /home/orahome/rdbms/demo/demo_rdbms.mk (including inclusions) -Deleted SHELL definition: SHELL=/bin/sh -Deleted LIB_EXT definition: LIB_EXT=a -Deleted OBJ_EXT definition: OBJ_EXT=o -Deleted AR definition: AR=ar -Deleted AS definition: AS=as -Deleted CC definition: CC=cc -Deleted CHMOD definition: CHMOD=chmod -Deleted CPP definition: CPP=cpp -Deleted ECHO definition: ECHO=echo -Deleted LD definition: LD=ld -Deleted PERL definition: PERL=perl -Deleted CFLAGS definition: CFLAGS=$(GFLAG) $(OPTIMIZE) $(CDEBUG) $(CCFLAGS) $(PFLAGS)\ - $(SHARED_CFLAG) $(USRFLAGS) -Deleted LDFLAGS definition: LDFLAGS=-o $@ $(LDPATHFLAG)$(PRODLIBHOME) $(LDPATHFLAG)$(LIBHOME) -Deleted LDFLAGS definition: LDFLAGS=-o $@ $(LDPATHFLAG)$(PRODLIBHOME) $(LDPATHFLAG)$(LIBHOME) $(LDPATHFLAG)$(LIBHOME)stubs/ -Deleted OPTIMIZE definition: OPTIMIZE=$(OPTIMIZE3) -Deleted AR definition: AR=/usr/bin/ar -Deleted AS definition: AS=/usr/bin/as -Deleted LD definition: LD=/usr/bin/ld -Deleted CPP definition: CPP=/lib/cpp -Deleted CHMOD definition: CHMOD=/bin/chmod -Deleted ASFLAGS definition: ASFLAGS= -Deleting ORA_NLS = $(ORACLE_HOME)/ocommon/nls/admin/data/ - because it is not already set in the environment - and it can cause ORA-01019 errors. -Deleted ORA_NLS definition: ORA_NLS = $(ORACLE_HOME)/ocommon/nls/admin/data/ -Deleting ORA_NLS33 = $(ORACLE_HOME)/ocommon/nls/admin/data/ - because it is not already set in the environment - and it can cause ORA-01019 errors. -Deleted ORA_NLS33 definition: ORA_NLS33 = $(ORACLE_HOME)/ocommon/nls/admin/data/ -Appending '/home/orahome/rdbms/lib/libskgxpd.a /home/orahome/rdbms/lib/libskgxpu.a /home/orahome/rdbms/lib/libskgxpt.a' to EXTRALIBS -Appending '$(LIBHOME)libskgxp9.so' to SHLIBS -Appending '/home/orahome/rdbms/lib/libskgxp9.a' to LIBS -Appending '/home/orahome/rdbms/lib/libskgxns.a /home/orahome/rdbms/lib/libskgxnd.a /home/orahome/rdbms/lib/libskgxnr.a' to EXTRALIBS -Appending '$(LIBHOME)libskgxn9.so' to SHLIBS -Appending '/home/orahome/rdbms/lib/libskgxn9.a' to LIBS -Evaluating `cat $(LIBHOME)sysliblist` - expanded `cat /home/orahome/lib/sysliblist` - returned '-ldl -lm -lpthread -lnsl ' - -Attempting to discover Oracle OCI build rules -gcc -c -o DBD_ORA_OBJ.o DBD_ORA_OBJ.c -by executing: (make -f /home/orahome/rdbms/demo/demo_rdbms.mk build ECHODO=echo ECHO=echo GENCLNTSH='echo genclntsh' CC=echo OPTIMIZE= CCFLAGS= EXE=DBD_ORA_EXE OBJS=DBD_ORA_OBJ.o) -returned: -[echo -L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -o DBD_ORA_EXE DBD_ORA_OBJ.o -lclntsh `cat /home/orahome/lib/sysliblist` -ldl -lm - -[-L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -o DBD_ORA_EXE DBD_ORA_OBJ.o -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm -] -reduced to: -[-L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -o DBD_ORA_EXE DBD_ORA_OBJ.o -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm -] -Oracle oci build command: - + -L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -o DBD_ORA_EXE DBD_ORA_OBJ.o -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm - - - -System: perl5.008 linux stripples.devel.redhat.com 2.4.21-1.1931.2.382.entsmp #1 smp wed aug 6 17:18:52 edt 2003 i686 i686 i386 gnulinux -Compiler: gcc -O2 -g -pipe -march=i386 -mcpu=i686 -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -Linker: /usr/bin/ld -Sysliblist: -ldl -lm -lpthread -lnsl -Oracle makefiles would have used these definitions but we override them: - CC: cc - - CFLAGS: $(GFLAG) $(OPTIMIZE) $(CDEBUG) $(CCFLAGS) $(PFLAGS)\ - $(SHARED_CFLAG) $(USRFLAGS) - [$(GFLAG) -O3 $(CDEBUG) $(CCFLAGS) -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -DLINUX -D_GNU_SOURCE -D_LARGEFILE64_SOURCE=1 -D_LARGEFILE_SOURCE=1 -DSLTS_ENABLE -DSLMXMX_ENABLE -D_REENTRANT -DNS_THREADS $(LPFLAGS) $(USRFLAGS)] - - LDFLAGS: -o $@ $(LDPATHFLAG)$(PRODLIBHOME) $(LDPATHFLAG)$(LIBHOME) $(LDPATHFLAG)$(LIBHOME)stubs/ - [-o $@ -L/home/orahome/rdbms/lib/ -L$(LIBHOME) -L$(LIBHOME)stubs/] - - -Linking with OTHERLDFLAGS = -L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm - [from 'build' rule] - - -MakeMaker (v6.03) -Checking if your kit is complete... -Looks good - ABSTRACT_FROM => q[Oracle.pm] - AUTHOR => q[Tim Bunce (dbi-users@perl.org)] - DEFINE => q[ -DUTF8_SUPPORT] - DIR => [] - EXE_FILES => [q[ora_explain]] - INC => q[-I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/rdbms/demo -I/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI] - NAME => q[DBD::Oracle] - OBJECT => q[$(O_FILES)] - PREREQ_PM => { DBI=>q[0] } - VERSION_FROM => q[Oracle.pm] - clean => { FILES=>q[Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def ora_explain mk.pm] } - dist => { DIST_DEFAULT=>q[clean distcheck disttest ci tardist], COMPRESS=>q[gzip -v9], PREOP=>q[$(MAKE) -f Makefile.old distdir], SUFFIX=>q[gz] } - dynamic_lib => { OTHERLDFLAGS=>q[ -L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm -] } -Using PERL=/usr/bin/perl -LD_RUN_PATH=/home/orahome/lib:/home/orahome/rdbms/lib -Using DBD::Oracle 1.14. -Using DBD::Oracle 1.14. -Using DBI 1.38 installed in /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI -Writing Makefile for DBD::Oracle - -*** If you have problems... - read all the log printed above, and the README and README.help files. - (Of course, you have read README by now anyway, haven't you?) - -[mike@commando DBD-Oracle-1.14]$ make -cp Oracle.pm blib/lib/DBD/Oracle.pm -cp Oracle.h blib/arch/auto/DBD/Oracle/Oracle.h -cp dbdimp.h blib/arch/auto/DBD/Oracle/dbdimp.h -cp oraperl.ph blib/lib/oraperl.ph -cp ocitrace.h blib/arch/auto/DBD/Oracle/ocitrace.h -cp Oraperl.pm blib/lib/Oraperl.pm -cp mk.pm blib/arch/auto/DBD/Oracle/mk.pm -cp lib/DBD/Oracle/GetInfo.pm blib/lib/DBD/Oracle/GetInfo.pm -/usr/bin/perl -p -e "s/~DRIVER~/Oracle/g" /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI/Driver.xst > Oracle.xsi -/usr/bin/perl /usr/lib/perl5/5.8.0/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.8.0/ExtUtils/typemap Oracle.xs > Oracle.xsc && mv Oracle.xsc Oracle.c -gcc -c -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/rdbms/demo -I/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -march=i386 -mcpu=i686 -DVERSION=\"1.14\" -DXS_VERSION=\"1.14\" -fPIC "-I/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE" -DUTF8_SUPPORT Oracle.c -gcc -c -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/rdbms/demo -I/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -march=i386 -mcpu=i686 -DVERSION=\"1.14\" -DXS_VERSION=\"1.14\" -fPIC "-I/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE" -DUTF8_SUPPORT dbdimp.c -gcc -c -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/rdbms/demo -I/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -march=i386 -mcpu=i686 -DVERSION=\"1.14\" -DXS_VERSION=\"1.14\" -fPIC "-I/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE" -DUTF8_SUPPORT oci7.c -gcc -c -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/plsql/public -I/home/orahome/network/public -I/home/orahome/rdbms/demo -I/home/orahome/rdbms/public -I/home/orahome/rdbms/demo -I/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/auto/DBI -D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm -O2 -g -pipe -march=i386 -mcpu=i686 -DVERSION=\"1.14\" -DXS_VERSION=\"1.14\" -fPIC "-I/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE" -DUTF8_SUPPORT oci8.c -Running Mkbootstrap for DBD::Oracle () -chmod 644 Oracle.bs -rm -f blib/arch/auto/DBD/Oracle/Oracle.so -LD_RUN_PATH="/home/orahome/lib:/home/orahome/rdbms/lib" gcc -shared -L/usr/local/lib Oracle.o dbdimp.o oci7.o oci8.o -L/home/orahome/lib/ -L/home/orahome/rdbms/lib/ -lclntsh -ldl -lm -lpthread -lnsl -ldl -lm -o blib/arch/auto/DBD/Oracle/Oracle.so -chmod 755 blib/arch/auto/DBD/Oracle/Oracle.so -cp Oracle.bs blib/arch/auto/DBD/Oracle/Oracle.bs -chmod 644 blib/arch/auto/DBD/Oracle/Oracle.bs -/usr/bin/perl "-Iblib/arch" "-Iblib/lib" ora_explain.PL ora_explain -Extracted ora_explain from ora_explain.PL with variable substitutions. -cp ora_explain blib/script/ora_explain -/usr/bin/perl "-MExtUtils::MY" -e "MY->fixin(shift)" blib/script/ora_explain -Manifying blib/man3/DBD::Oracle.3pm -Manifying blib/man1/ora_explain.1 -Manifying blib/man3/DBD::Oraperl.3pm -[mike@commando DBD-Oracle-1.14]$ make test -PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t -t/base....... t/base.......ok 1/5 t/base.......ok 2/5 t/base.......ok 3/5 t/base.......ok 4/5 t/base.......ok 5/5 t/base.......ok -t/cursor.....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle as scott/tiger (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -skipped - all skipped: no reason given -t/general....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at t/general.t line 20 -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -skipped - all skipped: no reason given -t/long.......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -skipped - all skipped: no reason given -t/meta.......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle as scott/tiger (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -skipped - all skipped: no reason given -t/ph_type....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at t/ph_type.t line 26 -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -skipped - all skipped: no reason given -t/plsql......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -skipped - all skipped: no reason given -t/reauth.....skipped - all skipped: no reason given -t/select.....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -skipped - all skipped: no reason given -All tests successful, 8 tests skipped. -Files=9, Tests=5, 7 wallclock secs ( 3.82 cusr + 0.33 csys = 4.15 CPU) -PERL_DL_NONLAZY=1 /usr/bin/perl "-Iblib/lib" "-Iblib/arch" test.pl -Oraperl test application $Revision: 1.7 $ - - -Extra tests. These are less formal and you need to read the output -to see if it looks reasonable and matches what the tests says is expected. - -Oraperl emulation interface version 1.43 -DBD::Oracle 1.14 using OCI8 by Tim Bunce -DBI 1.38 by Tim Bunce - -Data sources: - - - -Connecting - to '' (from command line, else uses ORACLE_SID or TWO_TASK - recommended) - as 'scott/tiger' (via ORACLE_USERID env var or default - recommend name/passwd@dbname) -(ORACLE_SID='', TWO_TASK='') -oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at /home/mike/tmp/DBD-Oracle-1.14/blib/lib/Oraperl.pm line 104 -ora_login: 12547: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) - -Generally set TWO_TASK or ORACLE_SID but not both at the same time. -Try to connect to the database using an oracle tool like sqlplus -only if that works should you suspect problems with DBD::Oracle. -Try leaving dbname value empty and set dbuser to name/passwd@dbname. - -Test aborted. -make: *** [test_dynamic] Error 255 -[mike@commando DBD-Oracle-1.14]$ make test TEST_VERBOSE=1 -PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib/lib', 'blib/arch')" t/*.t -t/base.......1..5 -ok 1 -ok 2 -ok 3 -ok 4 -ok 5 -ok -t/cursor.....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle as scott/tiger (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -1..0 -skipped - all skipped: no reason given -t/general....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at t/general.t line 20 -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -1..0 -skipped - all skipped: no reason given -t/long.......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -1..0 -skipped - all skipped: no reason given -t/meta.......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle as scott/tiger (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -1..0 -skipped - all skipped: no reason given -t/ph_type....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at t/ph_type.t line 26 -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skipped. -1..0 -skipped - all skipped: no reason given -t/plsql......oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -1..0 -skipped - all skipped: no reason given -t/reauth.....ORACLE_USERID_2 not defined. -Tests skiped. -1..0 -skipped - all skipped: no reason given -t/select.....oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -Unable to connect to Oracle (ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach)) -Tests skiped. -1..0 -skipped - all skipped: no reason given -All tests successful, 8 tests skipped. -Files=9, Tests=5, 7 wallclock secs ( 3.85 cusr + 0.32 csys = 4.17 CPU) -PERL_DL_NONLAZY=1 /usr/bin/perl "-Iblib/lib" "-Iblib/arch" test.pl -Oraperl test application $Revision: 1.7 $ - - -Extra tests. These are less formal and you need to read the output -to see if it looks reasonable and matches what the tests says is expected. - -Oraperl emulation interface version 1.43 -DBD::Oracle 1.14 using OCI8 by Tim Bunce -DBI 1.38 by Tim Bunce - -Data sources: - - - -Connecting - to '' (from command line, else uses ORACLE_SID or TWO_TASK - recommended) - as 'scott/tiger' (via ORACLE_USERID env var or default - recommend name/passwd@dbname) -(ORACLE_SID='', TWO_TASK='') -oracle: error while loading shared libraries: libodm9.so: cannot open shared object file: No such file or directory -DBI connect('','scott/tiger',...) failed: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) at /home/mike/tmp/DBD-Oracle-1.14/blib/lib/Oraperl.pm line 104 -ora_login: 12547: ORA-12547: TNS:lost contact (DBD ERROR: OCIServerAttach) - -Generally set TWO_TASK or ORACLE_SID but not both at the same time. -Try to connect to the database using an oracle tool like sqlplus -only if that works should you suspect problems with DBD::Oracle. -Try leaving dbname value empty and set dbuser to name/passwd@dbname. - -Test aborted. -make: *** [test_dynamic] Error 255 -[mike@commando DBD-Oracle-1.14]$ perl _V-V -Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration: - Platform: - osname=linux, osvers=2.4.21-1.1931.2.382.entsmp, archname=i386-linux-thread-multi - uname='linux str' - config_args='-des -Doptimize=-O2 -g -pipe -march=i386 -mcpu=i686 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Dotherlibdirs=/usr/lib/perl5/5.8.0 -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr' - hint=recommended, useposix=true, d_sigaction=define - usethreads=define use5005threads=undef' - useithreads=define usemultiplicity= - useperlio= d_sfio=undef uselargefiles=define usesocks=undef - use64bitint=undef use64bitall=un uselongdouble= - usemymalloc=, bincompat5005=undef - Compiler: - cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm', - optimize='', - cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm' - ccversion='', gccversion='3.2.2 20030222 (Red Hat Linux 3.2.2-5)', gccosandvers='' -gccversion='3.2.2 200302' - intsize=r, longsize=r, ptrsize=5, doublesize=8, byteorder=1234 - d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 - ivtype='long' -k', ivsize=4' -ivtype='l, nvtype='double' -o_nonbl', nvsize=, Off_t='', lseeksize=8 - alignbytes=4, prototype=define - Linker and Libraries: - ld='gcc' -l', ldflags =' -L/u' - libpth=/usr/local/lib /lib /usr/lib - libs=-lnsl -lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt -lutil - perllibs= - libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libper - gnulibc_version='2.3.2' - Dynamic Linking: - dlsrc=dl_dlopen.xs, dlext=so', d_dlsymun=undef, ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE' - cccdlflags='-fPIC' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5', lddlflags='s Unicode/Normalize XS/A' - - -Characteristics of this binary (from libperl): - Compile-time options: DEBUGGING MULTIPLICITY USE_ITHREADS USE_LARGE_FILES PERL_IMPLICIT_CONTEXT - Locally applied patches: - MAINT18379 - Built under linux - Compiled at Aug 13 2003 11:47:58 - @INC: - /usr/lib/perl5/5.8.0/i386-linux-thread-multi - /usr/lib/perl5/5.8.0 - /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi - /usr/lib/perl5/site_perl/5.8.0 - /usr/lib/perl5/site_perl - /usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi - /usr/lib/perl5/vendor_perl/5.8.0 - /usr/lib/perl5/vendor_perl - /usr/lib/perl5/5.8.0/i386-linux-thread-multi - /usr/lib/perl5/5.8.0 - . -[mike@commando DBD-Oracle-1.14]$ ^D -Script done on Fri 28 Nov 2003 09:16:43 AM PST ------------- end log ----------------------------------- - - diff --git a/err_unsorted/err_multiora.msg b/err_unsorted/err_multiora.msg deleted file mode 100644 index 9f7bcf6c..00000000 --- a/err_unsorted/err_multiora.msg +++ /dev/null @@ -1,470 +0,0 @@ -From dbi-users-return-21438-Tim.Bunce=pobox.com@perl.org Mon Jan 5 10:12:58 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i05ACYn1063537 - for ; Mon, 5 Jan 2004 10:12:58 GMT - (envelope-from dbi-users-return-21438-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Mon, 05 Jan 2004 10:12:58 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AdQXY-0007a7-IO; - Mon, 05 Jan 2004 09:18:18 +0000 -Received: from [208.58.1.194] (helo=integer.pobox.com) - by punt-3.mail.demon.net with esmtp id 1AdQXY-0007a7-IO - for pobox@dbi.demon.co.uk; Mon, 05 Jan 2004 08:56:48 +0000 -Received: from integer.pobox.com (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id C92F0282F - for ; Mon, 5 Jan 2004 03:56:45 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id B344B2B84 - for ; Mon, 5 Jan 2004 03:56:45 -0500 (EST) -Received: from onion.perl.org (onion.develooper.com [63.251.223.166]) - by integer.pobox.com (Postfix) with SMTP - for ; Mon, 5 Jan 2004 03:56:45 -0500 (EST) -Received: (qmail 58691 invoked by uid 1005); 5 Jan 2004 08:56:38 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 58674 invoked by uid 76); 5 Jan 2004 08:56:38 -0000 -Received: from qmailr@one.develooper.com (HELO ran-out.mx.develooper.com) (64.81.84.115) by onion.perl.org (qpsmtpd/0.26) with SMTP; Mon, 05 Jan 2004 00:56:38 -0800 -Received: (qmail 17937 invoked by uid 225); 5 Jan 2004 08:56:36 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 17930 invoked by uid 507); 5 Jan 2004 08:56:36 -0000 -Received: from stone.sifira.dk (HELO mail.int.sifira.dk) (217.157.24.2) by one.develooper.com (qpsmtpd/0.27-dev) with ESMTP; Mon, 05 Jan 2004 00:56:05 -0800 -Received: from ash.int.sifira.dk (ash.int.sifira.dk [192.168.1.7]) by mail.int.sifira.dk (Postfix) with ESMTP id F127674F58; Mon, 5 Jan 2004 09:55:58 +0100 (MET) -Sender: kn@sifira.dk -To: "Anniballi, Fran" -Cc: -Subject: Re: Help - multiple Oracle versions -References: <6B003D25ADBDE347B5542AFE6A55B42E03227831@tayexc13.americas.cpqcorp.net> -From: Kristian Nielsen -Date: 05 Jan 2004 09:55:59 +0100 -In-Reply-To: <6B003D25ADBDE347B5542AFE6A55B42E03227831@tayexc13.americas.cpqcorp.net> -Message-ID: <7sllomsrj4.fsf@ash.int.sifira.dk> -User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/21.2 -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=-2.5 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,QUOTED_EMAIL_TEXT,REFERENCES,SPAM_PHRASE_00_01,USER_AGENT,USER_AGENT_GNUS_UA version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Status: RO -Content-Length: 1223 -Lines: 40 - -[Add notes to docs covering what's in this thread] - -"Anniballi, Fran" writes: - -> For option two, if I have two versions of DBD:Oracle, how do I tell -> Perl which one to use? My scripts just say "/usr/bin/perl" in the -> first line. - -Basically, when you compile you use the PREFIX option: - - export ORACLE_HOME=/usr/local/oracle8 - perl Makefile.PL PREFIX=/usr/local/oracle8-perl - make - make install - - export ORACLE_HOME=/usr/local/oracle9 - perl Makefile.PL PREFIX=/usr/local/oracle9-perl - make - make install - -Then before running the perl script you should set the PERLLIB -environment variable to point to the correct location for the proper -version of DBD::Oracle. Alternatively, you could have the perl script -select the proper DBD::Oracle location based on the value of -ORACLE_HOME: - - #! /usr/bin/perl - BEGIN { - if($ENV{ORACLE_HOME} =~ /8/) { - use lib '/usr/local/oracle8-perl/REST/OF/PATH'; - } else { - use lib '/usr/local/oracle9-perl/REST/OF/PATH'; - } - } - use DBI; - -This is all from the top of my head; you will need to fiddle a bit to -get the details right (like the correct path etc). Also, I think this -has been covered in greater detail before; you might want to try -searching the archives. - - - Kristian. - - -From dbi-users-return-21441-Tim.Bunce=pobox.com@perl.org Mon Jan 5 14:47:30 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i05Ejvo1064760 - for ; Mon, 5 Jan 2004 14:47:30 GMT - (envelope-from dbi-users-return-21441-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Mon, 05 Jan 2004 14:47:30 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AdVCS-0004w0-Is; - Mon, 05 Jan 2004 13:55:22 +0000 -Received: from [208.58.1.194] (helo=integer.pobox.com) - by punt-3.mail.demon.net with esmtp id 1AdVCS-0004w0-Is - for pobox@dbi.demon.co.uk; Mon, 05 Jan 2004 13:55:21 +0000 -Received: from integer.pobox.com (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id 548DE2C87 - for ; Mon, 5 Jan 2004 08:55:20 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id 417692C81 - for ; Mon, 5 Jan 2004 08:55:20 -0500 (EST) -Received: from onion.perl.org (onion.develooper.com [63.251.223.166]) - by integer.pobox.com (Postfix) with SMTP - for ; Mon, 5 Jan 2004 08:55:19 -0500 (EST) -Received: (qmail 91728 invoked by uid 1005); 5 Jan 2004 13:55:17 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 48614 invoked by uid 76); 5 Jan 2004 12:24:01 -0000 -Delivered-To: dbi-users@perl.org -X-MimeOLE: Produced By Microsoft Exchange V6.0.6487.1 -content-class: urn:content-classes:message -MIME-Version: 1.0 -Content-Type: text/plain; charset="iso-8859-1" -Subject: RE: Help - multiple Oracle versions -Date: Mon, 5 Jan 2004 07:23:23 -0500 -Message-ID: <6B003D25ADBDE347B5542AFE6A55B42E04537A09@tayexc13.americas.cpqcorp.net> -X-MS-Has-Attach: -X-MS-TNEF-Correlator: -Thread-Topic: Help - multiple Oracle versions -Thread-Index: AcPTac0nADA1C8LsTdSTxpcvyeSNCgAHQWGQ -From: "Anniballi, Fran" -To: -Cc: -X-OriginalArrivalTime: 05 Jan 2004 12:23:24.0525 (UTC) FILETIME=[B6F761D0:01C3D386] -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=0.3 required=7.0 tests=CARRIAGE_RETURNS,QUOTED_EMAIL_TEXT,SPAM_PHRASE_00_01 version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Content-Transfer-Encoding: 8bit -X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id i05Ejvo1064760 -Status: RO -Content-Length: 1465 -Lines: 52 - -Thanks. Looks like this is what I'll need. - ------Original Message----- -From: kn@sifira.dk [mailto:kn@sifira.dk] -Sent: Monday, January 05, 2004 3:56 AM -To: Anniballi, Fran -Cc: dbi-users@perl.org -Subject: Re: Help - multiple Oracle versions - - -"Anniballi, Fran" writes: - -> For option two, if I have two versions of DBD:Oracle, how do I tell -> Perl which one to use? My scripts just say "/usr/bin/perl" in the -> first line. - -Basically, when you compile you use the PREFIX option: - - export ORACLE_HOME=/usr/local/oracle8 - perl Makefile.PL PREFIX=/usr/local/oracle8-perl - make - make install - - export ORACLE_HOME=/usr/local/oracle9 - perl Makefile.PL PREFIX=/usr/local/oracle9-perl - make - make install - -Then before running the perl script you should set the PERLLIB -environment variable to point to the correct location for the proper -version of DBD::Oracle. Alternatively, you could have the perl script -select the proper DBD::Oracle location based on the value of -ORACLE_HOME: - - #! /usr/bin/perl - BEGIN { - if($ENV{ORACLE_HOME} =~ /8/) { - use lib '/usr/local/oracle8-perl/REST/OF/PATH'; - } else { - use lib '/usr/local/oracle9-perl/REST/OF/PATH'; - } - } - use DBI; - -This is all from the top of my head; you will need to fiddle a bit to -get the details right (like the correct path etc). Also, I think this -has been covered in greater detail before; you might want to try -searching the archives. - - - Kristian. - - - -From dbi-users-return-21449-Tim.Bunce=pobox.com@perl.org Tue Jan 6 17:00:29 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i06GxrnC075337 - for ; Tue, 6 Jan 2004 17:00:29 GMT - (envelope-from dbi-users-return-21449-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 06 Jan 2004 17:00:29 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1Adu0c-0004RW-9d; - Tue, 06 Jan 2004 16:24:47 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by punt-3.mail.demon.net with esmtp id 1Adu0c-0004RW-9d - for pobox@dbi.demon.co.uk; Tue, 06 Jan 2004 16:24:47 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 21A79495C - for ; Tue, 6 Jan 2004 11:24:46 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 08B12494B - for ; Tue, 6 Jan 2004 11:24:46 -0500 (EST) -Received: from onion.perl.org (onion.develooper.com [63.251.223.166]) - by boggle.pobox.com (Postfix) with SMTP - for ; Tue, 6 Jan 2004 11:24:45 -0500 (EST) -Received: (qmail 25114 invoked by uid 1005); 6 Jan 2004 16:24:42 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 25095 invoked by uid 76); 6 Jan 2004 16:24:42 -0000 -Received: from qmailr@one.develooper.com (HELO ran-out.mx.develooper.com) (64.81.84.115) by onion.perl.org (qpsmtpd/0.26) with SMTP; Tue, 06 Jan 2004 08:24:42 -0800 -Received: (qmail 16535 invoked by uid 225); 6 Jan 2004 16:24:39 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 16527 invoked by uid 507); 6 Jan 2004 16:24:39 -0000 -Received: from mail.cybcon.com (HELO mail.cybcon.com) (216.190.188.5) by one.develooper.com (qpsmtpd/0.27-dev) with ESMTP; Tue, 06 Jan 2004 08:24:08 -0800 -Received: from poirot (dsl2-6.cybcon.com [208.186.116.6]) by mail.cybcon.com (8.11.6/8.11.6) with ESMTP id i06GNhn08916; Tue, 6 Jan 2004 08:23:43 -0800 -Subject: RE: Help - multiple Oracle versions -From: Jared Still -To: "Anniballi, Fran" -Cc: DBI List -In-Reply-To: <6B003D25ADBDE347B5542AFE6A55B42E03227831@tayexc13.americas.cpqcorp.net> -References: <6B003D25ADBDE347B5542AFE6A55B42E03227831@tayexc13.americas.cpqcorp.net> -Content-Type: text/plain -Content-Transfer-Encoding: 7bit -X-Mailer: Ximian Evolution 1.0.8 (1.0.8-11) -Date: 06 Jan 2004 08:25:59 -0800 -Message-Id: <1073406359.324.244.camel@poirot.jks.com> -Mime-Version: 1.0 -X-CyberConnectics-MailScanner2-Information: Spam/Virus Scanned at CyberConnectics -X-CyberConnectics-MailScanner2: Found to be clean -X-CyberConnectics-MailScanner2-SpamCheck: -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=-0.2 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,QUOTED_EMAIL_TEXT,REFERENCES,SPAM_PHRASE_05_08,SUPERLONG_LINE version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Status: RO -Content-Length: 4050 -Lines: 102 - -I read quickly through this thread, so my apologies if someone -already pointed this out. - -It doesn't matter which version of Oracle you compiled DBD with, -you can connect to all your 8i/9i databases on any platform with it. - -Assume you compiled with 9i libs, and you can connect to 9i db's with -no problem, but are unable to connect to 8i, getting the error you -mentioned previously. - -It appears that you are changing your Oracle environment via the -oraenv shell script to change your ORACLE_HOME to the 8i version -of Oracle. - -If so, stop doing that. Just leave your environment at 9i, and -connect to your 8i database. It will be fine. This is the way -my linux server is setup, and DBD is used to connect to Oracle -versions 7.3, 8.1.6, 8.1.7 and 9.2.0 every day. - -At our site DBD is compiled with 8i libs so that we can still -connect to the version 7 databases. If you compile with 9i libs, -you will be unable to connect to version 7 databases. - -HTH - -Jared - - -On Sun, 2004-01-04 at 05:12, Anniballi, Fran wrote: -> This is all done on one UNIX box. -> -> If I try option one, it doesn't work. I can't access an oracle8 instance with oracle9 sqlplus (or the other way around). That is the real problem. Since I can't do this I have to reassign the pointers before I access it. I can do this fine with sqlplus but with dbi/dbd I have to compile with one or the other. -> -> For option two, if I have two versions of DBD:Oracle, how do I tell Perl which one to use? My scripts just say "/usr/bin/perl" in the first line. -> -> -----Original Message----- -> From: kn@sifira.dk [mailto:kn@sifira.dk] -> Sent: Saturday, January 03, 2004 1:04 PM -> To: dbi-users@perl.org -> Cc: Anniballi, Fran -> Subject: Re: Help - multiple Oracle versions -> -> -> "Anniballi, Fran" writes: -> -> > As soon as I recompile the same DBI/DBD with it pointing to Oracle 9 -> > environment (libraries), it doesn't work. It is looking for Oracle9 -> > library files and I obviously don't have it pointing to oracle9 -> > libraries when I access an Oracle 8 instance. Oracle 9 is not -> > compatible with Oracle 8 so I have to redirect the environment -> > variables at run time. -> -> It sounds like you are confusing the Oracle client version and the -> Oracle server version. -> -> Eg. if you set ORACLE_HOME to /usr/local/oracle8 (or whatever) and use -> /usr/local/oracle8/bin/sqlplus you are using the Oracle 8 client, while -> if you set it to /usr/local/oracle9 and call -> /usr/local/oracle9/bin/sqlplus, you are using the Oracle 9 client. -> -> Which Oracle instance you access is selected by the connection string; -> for example "sqlplus scott/tiger@DB8" might access the Oracle 8 -> instance, and "scott/tiger@DB9" might access the Oracle 9 instance. -> -> What people are telling you is that you can choose client version -> independently of the server version. For example, it is possible to set -> ORACLE_HOME to /usr/local/oracle9 and call -> -> /usr/local/oracle9/bin/sqlplus scott/tiger@DB8 -> -> to access the Oracle 8 instance with the Oracle 9 client. This of course -> requires that the definition for DB8 is present in the file -> /usr/local/oracle-9.2/network/admin/tnsnames.ora. -> -> So you should either -> -> 1. Use only the Oracle 9 client, not change ORACLE_HOME, and access both -> instances with Oracle 9 sqlplus and DBD::Oracle compiled against -> Oracle 9 libraries. -> -> or -> -> 2. Compile DBD::Oracle twice (once against Oracle 8 libraries, once -> against Oracle 9 libraries, just as you have two versions of sqlplus) -> and use each one with the proper ORACLE_HOME setting. -> -> My guess is that you will find possibility 1. the easiest. -> -> > The tnsnames.ora are all set. I did what you said already. -> > -> > Example: DBI/DBD will work fine if I compile the DBI/DBD pointing to -> > Oracle 8 environment(libraries) and access an Oracle 8 instance. I -> > didn't have to change tnsnames.ora -> -> Yes you do: You need to have BOTH Oracle instances defined in EACH -> tnsnames.ora. -> -> Hope this helps, -> -> - Kristian. - - - -From andy@andyh.co.uk Wed Jan 7 07:31:57 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i077VPn8081048 - for ; Wed, 7 Jan 2004 07:31:57 GMT - (envelope-from andy@andyh.co.uk) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 07 Jan 2004 07:31:57 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1Ae0Yb-0002lT-IA; - Tue, 06 Jan 2004 23:24:17 +0000 -Received: from [208.58.1.194] (helo=integer.pobox.com) - by punt-3.mail.demon.net with esmtp id 1Ae0Yb-0002lT-IA - for pobox@dbi.demon.co.uk; Tue, 06 Jan 2004 23:24:17 +0000 -Received: from integer.pobox.com (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id 00D7C3C15 - for ; Tue, 6 Jan 2004 18:24:16 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by integer.pobox.com (Postfix) with ESMTP id CB5813BEA - for ; Tue, 6 Jan 2004 18:24:16 -0500 (EST) -Received: from mta03-svc.ntlworld.com (mta03-svc.ntlworld.com [62.253.162.43]) - by integer.pobox.com (Postfix) with ESMTP - for ; Tue, 6 Jan 2004 18:24:16 -0500 (EST) -Received: from excession ([80.2.244.47]) by mta03-svc.ntlworld.com - (InterMail vM.4.01.03.37 201-229-121-137-20020806) with SMTP - id <20040106232403.NEKJ9852.mta03-svc.ntlworld.com@excession>; - Tue, 6 Jan 2004 23:24:03 +0000 -Message-ID: <00bd01c3d4ac$e5713190$6564a8c0@excession> -From: "Andy Hassall" -To: "Eric Lenio" , "Tim Bunce" -Cc: -References: <20040102143310.GC27273@lenio.net> <20040104204914.GB60357@dansat.data-plan.com> <20040105123653.GA31473@lenio.net> <20040105223121.GG66760@dansat.data-plan.com> <20040106222634.GG11531@lenio.net> <20040106223845.GE78360@dansat.data-plan.com> <20040106225722.GI11531@lenio.net> -Subject: Re: DBI primary_key tests fail: oracle 8 -Date: Tue, 6 Jan 2004 23:29:14 -0000 -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-8859-1" -Content-Transfer-Encoding: 7bit -X-Priority: 3 -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook Express 6.00.2800.1158 -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1165 -Status: RO -X-Status: A -Content-Length: 1692 -Lines: 43 - -Eric Lenio wrote: -> OK Tim. One other note -- after reading through oracle docs, I think -> you might want to substitute 'session_user' for 'current_schema' in -> 'select sys_context(...)'. The definition of session_user is -> "returns the database -> user name by which the current user is authenticated" while -> current_schema is "returns the name of the default schema being used -> in the current session". -> Maybe it doesn't matter, I'm not an oracle guru by any stretch of the -> imagination. - -There's several usernames in the USERENV context: - -CURRENT_SCHEMA - -The schema/user used for unqualified object name resolution; by default the -user you logged in as, but alterable with 'alter session set -current_schema=x'. Useful for avoiding having to maintain loads of synonyms. - -CURRENT_USER - -The user you're currently authenticated as. Doesn't change in SQL and -anonymous PL/SQL, but changes within definer-rights PL/SQL stored procedures -to the owner of the stored procedure, since stored procs by default run with -the privileges of the owner, not the invoker. - -SESSION_USER - -Who you originally logged in as, and never changes (but see below). Looks -like the appropriate one to use. - -PROXY_USER - -I don't think DBD::Oracle supports proxy authentication so don't need to -worry about that one yet. Possibly a bit of a grey area if it does support -it in the future, since this would hold the username in the DSN, but it'd -reauthenticate and change the SESSION_USER on connect (which would probably -have to be specified as an attribute to the $dbh). - --- -Andy Hassall (andy@andyh.co.uk) icq(5747695) (http://www.andyh.co.uk) -Space: disk usage analysis tool (http://www.andyhsoftware.co.uk/space) - - diff --git a/err_unsorted/err_ora9ir2oci.msg b/err_unsorted/err_ora9ir2oci.msg deleted file mode 100644 index 7ed476e4..00000000 --- a/err_unsorted/err_ora9ir2oci.msg +++ /dev/null @@ -1,27 +0,0 @@ -http://otn.oracle.com/tech/oci/htdocs/oci9ir2_new_features - -OCI Session Pooling -Session Pooling is a new feature in Oracle 9i Database Release 2. -An application can now maintain a pool of sessions and use a session -from the pool when it needs it. This saves the time consuming process -of initiating a connection and authentication every time the process -needs a new session. Session Pooling is useful, especially when a -large number of stateless sessions are required for a very short -time. In a web scenario, where many users are connected for a short -time, and the primary operation is accessing data, it is a costly -operation to start up a new session every time. In such a scenario, -session pooling could boost up the performance. - -OCI Statement caching -Client-side statement caching is also introduced in Oracle9i Database -Release 2. This feature can be enabled at the time of session -creation. It allows users to have a cache of statements per session. -On the server, this means having cursors that ready to be used, -without the need to parse the statements again, and thus improving -performance significantly. With this feature enabled, applications -do not have to keep a track of the statements themselves, as the -OCI layer will do it for them. In addition, a tagging feature is -provided, which users can use as a key to save and search for -statements. - - diff --git a/err_unsorted/err_ref_type.msg b/err_unsorted/err_ref_type.msg deleted file mode 100644 index 26d86e14..00000000 --- a/err_unsorted/err_ref_type.msg +++ /dev/null @@ -1,115 +0,0 @@ -From dbi-users-return-19574-Tim.Bunce=pobox.com@perl.org Wed Jul 23 18:40:02 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id h6NHUUA0010501 - for ; Wed, 23 Jul 2003 18:40:02 +0100 (BST) - (envelope-from dbi-users-return-19574-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 23 Jul 2003 18:40:02 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1058948095:10:09585:8; Wed, 23 Jul 2003 08:14:55 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1116163; 23 Jul 2003 8:14 GMT -Received: from dolly1.pobox.com (localhost [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 88C1B21C024 - for ; Wed, 23 Jul 2003 04:13:51 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) - by dolly1.pobox.com (Postfix) with SMTP id AA89B21C082 - for ; Wed, 23 Jul 2003 04:13:50 -0400 (EDT) -Received: (qmail 26606 invoked by uid 1005); 23 Jul 2003 08:13:44 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 26590 invoked by uid 76); 23 Jul 2003 08:13:43 -0000 -Received: from qmailr@one.develooper.com (HELO ran-out.mx.develooper.com) (64.81.84.115) by onion.perl.org (qpsmtpd/0.26) with SMTP; Wed, 23 Jul 2003 01:13:43 -0700 -Received: (qmail 16360 invoked by uid 225); 23 Jul 2003 08:13:41 -0000 -Delivered-To: dbi-users@perl.org -Received: (qmail 16355 invoked by uid 507); 23 Jul 2003 08:13:41 -0000 -Received-SPF: unknown -Received: from [212.89.121.1] (HELO babel.morphochem.de) (212.89.121.1) by one.develooper.com (qpsmtpd/0.27-dev) with SMTP; Wed, 23 Jul 2003 01:13:41 -0700 -Received: (qmail 5378 invoked from network); 23 Jul 2003 08:54:08 -0000 -Received: from unknown (HELO mail.morphochem.de) (10.1.15.5) by 212.89.121.1 with SMTP; 23 Jul 2003 08:54:08 -0000 -Received: (qmail 8984 invoked from network); 23 Jul 2003 08:13:49 -0000 -Received: from localhost.morphochem.de (HELO mail) ([127.0.0.1]) (envelope-sender ) by localhost.morphochem.de (qmail-ldap-1.03) with SMTP for ; 23 Jul 2003 08:13:49 -0000 -Received: from mars.MORPHOCHEM.de ([10.1.8.130]) by mail.morphochem.de (MailMonitor for SMTP v1.2.1 ) ; Wed, 23 Jul 2003 10:13:49 +0200 (CEST) -Subject: Re: binding to parameters of type REF -From: Hendrik =?ISO-8859-1?Q?Fu=DF?= -To: dbi-users@perl.org -In-Reply-To: <1058865345.1241.56.camel@mars> -References: <1058865345.1241.56.camel@mars> -Content-Type: text/plain -Content-Transfer-Encoding: 7bit -X-Mailer: Ximian Evolution 1.0.8 -Date: 23 Jul 2003 10:11:49 +0200 -Message-Id: <1058947909.6353.5.camel@mars> -Mime-Version: 1.0 -X-SMTPD: qpsmtpd/0.27-dev, http://develooper.com/code/qpsmtpd/ -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=-0.3 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,LARGE_HEX,QUOTED_EMAIL_TEXT,REFERENCES,SPAM_PHRASE_00_01 version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Status: RO -Content-Length: 1354 -Lines: 56 - -I've also found out, that DBD::Oracle does not support type SQL_REF: -When not using DBD::Proxy I get: - - SQL type 20 for ':p1' is not fully supported, - bound as SQL_VARCHAR instead - -I even get segmentation faults when trying to fetch REF columns. :-( - -Any ideas? - -> Hi, -> -> I'm trying to bind a perl variable to an Oracle table reference with -> Oracle 9.2.0.3, DBD::Proxy and Perl::DBI 1.37 without success. I -> could'nt find help on this in the docs or list archives. I hope this is -> the right place to post. -> -> In SQL*Plus: -> -> SQL> desc getReference -> FUNCTION getReference RETURNS REF OF TABLETYPE -> -> SQL> select getReference() from dual; -> -> GETREFERENCE() -> ---------------------------------------------------------------------- -> 0000280209C229D2216EF6A5F4E030010A8D086AD3C204FC6EE0E46501E030010A8D08 -> 2CE703C0000E0000 -> -> -> My code: -> -> my $ref = undef; -> my $sth = $dbh->prepare('BEGIN ? := getReference(); END;'); -> $sth->bind_param_inout(1, \$ref, 128, SQL_REF ); -> $sth->execute(); -> -> yields: -> -> PLS-00382: expression is of wrong type -> -> -> Even fetching a reference does not work: -> -> my $sth = $dbh->prepare('SELECT getReference() FROM DUAL'); -> $sth->execute(); -> ($ref) = $sth->fetchrow_array(); -> -> yields undef in $ref. -> -> I'd very much appreciate your help. -> cheers, -> Hendrik - - - - diff --git a/err_unsorted/err_refcsr_rowcache.msg b/err_unsorted/err_refcsr_rowcache.msg deleted file mode 100644 index 5101d2ae..00000000 --- a/err_unsorted/err_refcsr_rowcache.msg +++ /dev/null @@ -1,85 +0,0 @@ -From dbi-users-bounce@isc.org Tue May 16 22:53:12 2000 -Return-Path: -Received: from oink by toad.ig.co.uk (SMI-8.6/SMI-SVR4) - id WAA29547; Tue, 16 May 2000 22:53:11 +0100 -Received: from finch-punt-12.mail.demon.net by oink with SMTP (PP) - id <04730-2@oink>; Sat, 16 May 1970 22:51:48 +0100 -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk - id 958512876:10:15786:0; Tue, 16 May 2000 21:34:36 GMT -Received: from pub3.rc.vix.com ([204.152.186.34]) by punt-1.mail.demon.net - id aa1122388; 16 May 2000 21:33 GMT -Received: from pub3.rc.vix.com (pub3.rc.vix.com [204.152.186.34]) - by pub3.rc.vix.com (Postfix) with ESMTP id 661E53EC8; - Tue, 16 May 2000 14:33:38 -0700 (PDT) -Received: with LISTAR (v0.129a; list dbi-users); - Tue, 16 May 2000 14:28:31 -0700 (PDT) -Received: from isrv3.isc.org (isrv3.isc.org [204.152.184.87]) - by pub3.rc.vix.com (Postfix) with ESMTP id 7192F3E20 - for ; - Tue, 16 May 2000 14:28:27 -0700 (PDT) -Received: from anchor-post-34.mail.demon.net (anchor-post-34.mail.demon.net [194.217.242.92]) - by isrv3.isc.org (8.9.1/8.9.1) via ESMTP id OAA27204 - for ; - Tue, 16 May 2000 14:28:26 -0700 (PDT) env-from (Tim.Bunce@ig.co.uk) -Received: from ignite.demon.co.uk ([158.152.8.99] helo=oink) - by anchor-post-34.mail.demon.net with smtp (Exim 2.12 #1) - id 12rot7-000Mp4-0Y; Tue, 16 May 2000 22:28:25 +0100 -Received: from toad by oink with SMTP (PP) id <04650-0@oink>; - Sat, 16 May 1970 22:23:55 +0100 -Received: by toad.ig.co.uk (SMI-8.6/SMI-SVR4) id WAA29289; - Tue, 16 May 2000 22:23:50 +0100 -Date: Tue, 16 May 2000 22:23:50 +0100 -From: Tim Bunce -To: peter_dev@talk21.com -Cc: dbi-users@isc.org -Subject: Re: Oracle Stored Procs take longer than embedded SQL -Message-ID: <20000516222350.F28435@ig.co.uk> -References: <20000516174946.QLKD22548.t21mta02-app.talk21.com@t21mtaV-lrs> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -X-Mailer: Mutt 0.95.3i -In-Reply-To: <20000516174946.QLKD22548.t21mta02-app.talk21.com@t21mtaV-lrs>; from peter_dev@talk21.com on Tue, May 16, 2000 at 06:48:22PM +0100 -Organization: Paul Ingram Group, Software Systems, +44 1 483 862800 -Sender: dbi-users-bounce@isc.org -Errors-To: dbi-users-bounce@isc.org -X-original-sender: Tim.Bunce@ig.co.uk -Precedence: bulk -List-unsubscribe: -X-List-ID: -List-owner: -List-post: -Status: RO -Content-Length: 1372 -Lines: 30 - -On Tue, May 16, 2000 at 06:48:22PM +0100, peter_dev@talk21.com wrote: -> I have a problem with the fetching of data from an Oracle Ref Cursor taking longer than the same query in Embeded SQL. -> -> $ get_sp.pl -> Fetched in 0.00774896144866943 seconds -> Completed in 0.106827020645142 seconds -> -> $ get_sql.pl -> Fetched in 0.00138604640960693 seconds -> Completed in 0.380790948867798 seconds -> -> In this example (Using the SCOTT/TIGER tables), while the Stored Procedure completed first, the actual fetch of the data took considerably longer. In a real situation (e.g. bigger tables ), this is easily the longest part of the task and causes the overall execution time to increase hugely. -> -> Any Help would be appreciated -> thanks - -Possibly related to the lack of a row cache on that statement handle. -You, or some kind volunteer, could probably hack that in without too -much work. - -Tim. - - ------------------------------------------------------------------------------- -DBI HOME PAGE AND ARCHIVES: http://www.symbolstone.org/technology/perl/DBI/ -To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html -If you are without web access, or if you are having trouble with the web page, -please send mail to dbi-users-request@isc.org with the subject line of: -'unsubscribe'. ------------------------------------------------------------------------------- - diff --git a/err_unsorted/err_refcsr_slow.msg b/err_unsorted/err_refcsr_slow.msg deleted file mode 100644 index 790d267d..00000000 --- a/err_unsorted/err_refcsr_slow.msg +++ /dev/null @@ -1,347 +0,0 @@ -From dbi-users-return-11175-Tim.Bunce=pobox.com@perl.org Mon Apr 29 23:12:51 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3TMCpR17212 - for ; Mon, 29 Apr 2002 23:12:51 +0100 (BST) - (envelope-from dbi-users-return-11175-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.22] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Mon, 29 Apr 2002 23:12:51 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020117986:10:17770:92; Mon, 29 Apr 2002 22:06:26 GMT -Received: from wormwood.pobox.com ([208.210.125.20]) by punt-1.mail.demon.net - id aa1017591; 29 Apr 2002 22:06 GMT -Received: from wormwood.pobox.com (localhost.pobox.com [127.0.0.1]) - by wormwood.pobox.com (Postfix) with ESMTP id 975037274A - for ; Mon, 29 Apr 2002 18:01:37 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) - by wormwood.pobox.com (Postfix) with SMTP id ED2897273F - for ; Mon, 29 Apr 2002 18:01:34 -0400 (EDT) -Received: (qmail 70462 invoked by uid 1005); 29 Apr 2002 21:59:33 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 20335 invoked by uid 76); 29 Apr 2002 20:18:55 -0000 -Message-ID: <20020429201853.52283.qmail@web10007.mail.yahoo.com> -Date: Mon, 29 Apr 2002 13:18:53 -0700 (PDT) -From: Calin Medianu -Reply-To: cmedianu@sfu.ca -Subject: DBD::Oracle Slow cursors -To: dbi-users@perl.org -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Status: RO -X-Status: A -Content-Length: 568 -Lines: 21 - -Hello, - -I did the following. Wrote a perl script that retreves -data via a straight select from the database. Then I -wrote a stored procedure returning a ref cursor open -on the same select statement and retrieved the data as -well. Using the REF CURSOR/ sotred procedure was about -3 time slower, that is 40 seconds instead of around -10. - -Is this normal? Is this a problem with oracle or with -DBD::Oracle? - -Thanks, - -Calin Medianu - -__________________________________________________ -Do You Yahoo!? -Yahoo! Health - your guide to health and wellness -http://health.yahoo.com - -From dbi-users-return-11177-Tim.Bunce=pobox.com@perl.org Tue Apr 30 00:06:36 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3TN6aR17980 - for ; Tue, 30 Apr 2002 00:06:36 +0100 (BST) - (envelope-from dbi-users-return-11177-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 30 Apr 2002 00:06:36 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020119533:20:05733:4; Mon, 29 Apr 2002 22:32:13 GMT -Received: from cali-1.pobox.com ([64.71.166.114]) by punt-2.mail.demon.net - id aa2005393; 29 Apr 2002 22:32 GMT -Received: from cali-1.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-1.pobox.com (Postfix) with ESMTP id 4E6B73E6BF - for ; Mon, 29 Apr 2002 18:32:00 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) - by cali-1.pobox.com (Postfix) with SMTP id BF79C3E6A0 - for ; Mon, 29 Apr 2002 18:31:59 -0400 (EDT) -Received: (qmail 87860 invoked by uid 1005); 29 Apr 2002 22:31:59 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Received: (qmail 87844 invoked by uid 76); 29 Apr 2002 22:31:58 -0000 -Received: from mail01.svc.cra.dublin.eircom.net (HELO mail01.svc.cra.dublin.eircom.net) (159.134.118.17) - by onion.perl.org (qpsmtpd/0.07) with SMTP; Mon Apr 29 22:31:58 2002 -0000 -Received: (qmail 21911 messnum 119827 invoked from network[159.134.167.97/p865.as1.limerick1.eircom.net]); 29 Apr 2002 22:31:29 -0000 -Received: from p865.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.167.97) - by mail01.svc.cra.dublin.eircom.net (qp 21911) with SMTP; 29 Apr 2002 22:31:29 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g3TMVcR17579; - Mon, 29 Apr 2002 23:31:38 +0100 (BST) - (envelope-from timbo) -Date: Mon, 29 Apr 2002 23:31:38 +0100 -From: Tim Bunce -To: cmedianu@sfu.ca -Cc: dbi-users@perl.org -Subject: Re: DBD::Oracle Slow cursors -Message-ID: <20020429233138.E16831@dansat.data-plan.com> -References: <20020429201853.52283.qmail@web10007.mail.yahoo.com> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.2.5i -In-Reply-To: <20020429201853.52283.qmail@web10007.mail.yahoo.com>; from calinm@yahoo.com on Mon, Apr 29, 2002 at 01:18:53PM -0700 -Content-Length: 651 -Lines: 20 - -On Mon, Apr 29, 2002 at 01:18:53PM -0700, Calin Medianu wrote: -> Hello, -> -> I did the following. Wrote a perl script that retreves -> data via a straight select from the database. Then I -> wrote a stored procedure returning a ref cursor open -> on the same select statement and retrieved the data as -> well. Using the REF CURSOR/ sotred procedure was about -> 3 time slower, that is 40 seconds instead of around -> 10. -> -> Is this normal? Is this a problem with oracle or with -> DBD::Oracle? - -DBD::Oracle. It probably isn't setting up a row cache for the ref cursor. - -Get a level 3 trace and look for the "dbd_describe'd" line for the -ref cursor. - -Tim. - -From calinm@yahoo.com Tue Apr 30 22:02:56 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3UL2tR26878 - for ; Tue, 30 Apr 2002 22:02:55 +0100 (BST) - (envelope-from calinm@yahoo.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 30 Apr 2002 22:02:55 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020198219:10:21718:114; Tue, 30 Apr 2002 20:23:39 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1101732; 30 Apr 2002 20:23 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id C6B4A2BFB4 - for ; Tue, 30 Apr 2002 16:23:25 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from web10004.mail.yahoo.com (web10004.mail.yahoo.com [216.136.130.40]) - by dolly1.pobox.com (Postfix) with SMTP id 527BD2BF3D - for ; Tue, 30 Apr 2002 16:23:25 -0400 (EDT) -Message-ID: <20020430202321.54825.qmail@web10004.mail.yahoo.com> -Received: from [213.157.171.169] by web10004.mail.yahoo.com via HTTP; Tue, 30 Apr 2002 13:23:20 PDT -Date: Tue, 30 Apr 2002 13:23:20 -0700 (PDT) -From: Calin Medianu -Subject: Re: DBD::Oracle Slow cursors -To: Tim Bunce -Cc: dbi-users@perl.org -In-Reply-To: <20020430140517.P16831@dansat.data-plan.com> -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Status: RO -X-Status: A -Content-Length: 425 -Lines: 18 - -I "Solved" the problem. For Now.. I did -perl Makefile.PL -8 - -hoping that the buggy code would be recently added, -and it was. Now both the select and the cursor return -the data at the same speed, meaning fast.. - -Am I am missing much by not using the code for Oracle -8? - -Thanks, - -Calin - -__________________________________________________ -Do You Yahoo!? -Yahoo! Health - your guide to health and wellness -http://health.yahoo.com - -From timbo@dansat.data-plan.com Wed May 1 16:49:55 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g41FnsR33994 - for ; Wed, 1 May 2002 16:49:54 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.22] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 01 May 2002 16:49:54 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020265865:20:10671:66; Wed, 01 May 2002 15:11:05 GMT -Received: from silk.pobox.com ([208.210.125.70]) by punt-2.mail.demon.net - id aa2122069; 1 May 2002 15:10 GMT -Received: from cali-3.pobox.com (cali-3.pobox.com [64.71.166.116]) - by silk.pobox.com (Postfix) with ESMTP id F29CC3FDF2 - for ; Wed, 1 May 2002 11:09:52 -0400 (EDT) -Received: from cali-3.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-3.pobox.com (Postfix) with ESMTP id E3A943E689 - for ; Wed, 1 May 2002 10:57:15 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail03.svc.cra.dublin.eircom.net (mail03.svc.cra.dublin.eircom.net [159.134.118.19]) - by cali-3.pobox.com (Postfix) with SMTP id D1F523E688 - for ; Wed, 1 May 2002 10:57:14 -0400 (EDT) -Received: (qmail 96042 messnum 564683 invoked from network[159.134.166.63/p575.as1.limerick1.eircom.net]); 1 May 2002 14:57:13 -0000 -Received: from p575.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.166.63) - by mail03.svc.cra.dublin.eircom.net (qp 96042) with SMTP; 1 May 2002 14:57:13 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g41EvIh33626; - Wed, 1 May 2002 15:57:18 +0100 (BST) - (envelope-from timbo) -Date: Wed, 1 May 2002 15:57:18 +0100 -From: Tim Bunce -To: Calin Medianu -Cc: Tim Bunce -Subject: Re: DBD::Oracle Slow cursors -Message-ID: <20020501155718.S16831@dansat.data-plan.com> -References: <20020430151126.Q16831@dansat.data-plan.com> <20020430183429.33340.qmail@web10005.mail.yahoo.com> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.2.5i -In-Reply-To: <20020430183429.33340.qmail@web10005.mail.yahoo.com>; from calinm@yahoo.com on Tue, Apr 30, 2002 at 11:34:29AM -0700 -Status: RO -Content-Length: 3111 -Lines: 111 - -Thanks. I'll take a look when I get to DBD::Oracle again. - -I think the last row of that table applies and it doesn't refer to OCIBindObject(): - REF CURSOR variables - SQLT_RSET - Allocate a statement handle, OCIStmt, and then bind its address - (OCIStmt **) using the SQLT_RSET datatype. -Note that SQLT_REF isn't the same as SQLT_RSET. - -You could always try patching it yourself! - -Tim. - - -On Tue, Apr 30, 2002 at 11:34:29AM -0700, Calin Medianu wrote: -> It says here: -> http://technet.oracle.com/doc/oracle8i_816/appdev.816/a76975/oci05bnd.htm#421007 -> -> that 2 calls are neede to bind a ref , the second is -> to OCIBindObject() which I don't see in dbdimp.c. -> -> Could this be a reason? -> -> Cheers, -> -> Calin -> -> --- Tim Bunce wrote: -> > On Tue, Apr 30, 2002 at 04:04:47PM +0300, Calin -> > Medianu wrote: -> > > Me again with the slow cursors. -> > > -> > > I modified both queries to only return 10 rows. -> > > I ran a sniffer (ethereal) on the NIC. It is -> > pretty cool, it also decodes TNS. -> > > -> > > when I am using the SQL, it works like this, there -> > are about 7 packets -> > > received by my workstation to set up the session, -> > then all 10 rows are in the -> > > same packet, then there is another packet probably -> > saying goodbye. -> > > -> > > When I am using the REF cursor, each row comes in -> > it's own TNS packet, that -> > > is why it is so slow! -> > > -> > > Any idea how to fix it? -> > -> > Do a level 9 trace to get a log of the OCI calls and -> > confirm that -> > the fragment I posted is being called (may be -> > helpful to also -> > add an extra print statement into that code since -> > parsing the -> > OCI trace can be painful). -> > -> > Assuming the code is being called then as far as I -> > can see the code is -> > doing the right thing and it's probably an Oracle -> > OCI issue. -> > -> > You'd need to talk to Oracle support. No need to -> > mention perl etc. -> > Just talk about your OCI application and provide the -> > OCI call trace. -> > -> > Let me know what you find out! -> > -> > Tim. -> > -> > > thanks a lot, -> > > -> > > Calin -> > > -> > > > On Mon, Apr 29, 2002 at 01:18:53PM -0700, Calin -> > Medianu wrote: -> > > > > Hello, -> > > > > -> > > > > I did the following. Wrote a perl script that -> > retreves -> > > > > data via a straight select from the database. -> > Then I -> > > > > wrote a stored procedure returning a ref -> > cursor open -> > > > > on the same select statement and retrieved the -> > data as -> > > > > well. Using the REF CURSOR/ sotred procedure -> > was about -> > > > > 3 time slower, that is 40 seconds instead of -> > around -> > > > > 10. -> > > > > -> > > > > Is this normal? Is this a problem with oracle -> > or with -> > > > > DBD::Oracle? -> > > > -> > > > DBD::Oracle. It probably isn't setting up a row -> > cache for the ref cursor. -> > > > -> > > > Get a level 3 trace and look for the -> > "dbd_describe'd" line for the -> > > > ref cursor. -> > > > -> > > > Tim. -> -> -> __________________________________________________ -> Do You Yahoo!? -> Yahoo! Health - your guide to health and wellness -> http://health.yahoo.com - diff --git a/err_unsorted/err_slowcsr.msg b/err_unsorted/err_slowcsr.msg deleted file mode 100644 index 80c43350..00000000 --- a/err_unsorted/err_slowcsr.msg +++ /dev/null @@ -1,316 +0,0 @@ -From calinm@yahoo.com Tue Apr 30 22:03:11 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3UL3AR27018 - for ; Tue, 30 Apr 2002 22:03:10 +0100 (BST) - (envelope-from calinm@yahoo.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Tue, 30 Apr 2002 22:03:10 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020196981:10:23493:39; Tue, 30 Apr 2002 20:03:01 GMT -Received: from silk.pobox.com ([208.210.125.70]) by punt-1.mail.demon.net - id aa1108477; 30 Apr 2002 20:02 GMT -Received: from dolly1.pobox.com (dolly1.pobox.com [207.106.49.22]) - by silk.pobox.com (Postfix) with ESMTP id 915563FCE8 - for ; Tue, 30 Apr 2002 14:35:38 -0400 (EDT) -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 343702BFDD - for ; Tue, 30 Apr 2002 14:34:38 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from web10005.mail.yahoo.com (web10005.mail.yahoo.com [216.136.130.41]) - by dolly1.pobox.com (Postfix) with SMTP id 6AA822BFA3 - for ; Tue, 30 Apr 2002 14:34:37 -0400 (EDT) -Message-ID: <20020430183429.33340.qmail@web10005.mail.yahoo.com> -Received: from [213.157.171.169] by web10005.mail.yahoo.com via HTTP; Tue, 30 Apr 2002 11:34:29 PDT -Date: Tue, 30 Apr 2002 11:34:29 -0700 (PDT) -From: Calin Medianu -Subject: Re: DBD::Oracle Slow cursors -To: Tim Bunce -In-Reply-To: <20020430151126.Q16831@dansat.data-plan.com> -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Status: RO -X-Status: A -Content-Length: 2457 -Lines: 96 - -It says here: -http://technet.oracle.com/doc/oracle8i_816/appdev.816/a76975/oci05bnd.htm#421007 - -that 2 calls are neede to bind a ref , the second is -to OCIBindObject() which I don't see in dbdimp.c. - -Could this be a reason? - -Cheers, - -Calin - ---- Tim Bunce wrote: -> On Tue, Apr 30, 2002 at 04:04:47PM +0300, Calin -> Medianu wrote: -> > Me again with the slow cursors. -> > -> > I modified both queries to only return 10 rows. -> > I ran a sniffer (ethereal) on the NIC. It is -> pretty cool, it also decodes TNS. -> > -> > when I am using the SQL, it works like this, there -> are about 7 packets -> > received by my workstation to set up the session, -> then all 10 rows are in the -> > same packet, then there is another packet probably -> saying goodbye. -> > -> > When I am using the REF cursor, each row comes in -> it's own TNS packet, that -> > is why it is so slow! -> > -> > Any idea how to fix it? -> -> Do a level 9 trace to get a log of the OCI calls and -> confirm that -> the fragment I posted is being called (may be -> helpful to also -> add an extra print statement into that code since -> parsing the -> OCI trace can be painful). -> -> Assuming the code is being called then as far as I -> can see the code is -> doing the right thing and it's probably an Oracle -> OCI issue. -> -> You'd need to talk to Oracle support. No need to -> mention perl etc. -> Just talk about your OCI application and provide the -> OCI call trace. -> -> Let me know what you find out! -> -> Tim. -> -> > thanks a lot, -> > -> > Calin -> > -> > > On Mon, Apr 29, 2002 at 01:18:53PM -0700, Calin -> Medianu wrote: -> > > > Hello, -> > > > -> > > > I did the following. Wrote a perl script that -> retreves -> > > > data via a straight select from the database. -> Then I -> > > > wrote a stored procedure returning a ref -> cursor open -> > > > on the same select statement and retrieved the -> data as -> > > > well. Using the REF CURSOR/ sotred procedure -> was about -> > > > 3 time slower, that is 40 seconds instead of -> around -> > > > 10. -> > > > -> > > > Is this normal? Is this a problem with oracle -> or with -> > > > DBD::Oracle? -> > > -> > > DBD::Oracle. It probably isn't setting up a row -> cache for the ref cursor. -> > > -> > > Get a level 3 trace and look for the -> "dbd_describe'd" line for the -> > > ref cursor. -> > > -> > > Tim. - - -__________________________________________________ -Do You Yahoo!? -Yahoo! Health - your guide to health and wellness -http://health.yahoo.com - -From calinm@yahoo.com Fri May 3 13:48:06 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g43Cm5R50489 - for ; Fri, 3 May 2002 13:48:05 +0100 (BST) - (envelope-from calinm@yahoo.com) -Received: from pop3.mail.demon.net [194.217.242.59] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 03 May 2002 13:48:05 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020429421:10:02019:143; Fri, 03 May 2002 12:37:01 GMT -Received: from wormwood.pobox.com ([208.210.125.20]) by punt-1.mail.demon.net - id aa1123562; 3 May 2002 12:36 GMT -Received: from wormwood.pobox.com (localhost.pobox.com [127.0.0.1]) - by wormwood.pobox.com (Postfix) with ESMTP id D7BD1725A1 - for ; Fri, 3 May 2002 08:36:41 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from web10008.mail.yahoo.com (web10008.mail.yahoo.com [216.136.130.44]) - by wormwood.pobox.com (Postfix) with SMTP id 3088772674 - for ; Fri, 3 May 2002 08:36:41 -0400 (EDT) -Message-ID: <20020503123640.19648.qmail@web10008.mail.yahoo.com> -Received: from [213.157.171.169] by web10008.mail.yahoo.com via HTTP; Fri, 03 May 2002 05:36:40 PDT -Date: Fri, 3 May 2002 05:36:40 -0700 (PDT) -From: Calin Medianu -Subject: Re: DBD::Oracle Slow cursors -To: Tim Bunce -In-Reply-To: <20020501155718.S16831@dansat.data-plan.com> -MIME-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Status: RO -Content-Length: 3619 -Lines: 150 - -Sure, - -I'll give it a try next week. - -Cheers, - -Calin ---- Tim Bunce wrote: -> Thanks. I'll take a look when I get to DBD::Oracle -> again. -> -> I think the last row of that table applies and it -> doesn't refer to OCIBindObject(): -> REF CURSOR variables -> SQLT_RSET -> Allocate a statement handle, OCIStmt, and then -> bind its address -> (OCIStmt **) using the SQLT_RSET datatype. -> Note that SQLT_REF isn't the same as SQLT_RSET. -> -> You could always try patching it yourself! -> -> Tim. -> -> -> On Tue, Apr 30, 2002 at 11:34:29AM -0700, Calin -> Medianu wrote: -> > It says here: -> > -> -http://technet.oracle.com/doc/oracle8i_816/appdev.816/a76975/oci05bnd.htm#421007 -> > -> > that 2 calls are neede to bind a ref , the second -> is -> > to OCIBindObject() which I don't see in dbdimp.c. -> > -> > Could this be a reason? -> > -> > Cheers, -> > -> > Calin -> > -> > --- Tim Bunce wrote: -> > > On Tue, Apr 30, 2002 at 04:04:47PM +0300, Calin -> > > Medianu wrote: -> > > > Me again with the slow cursors. -> > > > -> > > > I modified both queries to only return 10 -> rows. -> > > > I ran a sniffer (ethereal) on the NIC. It is -> > > pretty cool, it also decodes TNS. -> > > > -> > > > when I am using the SQL, it works like this, -> there -> > > are about 7 packets -> > > > received by my workstation to set up the -> session, -> > > then all 10 rows are in the -> > > > same packet, then there is another packet -> probably -> > > saying goodbye. -> > > > -> > > > When I am using the REF cursor, each row comes -> in -> > > it's own TNS packet, that -> > > > is why it is so slow! -> > > > -> > > > Any idea how to fix it? -> > > -> > > Do a level 9 trace to get a log of the OCI calls -> and -> > > confirm that -> > > the fragment I posted is being called (may be -> > > helpful to also -> > > add an extra print statement into that code -> since -> > > parsing the -> > > OCI trace can be painful). -> > > -> > > Assuming the code is being called then as far as -> I -> > > can see the code is -> > > doing the right thing and it's probably an -> Oracle -> > > OCI issue. -> > > -> > > You'd need to talk to Oracle support. No need to -> > > mention perl etc. -> > > Just talk about your OCI application and provide -> the -> > > OCI call trace. -> > > -> > > Let me know what you find out! -> > > -> > > Tim. -> > > -> > > > thanks a lot, -> > > > -> > > > Calin -> > > > -> > > > > On Mon, Apr 29, 2002 at 01:18:53PM -0700, -> Calin -> > > Medianu wrote: -> > > > > > Hello, -> > > > > > -> > > > > > I did the following. Wrote a perl script -> that -> > > retreves -> > > > > > data via a straight select from the -> database. -> > > Then I -> > > > > > wrote a stored procedure returning a ref -> > > cursor open -> > > > > > on the same select statement and retrieved -> the -> > > data as -> > > > > > well. Using the REF CURSOR/ sotred -> procedure -> > > was about -> > > > > > 3 time slower, that is 40 seconds instead -> of -> > > around -> > > > > > 10. -> > > > > > -> > > > > > Is this normal? Is this a problem with -> oracle -> > > or with -> > > > > > DBD::Oracle? -> > > > > -> > > > > DBD::Oracle. It probably isn't setting up a -> row -> > > cache for the ref cursor. -> > > > > -> > > > > Get a level 3 trace and look for the -> > > "dbd_describe'd" line for the -> > > > > ref cursor. -> > > > > -> > > > > Tim. -> > -> > -> > __________________________________________________ -> > Do You Yahoo!? -> > Yahoo! Health - your guide to health and wellness -> > http://health.yahoo.com - - -__________________________________________________ -Do You Yahoo!? -Yahoo! Health - your guide to health and wellness -http://health.yahoo.com - diff --git a/err_unsorted/err_svrparse.msg b/err_unsorted/err_svrparse.msg deleted file mode 100644 index 16886ca8..00000000 --- a/err_unsorted/err_svrparse.msg +++ /dev/null @@ -1,4717 +0,0 @@ -From cary.millsap@hotsos.com Thu Sep 12 23:38:20 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8CMbgC02618 - for ; Thu, 12 Sep 2002 23:38:03 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.22] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 12 Sep 2002 23:38:03 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031869308:20:16258:30; Thu, 12 Sep 2002 22:21:48 GMT -Received: from cali-3.pobox.com ([64.71.166.116]) by punt-2.mail.demon.net - id aa2108888; 12 Sep 2002 22:21 GMT -Received: from cali-3.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-3.pobox.com (Postfix) with ESMTP id A32132F05C9 - for ; Thu, 12 Sep 2002 18:21:34 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by cali-3.pobox.com (Postfix) with ESMTP id D71F62F056D - for ; Thu, 12 Sep 2002 18:21:31 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8CMLQn17849; - Thu, 12 Sep 2002 17:21:26 -0500 -From: "Cary Millsap" -To: -Subject: -Date: Thu, 12 Sep 2002 17:21:17 -0500 -Message-ID: <016901c25aaa$ba287930$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: multipart/mixed; - boundary="----=_NextPart_000_016A_01C25A80.D1527130" -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 64884 -Lines: 2025 - -This is a multi-part message in MIME format. - -------=_NextPart_000_016A_01C25A80.D1527130 -Content-Type: multipart/alternative; - boundary="----=_NextPart_001_016B_01C25A80.D1557E70" - - -------=_NextPart_001_016B_01C25A80.D1557E70 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit - -Tim, - - - -How are you doing? I hope you've had a good two years since I saw you on -the Oracle Geek Cruise event. - - - -I've been working on a project this year to construct a book about -optimizing Oracle response time. In my research, I've discovered -something about the DBI that I didn't expect: it executes two Oracle -parse calls for every one that I would expect an efficient DBI layer to -make. I've included my Perl source (below), the Oracle level-12 trace -data that shows the sequence of calls it's receiving from the Perl -application (below), a level-9 DBI trace from the application -(attached), and our version information (below). - - - -The reason I'm bringing this to your attention in this way is that I'm -relying pretty heavily upon Perl for performance measurement tools, -examples, and simulators in the text. I love the language and I want for -the book to be an encouragement for more people to use Perl. However, -this extra-parse behavior is one of the things that the book highlights -as an important scalability barrier (some other tools do it too, -unfortunately). Of course, this is a speed bump on the road to my goal -of helping to promote Perl. - - - -I was hoping that by showing you this specific data, you could make the -problem go away. - - - -Cary Millsap -Hotsos Enterprises, Ltd. -http://www.hotsos.com - -Upcoming events: -- Hotsos Clinic , Oct 1-3 San -Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu -- 2003 Hotsos Symposium on -OracleR System Performance, Feb 9-12 Dallas -- Next event: Miracle Database Forum , Sep -20-22 Middlefart Denmark - -Listing [listing.sqltrace.pl]: a simple application that executes a -database query - -#!/usr/bin/perl - - - - - -# $Header: /home/cvs/cvm-book1/sqltrace/ex1.pl,v 1.2 2002/09/12 21:10:25 -cvm Exp $ - -# Cary Millsap (cary.millsap@hotsos.com) - - - - - -use strict; - -use warnings; - -use DBI; - -use DBD::Oracle; - -use Getopt::Long; - -use Term::ReadKey; - - - - - -my $sth; # Oracle statement handle - -my $hostname = ""; - -my $username = "/"; - -my $password = ""; - -my $logfile = "ex1.log"; - -my %attr = ( - - RaiseError => 1, - - AutoCommit => 0, - -); - -my %opt = ( - - pause => 0, - -); - - - - - -# Get command line options and arguments. - -GetOptions( - - "pause" => \$opt{pause}, - -); - -my $key = 37; # default query value - -$key = $ARGV[0] if $ARGV[0]; - - - - - -# Connect to Oracle. - -my $dbh = DBI->connect("dbi:Oracle:$hostname", $username, $password, -\%attr); - -$dbh->trace(9, $logfile); - - - - - -# Activate tracing. - -$sth = $dbh->prepare(q(alter session set events '10046 trace name -context forever, level 12')); - -$sth->execute; - - - - - -# Allow the user to find the Oracle session and activate OS diagnostic - -# tools like strace(1) or lsof(8). - -if ($opt{pause}) { - - print "Press any key to continue..."; - - 1 while not defined (my $k = ReadKey(-1)); - - print "\n"; - -} - - - - - -# Execute the query to trace. - -$sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); - -$sth->execute($key); - - - - - -# Print output header. - -my @cdefs = qw(%8d %8d %32s); # column definitions - -my @hdefs = qw(Key Fkey Value); # column headings - -my $bformat = join(" ", @cdefs) . "\n"; - -my $hformat; ($hformat = $bformat) =~ s/%(\d*)\S+/%$1s/g; - -printf $hformat, @hdefs; - -printf $hformat, do { my @h; push @h, "-" x (/(\d+)/?$1:10) for @cdefs; -@h }; - - - - - -# Print query results. - -for my $row (@{$sth->fetchall_arrayref}) { - - printf $bformat, @$row; - -} - - - - - -# Allow the user to do final OS diagnostic stuff. - -if ($opt{pause}) { - - print "Press any key to continue..."; - - 1 while not defined (my $k = ReadKey(-1)); - - print "\n"; - -} - - - - - -# Disconnect from Oracle. - -$dbh->disconnect; - - - - - -Listing [listing:sqltrace.trc]: raw SQL trace output for an execution of -our program - -/usr/local/oracle/admin/V816/udump/ora_17349.trc - -Oracle8i Enterprise Edition Release 8.1.6.1.0 - Production - -With the Partitioning option - -JServer Release 8.1.6.0.0 - Production - -ORACLE_HOME = /usr/local/oracle/product/8.1.6 - -System name: Linux - -Node name: www.hotsos.com - -Release: 2.2.16-22enterprise - -Version: #1 SMP Tue Aug 22 16:29:32 EDT 2000 - -Machine: i686 - -Instance name: V816 - -Redo thread mounted by this instance: 1 - -Oracle process number: 8 - -Unix process pid: 17349, image: oracle@www.hotsos.com (TNS V1-V3) - - - -*** SESSION ID:(7.9) 2002-09-12 16:14:01.582 - -===================== - -PARSING IN CURSOR #1 len=69 dep=0 uid=12 oct=42 lid=12 tim=107309054 -hv=1509700594 ad='54af5e14' - -alter session set events '10046 trace name context forever, level 12' - -END OF STMT - -EXEC #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107309054 - -WAIT #1: nam='SQL*Net message to client' ela= 0 p1=1650815232 p2=1 p3=0 - -*** 2002-09-12 16:14:31.226 - -WAIT #1: nam='SQL*Net message from client' ela= 2964 p1=1650815232 p2=1 -p3=0 - -===================== - -PARSING IN CURSOR #2 len=44 dep=0 uid=12 oct=3 lid=12 tim=107312018 -hv=1997601641 ad='54af1384' - -select key, fkey, value from t where key=:p1 - -END OF STMT - -PARSE #2:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312018 - -WAIT #2: nam='SQL*Net message to client' ela= 0 p1=1650815232 p2=1 p3=0 - -WAIT #2: nam='SQL*Net message from client' ela= 0 p1=1650815232 p2=1 -p3=0 - -===================== - -PARSING IN CURSOR #1 len=44 dep=0 uid=12 oct=3 lid=12 tim=107312019 -hv=1997601641 ad='54af1384' - -select key, fkey, value from t where key=:p1 - -END OF STMT - -PARSE #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312019 - -BINDS #1: - - bind 0: dty=1 mxl=32(04) mal=00 scl=00 pre=00 oacflg=25 oacfl2=10 -size=32 offset=0 - - bfp=0940e7f0 bln=32 avl=04 flg=05 - - value="8542" - -EXEC #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312019 - -WAIT #1: nam='SQL*Net message to client' ela= 0 p1=1650815232 p2=1 p3=0 - -WAIT #1: nam='file open' ela= 0 p1=0 p2=0 p3=0 - -WAIT #1: nam='db file sequential read' ela= 0 p1=1 p2=6671 p3=1 - -WAIT #1: nam='db file sequential read' ela= 0 p1=1 p2=6678 p3=1 - -FETCH #1:c=0,e=0,p=2,cr=3,cu=0,mis=0,r=1,dep=0,og=3,tim=107312019 - -*** 2002-09-12 16:14:56.200 - -WAIT #1: nam='SQL*Net message from client' ela= 2496 p1=1650815232 p2=1 -p3=0 - -XCTEND rlbk=0, rd_only=1 - -STAT #1 id=1 cnt=1 pid=0 pos=0 obj=5156 op='TABLE ACCESS BY INDEX ROWID -T ' - -STAT #1 id=2 cnt=2 pid=1 pos=1 obj=5157 op='INDEX UNIQUE SCAN ' - - - - - -$ perl -V - -Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: - - Platform: - - osname=linux, osvers=2.2.5-22smp, archname=i386-linux - - uname='linux porky.devel.redhat.com 2.2.5-22smp #1 smp wed jun 2 -09:11:51 edt 1999 i686 unknown ' - - config_args='-des -Doptimize=-O2 -march=i386 -mcpu=i686 -Dcc=gcc --Dcccdlflags=-fPIC -Dinstallprefix=/usr -Dprefix=/usr --Darchname=i386-linux -Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm --Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Uuselargefiles' - - hint=recommended, useposix=true, d_sigaction=define - - usethreads=undef use5005threads=undef useithreads=undef -usemultiplicity=undef - - useperlio=undef d_sfio=undef uselargefiles=undef - - use64bitint=undef use64bitall=undef uselongdouble=undef -usesocks=undef - - Compiler: - - cc='gcc', optimize='-O2 -march=i386 -mcpu=i686', gccversion=2.96 -20000731 (experimental) - - cppflags='-fno-strict-aliasing' - - ccflags ='-fno-strict-aliasing' - - stdchar='char', d_stdstdio=define, usevfork=false - - intsize=4, longsize=4, ptrsize=4, doublesize=8 - - d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 - - ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', -lseeksize=4 - - alignbytes=4, usemymalloc=n, prototype=define - - Linker and Libraries: - - ld='gcc', ldflags =' -L/usr/local/lib' - - libpth=/usr/local/lib /lib /usr/lib - - libs=-lnsl -ldl -lm -lc -lcrypt - - libc=/lib/libc-2.1.92.so, so=so, useshrplib=false, libperl=libperl.a - - Dynamic Linking: - - dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' - - cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib' - - - - - -Characteristics of this binary (from libperl): - - Compile-time options: - - Built under linux - - Compiled at Aug 7 2000 10:59:51 - - @INC: - - /usr/lib/perl5/5.6.0/i386-linux - - /usr/lib/perl5/5.6.0 - - /usr/lib/perl5/site_perl/5.6.0/i386-linux - - /usr/lib/perl5/site_perl/5.6.0 - - /usr/lib/perl5/site_perl - - . - - - - - -Other site information - -- Redhat Linux 7.0 - -- Oracle 8.1.6.1.0 - -- DBD-Oracle 1.12 - -- DBI 1.30 - - - - -------=_NextPart_001_016B_01C25A80.D1557E70 -Content-Type: text/html; - charset="us-ascii" -Content-Transfer-Encoding: quoted-printable - - - - - - - - - - - - - - - -
- -

Tim,

- -

 

- -

How are you doing? I hope you’ve had a good two = -years -since I saw you on the Oracle Geek Cruise event.

- -

 

- -

I’ve been working on a project this year to = -construct -a book about optimizing Oracle response time. In my research, I’ve -discovered something about the DBI that I didn’t expect: it = -executes two -Oracle parse calls for every one that I would expect an efficient DBI = -layer to -make. I’ve included my Perl source (below), the Oracle level-12 = -trace -data that shows the sequence of calls it’s receiving from the Perl = -application -(below), a level-9 DBI trace from the application (attached), and our = -version information -(below).

- -

 

- -

The reason I’m bringing this to your attention = -in this -way is that I’m relying pretty heavily upon Perl for performance -measurement tools, examples, and simulators in the text. I love the = -language -and I want for the book to be an encouragement for more people to use = -Perl. -However, this extra-parse behavior is one of the things that the book = -highlights -as an important scalability barrier (some other tools do it too, = -unfortunately). -Of course, this is a speed bump on the road to my goal of helping to = -promote Perl.

- -

 

- -

I was hoping that by showing you this specific data, = -you -could make the problem go away.

- -

 

- -

Cary = -Millsap
-Hotsos Enterprises, Ltd.
-http://www.hotsos.com
-
-Upcoming events:
-- Hotsos Clinic, = -Oct -1–3 San Francisco, Oct 15–17 = -Dallas, Dec -9–11 Honolulu
-- 2003 Hotsos = -Symposium on -Oracle® System Performance, Feb 9–12 = -Dallas
-- Next event: Miracle Database = -Forum, Sep -20–22 Middlefart Denmark

- -
- -

Listing [listing.sqltrace.pl]: a simple = -application that -executes a database query

- -
- -
- -

#!/usr/bin/perl

- -

- -

- -

 

- -

 

- -

# = -$Header: -/home/cvs/cvm-book1/sqltrace/ex1.pl,v 1.2 2002/09/12 = -21:10:25 cvm Exp $

- -

- -

# = -Cary Millsap (cary.millsap@hotsos.com)

- -

- -

 

- -

 

- -

use = -strict;

- -

- -

use = -warnings;

- -

- -

use = -DBI;

- -

- -

use = -DBD::Oracle;

- -

- -

use = -Getopt::Long;

- -

- -

use = -Term::ReadKey;

- -

- -

 

- -

 

- -

my -$sth;           &n= -bsp;        -# Oracle statement handle

- -

- -

my = -$hostname =3D -"";

- -

- -

my = -$username =3D -"/";

- -

- -

my = -$password =3D -"";

- -

- -

my = -$logfile  -=3D "ex1.log";

- -

- -

my = -%attr =3D (

- -

- -

    -RaiseError =3D> 1,

- -

- -

    -AutoCommit =3D> 0,

- -

- -

);

- -

- -

my = -%opt =3D (

- -

- -

    -pause   =3D> 0,

- -

- -

);

- -

- -

 

- -

 

- -

# Get = -command line -options and arguments.

- -

- -

GetOptions(

- -

- -

    -"pause" =3D> \$opt{pause},

- -

- -

);

- -

- -

my = -$key =3D -37;           &nbs= -p;  - # default query value

- -

- -

$key = -=3D $ARGV[0] if -$ARGV[0];

- -

- -

 

- -

 

- -

# = -Connect to -Oracle.

- -

- -

my = -$dbh =3D -DBI->connect("dbi:Oracle:$hostname", $username, $password, -\%attr);

- -

- -

$dbh->trace(9, -$logfile);

- -

- -

 

- -

 

- -

# = -Activate -tracing.

- -

- -

$sth = -=3D -$dbh->prepare(q(alter session set events '10046 trace name context = -forever, -level 12'));

- -

- -

$sth->execute;

- -

- -

 

- -

 

- -

# = -Allow the user -to find the Oracle session and activate OS diagnostic

- -

- -

# = -tools like -strace(1) or lsof(8).

- -

- -

if = -($opt{pause}) {

- -

- -

    -print "Press any key to continue...";

- -

- -

    -1 while not defined (my $k =3D ReadKey(-1));

- -

- -

    -print "\n";

- -

- -

}

- -

- -

 

- -

 

- -

# = -Execute the -query to trace.

- -

- -

$sth = -=3D -$dbh->prepare(q(select key, fkey, value from t where = -key=3D?));

- -

- -

$sth->execute($key);

- -

- -

 

- -

 

- -

# = -Print output -header.

- -

- -

my = -@cdefs =3D qw(%8d -%8d %32s);   # column definitions

- -

- -

my = -@hdefs =3D qw(Key -Fkey Value); # column headings

- -

- -

my = -$bformat =3D -join("  ", @cdefs) . "\n";

- -

- -

my = -$hformat; -($hformat =3D $bformat) =3D~ s/%(\d*)\S+/%$1s/g;

- -

- -

printf $hformat, -@hdefs;

- -

- -

printf $hformat, -do { my @h; push @h, "-" x (/(\d+)/?$1:10) for = -@cdefs; @h };

- -

- -

 

- -

 

- -

# = -Print query -results.

- -

- -

for = -my $row -(@{$sth->fetchall_arrayref}) {

- -

- -

    -printf $bformat, @$row;

- -

- -

}

- -

- -

- -

 

- -

 

- -

# = -Allow the user -to do final OS diagnostic stuff.

- -

- -

if = -($opt{pause}) {

- -

- -

    -print "Press any key to continue...";

- -

- -

    -1 while not defined (my $k =3D ReadKey(-1));

- -

- -

    -print "\n";

- -

- -

}

- -

- -

 

- -

 

- -

# = -Disconnect from -Oracle.

- -

- -

$dbh->disconnect;

- -
- -

 

- -

 

- -
- -

Listing [listing:sqltrace.trc]: raw SQL trace = -output for -an execution of our program

- -
- -
- -

/usr/local/oracle/admin/V816/udump/ora_17349.tr= -c

- -

Oracle8i Enterprise -Edition Release 8.1.6.1.0 - Production

- -

With = -the -Partitioning option

- -

JServer Release -8.1.6.0.0 - Production

- -

ORACLE_HOME =3D -/usr/local/oracle/product/8.1.6

- -

System -name:        Linux

- -

Node name:  = -www.hotsos.com

- -

Release:    = -2.2.16-22enterprise

- -

Version:    #1 -SMP Tue Aug 22 16:29:32 EDT 2000

- -

Machine:    = -i686

- -

Instance name: -V816

- -

Redo = -thread -mounted by this instance: 1

- -

Oracle process -number: 8

- -

Unix = -process pid: -17349, image: oracle@www.hotsos.com (TNS V1-V3)

- -

 

- -

*** = -SESSION -ID:(7.9) 2002-09-12 16:14:01.582

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= -=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR -#1 len=3D69 dep=3D0 uid=3D12 oct=3D42 lid=3D12 = -tim=3D107309054 hv=3D1509700594 -ad=3D'54af5e14'

- -

alter = -session set -events '10046 trace name context forever, level 12'

- -

END = -OF STMT

- -

EXEC -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -309054

- -

WAIT = -#1: -nam=3D'SQL*Net message to client' ela=3D 0 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

*** = -2002-09-12 -16:14:31.226

- -

WAIT = -#1: -nam=3D'SQL*Net message from client' ela=3D 2964 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= -=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR -#2 len=3D44 dep=3D0 uid=3D12 oct=3D3 lid=3D12 = -tim=3D107312018 hv=3D1997601641 -ad=3D'54af1384'

- -

select key, fkey, -value from t where key=3D:p1

- -

END = -OF STMT

- -

PARSE -#2:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312018

- -

WAIT = -#2: -nam=3D'SQL*Net message to client' ela=3D 0 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

WAIT = -#2: -nam=3D'SQL*Net message from client' ela=3D 0 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= -=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR -#1 len=3D44 dep=3D0 uid=3D12 oct=3D3 lid=3D12 = -tim=3D107312019 hv=3D1997601641 -ad=3D'54af1384'

- -

select key, fkey, -value from t where key=3D:p1

- -

END = -OF STMT

- -

PARSE -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312019

- -

BINDS = -#1:

- -

 bind 0: -dty=3D1 mxl=3D32(04) mal=3D00 scl=3D00 pre=3D00 oacflg=3D25 oacfl2=3D10 = -size=3D32 offset=3D0

- -

   bfp=3D0940e7f0 bln=3D32 avl=3D04 flg=3D05

- -

   -value=3D"8542"

- -

EXEC -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312019

- -

WAIT = -#1: -nam=3D'SQL*Net message to client' ela=3D 0 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

WAIT = -#1: nam=3D'file -open' ela=3D 0 p1=3D0 p2=3D0 p3=3D0

- -

WAIT = -#1: nam=3D'db -file sequential read' ela=3D 0 p1=3D1 p2=3D6671 p3=3D1

- -

WAIT = -#1: nam=3D'db -file sequential read' ela=3D 0 p1=3D1 p2=3D6678 p3=3D1

- -

FETCH -#1:c=3D0,e=3D0,p=3D2,cr=3D3,cu=3D0,mis=3D0,r=3D1,dep=3D0,og=3D3,tim=3D107= -312019

- -

*** = -2002-09-12 -16:14:56.200

- -

WAIT = -#1: -nam=3D'SQL*Net message from client' ela=3D 2496 p1=3D1650815232 p2=3D1 = -p3=3D0

- -

XCTEND rlbk=3D0, -rd_only=3D1

- -

STAT = -#1 id=3D1 cnt=3D1 -pid=3D0 pos=3D0 obj=3D5156 op=3D'TABLE ACCESS BY INDEX ROWID T = -'

- -

STAT = -#1 id=3D2 cnt=3D2 -pid=3D1 pos=3D1 obj=3D5157 op=3D'INDEX UNIQUE SCAN '

- -
- -

 

- -

 

- -

$ perl -V

- -

Summary of my perl5 (revision 5.0 version 6 subversion 0) = -configuration:

- -

  Platform:

- -

    osname=3Dlinux, osvers=3D2.2.5-22smp, = -archname=3Di386-linux

- -

    uname=3D'linux porky.devel.redhat.com = -2.2.5-22smp #1 smp -wed jun 2 09:11:51 edt 1999 i686 unknown '

- -

    config_args=3D'-des -Doptimize=3D-O2 = --march=3Di386 -mcpu=3Di686 --Dcc=3Dgcc -Dcccdlflags=3D-fPIC -Dinstallprefix=3D/usr -Dprefix=3D/usr = --Darchname=3Di386-linux --Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm -Di_gdbm -Di_shadow = --Di_syslog -Dman3ext=3D3pm -Uuselargefiles'

- -

    hint=3Drecommended, useposix=3Dtrue, = -d_sigaction=3Ddefine

- -

    usethreads=3Dundef use5005threads=3Dundef = -useithreads=3Dundef -usemultiplicity=3Dundef

- -

    useperlio=3Dundef d_sfio=3Dundef = -uselargefiles=3Dundef

- -

    use64bitint=3Dundef use64bitall=3Dundef = -uselongdouble=3Dundef -usesocks=3Dundef

- -

  Compiler:

- -

    cc=3D'gcc', optimize=3D'-O2 -march=3Di386 = --mcpu=3Di686', gccversion=3D2.96 -20000731 (experimental)

- -

    = -cppflags=3D'-fno-strict-aliasing'

- -

    ccflags = -=3D'-fno-strict-aliasing'

- -

    stdchar=3D'char', d_stdstdio=3Ddefine, = -usevfork=3Dfalse

- -

    intsize=3D4, longsize=3D4, ptrsize=3D4, = -doublesize=3D8

- -

    d_longlong=3Ddefine, longlongsize=3D8, = -d_longdbl=3Ddefine, -longdblsize=3D12

- -

    ivtype=3D'long', ivsize=3D4, = -nvtype=3D'double', nvsize=3D8, Off_t=3D'off_t', -lseeksize=3D4

- -

    alignbytes=3D4, usemymalloc=3Dn, = -prototype=3Ddefine

- -

  Linker and Libraries:

- -

    ld=3D'gcc', ldflags =3D' = --L/usr/local/lib'

- -

    libpth=3D/usr/local/lib /lib = -/usr/lib

- -

    libs=3D-lnsl -ldl -lm -lc = --lcrypt

- -

    libc=3D/lib/libc-2.1.92.so, so=3Dso, = -useshrplib=3Dfalse, libperl=3Dlibperl.a

- -

  Dynamic Linking:

- -

    dlsrc=3Ddl_dlopen.xs, dlext=3Dso, = -d_dlsymun=3Dundef, ccdlflags=3D'-rdynamic'

- -

    cccdlflags=3D'-fPIC', lddlflags=3D'-shared = --L/usr/local/lib'

- -

 

- -

 

- -

Characteristics of this binary (from libperl): = -

- -

  Compile-time options:

- -

  Built under linux

- -

  Compiled at Aug  7 2000 10:59:51

- -

  @INC:

- -

    = -/usr/lib/perl5/5.6.0/i386-linux

- -

    /usr/lib/perl5/5.6.0

- -

    = -/usr/lib/perl5/site_perl/5.6.0/i386-linux

- -

    = -/usr/lib/perl5/site_perl/5.6.0

- -

    /usr/lib/perl5/site_perl

- -

    .

- -

 

- -

 

- -

Other site information

- -

- Redhat Linux 7.0

- -

- Oracle 8.1.6.1.0

- -

- DBD-Oracle 1.12

- -

- DBI 1.30

- -

 

- -
- - - - - -------=_NextPart_001_016B_01C25A80.D1557E70-- - -------=_NextPart_000_016A_01C25A80.D1527130 -Content-Type: application/octet-stream; - name="ex1.log" -Content-Transfer-Encoding: quoted-printable -Content-Disposition: attachment; - filename="ex1.log" - - DBI::db=3DHASH(0x8235a74) trace level set to 9 in DBI 1.30-nothread=0A= - -> prepare for DBD::Oracle::db (DBI::db=3DHASH(0x8235b34)~0x8235a74 = -'alter session set events '10046 trace name context forever, level 12'')=0A= - = -dbih_setup_handle(DBI::st=3DHASH(0x8240f68)=3D>DBI::st=3DHASH(0x8240f98),= - DBD::Oracle::st, 8240f74, Null!)=0A= - dbih_make_com(DBI::db=3DHASH(0x8235a74), DBD::Oracle::st, 208) = -thr#(nil)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), Err, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8162bb8) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), State, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8190e58) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), Errstr, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8162ba0) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), Debug, = -DBI::db=3DHASH(0x8235a74)) 9 (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), FetchHashKeyName, = -DBI::db=3DHASH(0x8235a74)) 'NAME' (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240f98), HandleError, = -DBI::db=3DHASH(0x8235a74)) undef (not defined)=0A= -OCIHandleAlloc(0x82465d8,0x826c948,OCI_HTYPE_STMT,0,(nil))=3DSUCCESS=0A= -OCIStmtPrepare(0x826bf48,0x82559ec,'alter session set events '10046 = -trace name context forever, level 12'',69,1,0)=3DSUCCESS=0A= -OCIAttrGet(0x826bf48,OCI_HTYPE_STMT,0x826c94c,(nil),24,0x82559ec)=3DSUCCE= -SS=0A= - dbd_st_prepare'd sql ALTER=0A= - dbd_describe skipped for ALTER=0A= - <- prepare=3D DBI::st=3DHASH(0x8240f68) at ex1.pl line 38=0A= - -> execute for DBD::Oracle::st (DBI::st=3DHASH(0x8240f68)~0x8240f98)=0A= - dbd_st_execute ALTER (out0, lob0)...=0A= -OCIStmtExecute(0x82557c4,0x826bf48,0x82559ec,1,0,(nil),(nil),0)=3DSUCCESS=0A= -OCIAttrGet(0x826bf48,OCI_HTYPE_STMT,0xbffff654,(nil),9,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826bf48,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=3DSUCC= -ESS=0A= - dbd_st_execute ALTER returned (SUCCESS, rpc0, fn52, out0)=0A= - <- execute=3D '0E0' at ex1.pl line 39=0A= - -> prepare for DBD::Oracle::db (DBI::db=3DHASH(0x8235b34)~0x8235a74 = -'select key, fkey, value from t where key=3D?')=0A= - = -dbih_setup_handle(DBI::st=3DHASH(0x8240fe0)=3D>DBI::st=3DHASH(0x8240fb0),= - DBD::Oracle::st, 8240fec, Null!)=0A= - dbih_make_com(DBI::db=3DHASH(0x8235a74), DBD::Oracle::st, 208) = -thr#(nil)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), Err, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8162bb8) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), State, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8190e58) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), Errstr, = -DBI::db=3DHASH(0x8235a74)) SCALAR(0x8162ba0) (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), Debug, = -DBI::db=3DHASH(0x8235a74)) 9 (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), FetchHashKeyName, = -DBI::db=3DHASH(0x8235a74)) 'NAME' (already defined)=0A= - dbih_setup_attrib(DBI::st=3DHASH(0x8240fb0), HandleError, = -DBI::db=3DHASH(0x8235a74)) undef (not defined)=0A= - dbd_preparse scanned 1 distinct placeholders=0A= -OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=3DSUCCESS=0A= -OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t where = -key=3D:p1',44,1,0)=3DSUCCESS=0A= -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=3DSUCCE= -SS=0A= - dbd_st_prepare'd sql SELECT=0A= - dbd_describe SELECT (EXPLICIT, lb 80)...=0A= -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=3DSUCCES= -S=0A= -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff3dc,(nil),18,0x82559ec)=3DSUCC= -ESS=0A= -OCIParamGet(0x826e4a0,4,0x82559ec,0x826d1c0,1)=3DSUCCESS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1d6,(nil),2,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1d4,(nil),1,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1d8,(nil),5,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1da,(nil),6,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1db,(nil),7,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e228,OCI_DTYPE_PARAM,0x826d1e8,0xbffff3d8,4,0x82559ec)=3D= -SUCCESS=0A= - fbh 1: 'KEY' NO null , otype 2-> 5, dbsize 22/134, p0.s0=0A= -OCIParamGet(0x826e4a0,4,0x82559ec,0x826d200,2)=3DSUCCESS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d216,(nil),2,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d214,(nil),1,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d218,(nil),5,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d21a,(nil),6,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d21b,(nil),7,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e208,OCI_DTYPE_PARAM,0x826d228,0xbffff3d8,4,0x82559ec)=3D= -SUCCESS=0A= - fbh 2: 'FKEY' NULLable, otype 2-> 5, dbsize 22/134, p0.s0=0A= -OCIParamGet(0x826e4a0,4,0x82559ec,0x826d240,3)=3DSUCCESS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d256,(nil),2,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d254,(nil),1,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d258,(nil),5,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d25a,(nil),6,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d25b,(nil),7,0x82559ec)=3DSUCCE= -SS=0A= -OCIAttrGet(0x826e1e8,OCI_DTYPE_PARAM,0x826d268,0xbffff3d8,4,0x82559ec)=3D= -SUCCESS=0A= - fbh 3: 'VALUE' NULLable, otype 1-> 5, dbsize 32/33, p32.s0=0A= -OCIAttrSet(0x826e4a0,OCI_HTYPE_STMT,0xbffff3d4,4,11,0x82559ec)=3DSUCCESS=0A= -OCIDefineByPos(0x826e4a0,0x826d1c4,0x82559ec,1,0x826e8d0,134,5,0x826d438,= -0x826d448,0x826d458,0)=3DSUCCESS=0A= -OCIDefineByPos(0x826e4a0,0x826d204,0x82559ec,2,0x826eaf8,134,5,0x826ca28,= -0x826ca38,0x826ca48,0)=3DSUCCESS=0A= -OCIDefineByPos(0x826e4a0,0x826d244,0x82559ec,3,0x826cbb8,33,5,0x826ca58,0= -x826cbe0,0x826cbf0,0)=3DSUCCESS=0A= - dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: 231)=0A= - <- prepare=3D DBI::st=3DHASH(0x8240fe0) at ex1.pl line 50=0A= - -> DESTROY for DBD::Oracle::st (DBI::st=3DHASH(0x8240f98)~INNER)=0A= -OCIHandleFree(0x826bf48,OCI_HTYPE_STMT)=3DSUCCESS=0A= - <- DESTROY=3D undef at ex1.pl line 51=0A= - -> execute for DBD::Oracle::st (DBI::st=3DHASH(0x8240fe0)~0x8240fb0 = -'8542')=0A= - bind :p1 <=3D=3D '8542' (type 0)=0A= - bind :p1 <=3D=3D '8542' (size 4/5/0, ptype 7, otype 1)=0A= - bind :p1 <=3D=3D '8542' (size 4/4, otype 1, indp 0, at_exec 1)=0A= -OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826cb= -6e,(nil),0x826cb6c,0,(nil),2)=3DSUCCESS=0A= -OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401da= -090)=3DSUCCESS=0A= - bind :p1 done with ftype 1=0A= - dbd_st_execute SELECT (out0, lob0)...=0A= - in ':p1' [0,0]: len 4, ind 0=0A= -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=3DSUCCESS=0A= -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=3DSUCC= -ESS=0A= - dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0)=0A= - <- execute=3D '0E0' at ex1.pl line 51=0A= - -> fetchall_arrayref for DBD::Oracle::st = -(DBI::st=3DHASH(0x8240fe0)~0x8240fb0)=0A= - dbd_st_fetch 3 fields...=0A= -OCIStmtFetch(0x826e4a0,0x82559ec,1,2,0)=3DSUCCESS=0A= - dbih_setup_fbav for 3 fields =3D> 0x8240fbc=0A= - dbd_st_fetch 3 fields SUCCESS=0A= - 0 (rc=3D0): '8542'=0A= - 1 (rc=3D0): '8542'=0A= - 2 (rc=3D0): 'value'=0A= - dbd_st_fetch 3 fields...=0A= -OCIStmtFetch(0x826e4a0,0x82559ec,1,2,0)=3DNO_DATA=0A= - dbd_st_fetch no-more-data=0A= - <- fetchall_arrayref=3D [ ARRAY(0x82411f0) ] row1 at ex1.pl line 62=0A= - -> disconnect for DBD::Oracle::db = -(DBI::db=3DHASH(0x8235b34)~0x8235a74)=0A= -OCISessionEnd(0x82557c4,0x82559ec,0x826c384,0)=3DSUCCESS=0A= -OCIServerDetach(0x8255834,0x82559ec,0)=3DSUCCESS=0A= - <- disconnect=3D 1 at ex1.pl line 74=0A= - -> DESTROY for DBD::Oracle::st (DBI::st=3DHASH(0x8240fb0)~INNER)=0A= -OCIHandleFree(0x826e4a0,OCI_HTYPE_STMT)=3DSUCCESS=0A= - <- DESTROY=3D undef=0A= - -> DESTROY for DBD::Oracle::db (DBI::db=3DHASH(0x8235a74)~INNER)=0A= -OCIHandleFree(0x826c384,OCI_HTYPE_SESSION)=3DSUCCESS=0A= -OCIHandleFree(0x8255834,OCI_HTYPE_SERVER)=3DSUCCESS=0A= -OCIHandleFree(0x82557c4,OCI_HTYPE_SVCCTX)=3DSUCCESS=0A= -OCIHandleFree(0x82559ec,OCI_HTYPE_ERROR)=3DSUCCESS=0A= - <- DESTROY=3D undef=0A= - -------=_NextPart_000_016A_01C25A80.D1527130-- - - -From timbo@dansat.data-plan.com Fri Sep 13 07:30:31 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8D6UUC04053 - for ; Fri, 13 Sep 2002 07:30:30 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.21] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 07:30:30 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031871608:20:03733:55; Thu, 12 Sep 2002 23:00:08 GMT -Received: from cali-3.pobox.com ([64.71.166.116]) by punt-2.mail.demon.net - id ab2122693; 12 Sep 2002 23:00 GMT -Received: from cali-3.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-3.pobox.com (Postfix) with ESMTP id AE0642F0B8A - for ; Thu, 12 Sep 2002 18:58:25 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail03.svc.cra.dublin.eircom.net (mail03.svc.cra.dublin.eircom.net [159.134.118.19]) - by cali-3.pobox.com (Postfix) with SMTP id 931D42F0D0A - for ; Thu, 12 Sep 2002 18:58:19 -0400 (EDT) -Received: (qmail 57270 messnum 519666 invoked from network[159.134.164.69/p69.as1.limerick1.eircom.net]); 12 Sep 2002 22:58:17 -0000 -Received: from p69.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.164.69) - by mail03.svc.cra.dublin.eircom.net (qp 57270) with SMTP; 12 Sep 2002 22:58:17 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g8CMwEQ02798; - Thu, 12 Sep 2002 23:58:14 +0100 (BST) - (envelope-from timbo) -Date: Thu, 12 Sep 2002 23:58:14 +0100 -From: Tim Bunce -To: Cary Millsap -Cc: tim.bunce@pobox.com -Subject: two Oracle parse calls -Message-ID: <20020912225814.GG539@dansat.data-plan.com> -References: <016901c25aaa$ba287930$6501a8c0@CVMLAP01> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <016901c25aaa$ba287930$6501a8c0@CVMLAP01> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 3530 -Lines: 77 - -On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap wrote: -> Tim, -> -> How are you doing? I hope you've had a good two years since I saw you on -> the Oracle Geek Cruise event. - -Yes thanks. And you? - -> I've been working on a project this year to construct a book about -> optimizing Oracle response time. In my research, I've discovered -> something about the DBI that I didn't expect: it executes two Oracle -> parse calls for every one that I would expect an efficient DBI layer to -> make. I've included my Perl source (below), the Oracle level-12 trace -> data that shows the sequence of calls it's receiving from the Perl -> application (below), a level-9 DBI trace from the application -> (attached), and our version information (below). -> -> I was hoping that by showing you this specific data, you could make the -> problem go away. - -I can only do what OCI lets me do... but within that I'll do what I can... - -I'm not familar with Oracle trace logs so I can't readily intrepret them -and I'll take what you say at face value. - -But I am familar with DBD::Oracle :) and the logs it writes :) - -> $sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); -> $sth->execute($key); - - - -> prepare for DBD::Oracle::db (DBI::db=HASH(0x8235b34)~0x8235a74 'select key, fkey, value from t where key=?') - dbd_preparse scanned 1 distinct placeholders -OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=SUCCESS -OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t where key=:p1',44,1,0)=SUCCESS -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=SUCCESS - dbd_st_prepare'd sql SELECT - dbd_describe SELECT (EXPLICIT, lb 80)... -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=SUCCESS - dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: 231) - <- prepare= DBI::st=HASH(0x8240fe0) at ex1.pl line 50 - -> execute for DBD::Oracle::st (DBI::st=HASH(0x8240fe0)~0x8240fb0 '8542') -OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826cb6e,(nil),0x826cb6c,0,(nil),2)=SUCCESS -OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401da090)=SUCCESS - bind :p1 done with ftype 1 - dbd_st_execute SELECT (out0, lob0)... - in ':p1' [0,0]: len 4, ind 0 -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=SUCCESS -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=SUCCESS - dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) - <- execute= '0E0' at ex1.pl line 51 - -Given those OCI calls, what is DBD::Oracle doing that it shouldn't? - -I'd guess that it's something to do with the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) -call that prepare() does. - -It doesn't do that for non-select statements so you could check if -non-selects also have two parse calls. - -Also try doing - $sth = $dbh->prepare(q(select key, fkey, value from t where key=?), { ora_check_sql=> 0 }); - -which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till after the -main OCIStmtExecute(). In that case the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) -is possibly redundant and could be removed (but Oracle ought to detect that -anyway and not make a round-trip for it, and certainly not call parse). - -If non-selects only have one parse call but ora_check_sql=>0 doesn't -fix selects, then I might be able to do a simple patch to avoid the -OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if ora_check_sql=>0. - -Then the issue will be: should ora_check_sql=>0 be the default... - -Tim. - -p.s. I'd love a copy of your book when it's ready! - -From cary.millsap@hotsos.com Fri Sep 13 07:31:55 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8D6VsC04590 - for ; Fri, 13 Sep 2002 07:31:54 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.21] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 07:31:54 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031889643:20:09494:0; Fri, 13 Sep 2002 04:00:43 GMT -Received: from wormwood.pobox.com ([208.210.125.20]) by punt-2.mail.demon.net - id aa2008866; 13 Sep 2002 4:00 GMT -Received: from wormwood.pobox.com (localhost.pobox.com [127.0.0.1]) - by wormwood.pobox.com (Postfix) with ESMTP id C94C67264F - for ; Fri, 13 Sep 2002 00:00:07 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by wormwood.pobox.com (Postfix) with ESMTP id A821072676 - for ; Fri, 13 Sep 2002 00:00:06 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8D405n19404 - for ; Thu, 12 Sep 2002 23:00:05 -0500 -From: "Cary Millsap" -To: "'Tim Bunce'" -Subject: RE: two Oracle parse calls -Date: Thu, 12 Sep 2002 22:59:56 -0500 -Message-ID: <019201c25ada$093c6ac0$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -In-Reply-To: <20020912225814.GG539@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 4825 -Lines: 129 - -Tim, - -Thanks so very much. The attribute ora_check_sql=>0 is new knowledge to -me; this is a nice reward for having written to you. I will test it -either tonight or the first thing tomorrow and then inform you of the -results immediately after that. If it solves the problem, then I will -lobby you to make 0 the default value and probably consider the issue -"problem solved." - -Things are very well, thank you. I've been at home with my family now -for over three straight weeks, and we're having a nice time of our lives -these days with the business settling into stride a bit. Tonight is a -big night for me. I've just crossed the line of accepting a preliminary -offer from O'Reilly. This book project has actually been underway for -quite some time now, but as of tonight it's quite a bit more "official." - - -Cary Millsap -Hotsos Enterprises, Ltd. -http://www.hotsos.com - -Upcoming events: -- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -Honolulu -- 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -- Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark - - - ------Original Message----- -From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -Sent: Thursday, September 12, 2002 5:58 PM -To: Cary Millsap -Cc: tim.bunce@pobox.com -Subject: two Oracle parse calls - -On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap wrote: -> Tim, -> -> How are you doing? I hope you've had a good two years since I saw you -on -> the Oracle Geek Cruise event. - -Yes thanks. And you? - -> I've been working on a project this year to construct a book about -> optimizing Oracle response time. In my research, I've discovered -> something about the DBI that I didn't expect: it executes two Oracle -> parse calls for every one that I would expect an efficient DBI layer -to -> make. I've included my Perl source (below), the Oracle level-12 trace -> data that shows the sequence of calls it's receiving from the Perl -> application (below), a level-9 DBI trace from the application -> (attached), and our version information (below). -> -> I was hoping that by showing you this specific data, you could make -the -> problem go away. - -I can only do what OCI lets me do... but within that I'll do what I -can... - -I'm not familar with Oracle trace logs so I can't readily intrepret them -and I'll take what you say at face value. - -But I am familar with DBD::Oracle :) and the logs it writes :) - -> $sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); -> $sth->execute($key); - - - -> prepare for DBD::Oracle::db (DBI::db=HASH(0x8235b34)~0x8235a74 -'select key, fkey, value from t where key=?') - dbd_preparse scanned 1 distinct placeholders -OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=SUCCESS -OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t where -key=:p1',44,1,0)=SUCCESS -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=SUCCES -S - dbd_st_prepare'd sql SELECT - dbd_describe SELECT (EXPLICIT, lb 80)... -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=SUCCESS - dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: 231) - <- prepare= DBI::st=HASH(0x8240fe0) at ex1.pl line 50 - -> execute for DBD::Oracle::st (DBI::st=HASH(0x8240fe0)~0x8240fb0 -'8542') -OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826c -b6e,(nil),0x826cb6c,0,(nil),2)=SUCCESS -OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401d -a090)=SUCCESS - bind :p1 done with ftype 1 - dbd_st_execute SELECT (out0, lob0)... - in ':p1' [0,0]: len 4, ind 0 -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=SUCCESS -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=SUCCE -SS - dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) - <- execute= '0E0' at ex1.pl line 51 - -Given those OCI calls, what is DBD::Oracle doing that it shouldn't? - -I'd guess that it's something to do with the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY) -call that prepare() does. - -It doesn't do that for non-select statements so you could check if -non-selects also have two parse calls. - -Also try doing - $sth = $dbh->prepare(q(select key, fkey, value from t where key=?), { -ora_check_sql=> 0 }); - -which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till after the -main OCIStmtExecute(). In that case the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY) -is possibly redundant and could be removed (but Oracle ought to detect -that -anyway and not make a round-trip for it, and certainly not call parse). - -If non-selects only have one parse call but ora_check_sql=>0 doesn't -fix selects, then I might be able to do a simple patch to avoid the -OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if ora_check_sql=>0. - -Then the issue will be: should ora_check_sql=>0 be the default... - -Tim. - -p.s. I'd love a copy of your book when it's ready! - - -From timbo@dansat.data-plan.com Fri Sep 13 10:48:59 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8D9mwC06022 - for ; Fri, 13 Sep 2002 10:48:58 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.22] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 10:48:58 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031907122:20:19599:21; Fri, 13 Sep 2002 08:52:02 GMT -Received: from cali-2.pobox.com ([64.71.166.115]) by punt-2.mail.demon.net - id aa2129553; 13 Sep 2002 8:52 GMT -Received: from cali-2.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-2.pobox.com (Postfix) with ESMTP id 99E263E660 - for ; Fri, 13 Sep 2002 04:51:54 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail03.svc.cra.dublin.eircom.net (mail03.svc.cra.dublin.eircom.net [159.134.118.19]) - by cali-2.pobox.com (Postfix) with SMTP id 721613E637 - for ; Fri, 13 Sep 2002 04:51:53 -0400 (EDT) -Received: (qmail 29161 messnum 524631 invoked from network[159.134.167.5/p773.as1.limerick1.eircom.net]); 13 Sep 2002 08:51:51 -0000 -Received: from p773.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.167.5) - by mail03.svc.cra.dublin.eircom.net (qp 29161) with SMTP; 13 Sep 2002 08:51:51 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g8D8prO05752; - Fri, 13 Sep 2002 09:51:53 +0100 (BST) - (envelope-from timbo) -Date: Fri, 13 Sep 2002 09:51:53 +0100 -From: Tim Bunce -To: Cary Millsap -Cc: "'Tim Bunce'" -Subject: Re: two Oracle parse calls -Message-ID: <20020913085153.GJ539@dansat.data-plan.com> -References: <20020912225814.GG539@dansat.data-plan.com> <019201c25ada$093c6ac0$6501a8c0@CVMLAP01> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <019201c25ada$093c6ac0$6501a8c0@CVMLAP01> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 6172 -Lines: 154 - -On Thu, Sep 12, 2002 at 10:59:56PM -0500, Cary Millsap wrote: -> Tim, -> -> Thanks so very much. The attribute ora_check_sql=>0 is new knowledge to -> me; this is a nice reward for having written to you. I will test it -> either tonight or the first thing tomorrow and then inform you of the -> results immediately after that. If it solves the problem, then I will -> lobby you to make 0 the default value and probably consider the issue -> "problem solved." - -Ah, but there are down-sides to ora_check_sql=0 - it was the default -for a little while. Here's an old message that, although being out of -date in various ways, describes some of the issues: - -http://www.bitmechanic.com/mail-archives/dbi-users/Apr1999/0538.html - -In principle I don't have a fundamental objection to defering the -'describe' until execute and thus defering detection of syntax -errors until the execute. I'd probably add a new $dbh attribute to -set the desired default behaviour so you don't have to add it to -each prepare() call. - -> Things are very well, thank you. I've been at home with my family now -> for over three straight weeks, and we're having a nice time of our lives -> these days with the business settling into stride a bit. Tonight is a -> big night for me. I've just crossed the line of accepting a preliminary -> offer from O'Reilly. This book project has actually been underway for -> quite some time now, but as of tonight it's quite a bit more "official." - -Congratulations. I'm sure it'll be a success. - -BTW, if you happen to come across any work opportunities that might -fit my skills I'd be interested in hearing about them (would have to -be teleworking as I've no plans to move under any circumstances). -I'd especially love to find some company that uses DBI & DBD::Oracle -heavily and would basically pay me to develop them - there's *lots* -more valuable functionality that could be added to DBD::Oracle (and -my Oracle::OCI module). - -Tim. - -> -> Cary Millsap -> Hotsos Enterprises, Ltd. -> http://www.hotsos.com -> -> Upcoming events: -> - Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -> Honolulu -> - 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -> - Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark -> -> -> -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Thursday, September 12, 2002 5:58 PM -> To: Cary Millsap -> Cc: tim.bunce@pobox.com -> Subject: two Oracle parse calls -> -> On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap wrote: -> > Tim, -> > -> > How are you doing? I hope you've had a good two years since I saw you -> on -> > the Oracle Geek Cruise event. -> -> Yes thanks. And you? -> -> > I've been working on a project this year to construct a book about -> > optimizing Oracle response time. In my research, I've discovered -> > something about the DBI that I didn't expect: it executes two Oracle -> > parse calls for every one that I would expect an efficient DBI layer -> to -> > make. I've included my Perl source (below), the Oracle level-12 trace -> > data that shows the sequence of calls it's receiving from the Perl -> > application (below), a level-9 DBI trace from the application -> > (attached), and our version information (below). -> > -> > I was hoping that by showing you this specific data, you could make -> the -> > problem go away. -> -> I can only do what OCI lets me do... but within that I'll do what I -> can... -> -> I'm not familar with Oracle trace logs so I can't readily intrepret them -> and I'll take what you say at face value. -> -> But I am familar with DBD::Oracle :) and the logs it writes :) -> -> > $sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); -> > $sth->execute($key); -> -> -> -> prepare for DBD::Oracle::db (DBI::db=HASH(0x8235b34)~0x8235a74 -> 'select key, fkey, value from t where key=?') -> dbd_preparse scanned 1 distinct placeholders -> OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=SUCCESS -> OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t where -> key=:p1',44,1,0)=SUCCESS -> OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=SUCCES -> S -> dbd_st_prepare'd sql SELECT -> dbd_describe SELECT (EXPLICIT, lb 80)... -> OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=SUCCESS -> dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: 231) -> <- prepare= DBI::st=HASH(0x8240fe0) at ex1.pl line 50 -> -> execute for DBD::Oracle::st (DBI::st=HASH(0x8240fe0)~0x8240fb0 -> '8542') -> OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826c -> b6e,(nil),0x826cb6c,0,(nil),2)=SUCCESS -> OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401d -> a090)=SUCCESS -> bind :p1 done with ftype 1 -> dbd_st_execute SELECT (out0, lob0)... -> in ':p1' [0,0]: len 4, ind 0 -> OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=SUCCESS -> OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=SUCCE -> SS -> dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) -> <- execute= '0E0' at ex1.pl line 51 -> -> Given those OCI calls, what is DBD::Oracle doing that it shouldn't? -> -> I'd guess that it's something to do with the OCIStmtExecute(..., -> OCI_DESCRIBE_ONLY) -> call that prepare() does. -> -> It doesn't do that for non-select statements so you could check if -> non-selects also have two parse calls. -> -> Also try doing -> $sth = $dbh->prepare(q(select key, fkey, value from t where key=?), { -> ora_check_sql=> 0 }); -> -> which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till after the -> main OCIStmtExecute(). In that case the OCIStmtExecute(..., -> OCI_DESCRIBE_ONLY) -> is possibly redundant and could be removed (but Oracle ought to detect -> that -> anyway and not make a round-trip for it, and certainly not call parse). -> -> If non-selects only have one parse call but ora_check_sql=>0 doesn't -> fix selects, then I might be able to do a simple patch to avoid the -> OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if ora_check_sql=>0. -> -> Then the issue will be: should ora_check_sql=>0 be the default... -> -> Tim. -> -> p.s. I'd love a copy of your book when it's ready! -> - -From cary.millsap@hotsos.com Fri Sep 13 17:52:40 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DGqdC10778 - for ; Fri, 13 Sep 2002 17:52:39 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.59] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 17:52:39 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031932999:10:25604:102; Fri, 13 Sep 2002 16:03:19 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1101673; 13 Sep 2002 16:03 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id E4A692C078 - for ; Fri, 13 Sep 2002 12:02:43 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by dolly1.pobox.com (Postfix) with ESMTP id 1609E2C03F - for ; Fri, 13 Sep 2002 12:02:29 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8DG2Sn24856 - for ; Fri, 13 Sep 2002 11:02:28 -0500 -From: "Cary Millsap" -To: "'Tim Bunce'" -Subject: RE: two Oracle parse calls -Date: Fri, 13 Sep 2002 11:02:20 -0500 -Message-ID: <01c501c25b3e$f3e7f440$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -In-Reply-To: <20020913085153.GJ539@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 9234 -Lines: 248 - -Tim, - -I think it's important for a developer to have the ability to turn this -on and off. But I would argue that 0 is the correct default. I think of -it as a probability times cost function. The cost of leaving the setting -at 1 accidentally in a production application is pretty high: if the app -doesn't scale (because it's parsing too much), then it jeopardizes the -business' ability to succeed with it. - -The probability of leaving the option set to 1 accidentally during -production is very high. A point in evidence is that I didn't find the -parameter until I corresponded personally with you. I in fact *still* -don't know where to find it. I've checked Descartes & Bunce, perldoc -DBI, and perldoc DBD::Oracle without finding it yet... - -If the default were 0, the probability of leaving the option set to 0 -accidentally during development would be much lower. A developer faced -with a SQL syntax problem he doesn't understand will do the research -necessary to fix that problem. He can't release his code until he does. - -The problem with the default of 1 is, in my opinion, that most -developers will never learn of the feature, and they'll accidentally -leave it turned on in production. The proportion of developers who -competently performance-test their code is, unfortunately, -microscopically small. But they all do some level of functional testing. - -I would recommend making the ora_check_sql feature a more prominently -documented feature, presumably in "perldoc DBD::Oracle". - -I did learn in a test that specifying the option in the DBI->connect() -call doesn't do anything. Is it possible that you could allow us to -specify it at the connection level? The workaround is to do something -like this: - - use Getopt::Long; - my %prepare_attr = (ora_check_sql=>0); - GetOptions("dev"=>\$dev); - $prepare_attr{ora_check_sql} = 1 if $dev; - # developer must specify the command-line flag to get the -unscalable - # behavior that's necessary for functional testing - ... - $sth = $dbh->prepare($sql, %prepare_attr); # MUST specify -%p..attr - -...But I doubt that most Oracle application developers would come up -with this without some coaching. - -I'll definitely keep an eye open for projects you might like. It would -be a hell of an opportunity for someone to have you, I think. It seems -that if you could make a list like Oracle-L (1,900 people) aware that -there's an opportunity, it would improve your chances of finding -something quickly. It's of course bad taste to advertise oneself overtly -on those lists, but there is almost always a clever way to do it anyway -without offending anyone. - - -Cary Millsap -Hotsos Enterprises, Ltd. -http://www.hotsos.com - -Upcoming events: -- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -Honolulu -- 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -- Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark - - - ------Original Message----- -From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -Sent: Friday, September 13, 2002 3:52 AM -To: Cary Millsap -Cc: 'Tim Bunce' -Subject: Re: two Oracle parse calls - -On Thu, Sep 12, 2002 at 10:59:56PM -0500, Cary Millsap wrote: -> Tim, -> -> Thanks so very much. The attribute ora_check_sql=>0 is new knowledge -to -> me; this is a nice reward for having written to you. I will test it -> either tonight or the first thing tomorrow and then inform you of the -> results immediately after that. If it solves the problem, then I will -> lobby you to make 0 the default value and probably consider the issue -> "problem solved." - -Ah, but there are down-sides to ora_check_sql=0 - it was the default -for a little while. Here's an old message that, although being out of -date in various ways, describes some of the issues: - -http://www.bitmechanic.com/mail-archives/dbi-users/Apr1999/0538.html - -In principle I don't have a fundamental objection to defering the -'describe' until execute and thus defering detection of syntax -errors until the execute. I'd probably add a new $dbh attribute to -set the desired default behaviour so you don't have to add it to -each prepare() call. - -> Things are very well, thank you. I've been at home with my family now -> for over three straight weeks, and we're having a nice time of our -lives -> these days with the business settling into stride a bit. Tonight is a -> big night for me. I've just crossed the line of accepting a -preliminary -> offer from O'Reilly. This book project has actually been underway for -> quite some time now, but as of tonight it's quite a bit more -"official." - -Congratulations. I'm sure it'll be a success. - -BTW, if you happen to come across any work opportunities that might -fit my skills I'd be interested in hearing about them (would have to -be teleworking as I've no plans to move under any circumstances). -I'd especially love to find some company that uses DBI & DBD::Oracle -heavily and would basically pay me to develop them - there's *lots* -more valuable functionality that could be added to DBD::Oracle (and -my Oracle::OCI module). - -Tim. - -> -> Cary Millsap -> Hotsos Enterprises, Ltd. -> http://www.hotsos.com -> -> Upcoming events: -> - Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -> Honolulu -> - 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -> - Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark -> -> -> -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Thursday, September 12, 2002 5:58 PM -> To: Cary Millsap -> Cc: tim.bunce@pobox.com -> Subject: two Oracle parse calls -> -> On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap wrote: -> > Tim, -> > -> > How are you doing? I hope you've had a good two years since I saw -you -> on -> > the Oracle Geek Cruise event. -> -> Yes thanks. And you? -> -> > I've been working on a project this year to construct a book about -> > optimizing Oracle response time. In my research, I've discovered -> > something about the DBI that I didn't expect: it executes two Oracle -> > parse calls for every one that I would expect an efficient DBI layer -> to -> > make. I've included my Perl source (below), the Oracle level-12 -trace -> > data that shows the sequence of calls it's receiving from the Perl -> > application (below), a level-9 DBI trace from the application -> > (attached), and our version information (below). -> > -> > I was hoping that by showing you this specific data, you could make -> the -> > problem go away. -> -> I can only do what OCI lets me do... but within that I'll do what I -> can... -> -> I'm not familar with Oracle trace logs so I can't readily intrepret -them -> and I'll take what you say at face value. -> -> But I am familar with DBD::Oracle :) and the logs it writes :) -> -> > $sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); -> > $sth->execute($key); -> -> -> -> prepare for DBD::Oracle::db (DBI::db=HASH(0x8235b34)~0x8235a74 -> 'select key, fkey, value from t where key=?') -> dbd_preparse scanned 1 distinct placeholders -> OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=SUCCESS -> OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t -where -> key=:p1',44,1,0)=SUCCESS -> -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=SUCCES -> S -> dbd_st_prepare'd sql SELECT -> dbd_describe SELECT (EXPLICIT, lb 80)... -> -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=SUCCESS -> dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: -231) -> <- prepare= DBI::st=HASH(0x8240fe0) at ex1.pl line 50 -> -> execute for DBD::Oracle::st (DBI::st=HASH(0x8240fe0)~0x8240fb0 -> '8542') -> -OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826c -> b6e,(nil),0x826cb6c,0,(nil),2)=SUCCESS -> -OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401d -> a090)=SUCCESS -> bind :p1 done with ftype 1 -> dbd_st_execute SELECT (out0, lob0)... -> in ':p1' [0,0]: len 4, ind 0 -> -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=SUCCESS -> -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=SUCCE -> SS -> dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) -> <- execute= '0E0' at ex1.pl line 51 -> -> Given those OCI calls, what is DBD::Oracle doing that it shouldn't? -> -> I'd guess that it's something to do with the OCIStmtExecute(..., -> OCI_DESCRIBE_ONLY) -> call that prepare() does. -> -> It doesn't do that for non-select statements so you could check if -> non-selects also have two parse calls. -> -> Also try doing -> $sth = $dbh->prepare(q(select key, fkey, value from t where key=?), -{ -> ora_check_sql=> 0 }); -> -> which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till after the -> main OCIStmtExecute(). In that case the OCIStmtExecute(..., -> OCI_DESCRIBE_ONLY) -> is possibly redundant and could be removed (but Oracle ought to detect -> that -> anyway and not make a round-trip for it, and certainly not call -parse). -> -> If non-selects only have one parse call but ora_check_sql=>0 doesn't -> fix selects, then I might be able to do a simple patch to avoid the -> OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if ora_check_sql=>0. -> -> Then the issue will be: should ora_check_sql=>0 be the default... -> -> Tim. -> -> p.s. I'd love a copy of your book when it's ready! -> - - -From timbo@dansat.data-plan.com Fri Sep 13 23:21:37 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DMLbC13725 - for ; Fri, 13 Sep 2002 23:21:37 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 23:21:37 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031951069:20:15816:152; Fri, 13 Sep 2002 21:04:29 GMT -Received: from cali-2.pobox.com ([64.71.166.115]) by punt-2.mail.demon.net - id aa2120669; 13 Sep 2002 21:04 GMT -Received: from cali-2.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-2.pobox.com (Postfix) with ESMTP id 544863E642 - for ; Fri, 13 Sep 2002 17:04:17 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail05.svc.cra.dublin.eircom.net (mail05.svc.cra.dublin.eircom.net [159.134.118.21]) - by cali-2.pobox.com (Postfix) with SMTP id 0AE7C3E667 - for ; Fri, 13 Sep 2002 17:04:16 -0400 (EDT) -Received: (qmail 16221 messnum 355694 invoked from network[159.134.166.226/p738.as1.limerick1.eircom.net]); 13 Sep 2002 21:04:14 -0000 -Received: from p738.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.166.226) - by mail05.svc.cra.dublin.eircom.net (qp 16221) with SMTP; 13 Sep 2002 21:04:14 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g8DL4Lx12642; - Fri, 13 Sep 2002 22:04:21 +0100 (BST) - (envelope-from timbo) -Date: Fri, 13 Sep 2002 22:04:21 +0100 -From: Tim Bunce -To: Cary Millsap -Cc: "'Tim Bunce'" -Subject: Re: two Oracle parse calls -Message-ID: <20020913210421.GR539@dansat.data-plan.com> -References: <20020913085153.GJ539@dansat.data-plan.com> <01c501c25b3e$f3e7f440$6501a8c0@CVMLAP01> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <01c501c25b3e$f3e7f440$6501a8c0@CVMLAP01> -User-Agent: Mutt/1.4i -Status: O -Content-Length: 3078 -Lines: 70 - -On Fri, Sep 13, 2002 at 11:02:20AM -0500, Cary Millsap wrote: -> Tim, -> -> I think it's important for a developer to have the ability to turn this -> on and off. But I would argue that 0 is the correct default. I think of -> it as a probability times cost function. The cost of leaving the setting -> at 1 accidentally in a production application is pretty high: if the app -> doesn't scale (because it's parsing too much), then it jeopardizes the -> business' ability to succeed with it. -> -> The probability of leaving the option set to 1 accidentally during -> production is very high. A point in evidence is that I didn't find the -> parameter until I corresponded personally with you. I in fact *still* -> don't know where to find it. I've checked Descartes & Bunce, perldoc -> DBI, and perldoc DBD::Oracle without finding it yet... - -It's not documented. - -As I recall it... originally DBD::Oracle defered the describe as -long as possible. But people reported very slow select performance: - - http://www.faqchest.com/prgm/dbi-l/dbi-99/dbi-9910/dbi-991005/dbi99101218_28018.html - -Turned out that the row cache logic needed the describe to try to -work out an optimal row cache size. Without the describe the row -cache wasn't getting set up. - -At some point I added code that would just set OCI_ATTR_PREFETCH_MEMORY -to a set size if ora_check_sql was 0. But I can't remember now why -I left ora_check_sql=1. - -It was possibly in relation to wanting to be able to use the -OCI_ATTR_PARSE_ERROR_OFFSET attribute to be able to highlight the -point in a query where the error was detected. But I think execute() -needs to be able to do that anyway (to catch syntax errors in -non-select statements). - -There is another problem. If the describe has been defered and the -application uses $sth->{NAME} or other similar attribute then the -describe has to be done at that point. The code is thee to do that -but the problem is how should the DBI behave if there's an error -in the SQL? It currently always croaks (rather than return undef, -in order to give a useful error message), but that's rather surprising -behaviour to many people and very unhelpful to some. - -There may well be other subtle issues that I can't recall right now. - -> I would recommend making the ora_check_sql feature a more prominently -> documented feature, presumably in "perldoc DBD::Oracle". -> -> I did learn in a test that specifying the option in the DBI->connect() -> call doesn't do anything. Is it possible that you could allow us to -> specify it at the connection level? - -By making it a database handle attribute, yes, that would be my plan. - -> I'll definitely keep an eye open for projects you might like. It would -> be a hell of an opportunity for someone to have you, I think. - -Thanks. - -> It seems that if you could make a list like Oracle-L (1,900 people) aware -> that there's an opportunity, it would improve your chances of finding -> something quickly. It's of course bad taste to advertise oneself overtly -> on those lists, but there is almost always a clever way to do it anyway -> without offending anyone. - -:-) - -Tim. - -From cary.millsap@hotsos.com Fri Sep 13 07:32:06 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8D6W1C04656 - for ; Fri, 13 Sep 2002 07:32:01 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.21] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 07:32:01 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031891038:20:04710:44; Fri, 13 Sep 2002 04:23:58 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-2.mail.demon.net - id ab2004623; 13 Sep 2002 4:23 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 942A82BF2C - for ; Fri, 13 Sep 2002 00:23:44 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by dolly1.pobox.com (Postfix) with ESMTP id 73C982BF33 - for ; Fri, 13 Sep 2002 00:23:42 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8D4Ndn19584 - for ; Thu, 12 Sep 2002 23:23:39 -0500 -From: "Cary Millsap" -To: "'Tim Bunce'" -Subject: RE: two Oracle parse calls -Date: Thu, 12 Sep 2002 23:23:30 -0500 -Message-ID: <019301c25add$53f5dfd0$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: multipart/alternative; - boundary="----=_NextPart_000_0194_01C25AB3.6B1FD7D0" -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -In-Reply-To: -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -Content-Length: 36859 -Lines: 1209 - -This is a multi-part message in MIME format. - -------=_NextPart_000_0194_01C25AB3.6B1FD7D0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit - -Well, that was easy. Setting ora_check_sql=>0 does solve the problem. - - - -I now shift into "Please make 0 the default" mode. - - - -Here are the Oracle trace files, by the way, with a splash of color to -illustrate how the Oracle kernel sees what's going on (I hope you have -an HTML mail reader)... - - - -With {ora_check_sql=>1} (or no setting at all), here's what Oracle does -for the application: - - - -===================== - -PARSING IN CURSOR #2 len=44 dep=0 uid=12 oct=3 lid=12 tim=107312018 -hv=1997601641 ad='54af1384' - -select key, fkey, value from t where key=:p1 - -END OF STMT - -PARSE #2:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312018 - -===================== - -PARSING IN CURSOR #1 len=44 dep=0 uid=12 oct=3 lid=12 tim=107312019 -hv=1997601641 ad='54af1384' - -select key, fkey, value from t where key=:p1 - -END OF STMT - -PARSE #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312019 - -EXEC #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=107312019 - -FETCH #1:c=0,e=0,p=2,cr=3,cu=0,mis=0,r=1,dep=0,og=3,tim=107312019 - - - -The PARSING IN CURSOR section tells us what SQL it is that we're -executing. Each line beginning with "PARSE" is emitted only when Oracle -executes a parse call. There are two. The first is wasted. - - - -Here's the same application with {ora_check_sql=>1} (the official new -default value, I am sure :-)): - - - -===================== - -PARSING IN CURSOR #1 len=44 dep=0 uid=12 oct=3 lid=12 tim=109776065 -hv=1997601641 ad='54af1384' - -select key, fkey, value from t where key=:p1 - -END OF STMT - -PARSE #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=109776065 - -EXEC #1:c=0,e=0,p=0,cr=0,cu=0,mis=0,r=0,dep=0,og=3,tim=109776065 - -FETCH #1:c=0,e=0,p=0,cr=3,cu=0,mis=0,r=1,dep=0,og=3,tim=109776065 - - - -One parse call; problem solved. - - - -Thank you sincerely for your help. - - - - - -Cary Millsap - -Hotsos Enterprises, Ltd. - -http://www.hotsos.com - - - -Upcoming events: - -- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -Honolulu - -- 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas - -- Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark - - - - - - - ------Original Message----- -From: Cary Millsap [mailto:cary.millsap@hotsos.com] -Sent: Thursday, September 12, 2002 11:00 PM -To: 'Tim Bunce' -Subject: RE: two Oracle parse calls - - - -Tim, - - - -Thanks so very much. The attribute ora_check_sql=>0 is new knowledge to -me; this is a nice reward for having written to you. I will test it -either tonight or the first thing tomorrow and then inform you of the -results immediately after that. If it solves the problem, then I will -lobby you to make 0 the default value and probably consider the issue -"problem solved." - - - -Things are very well, thank you. I've been at home with my family now -for over three straight weeks, and we're having a nice time of our lives -these days with the business settling into stride a bit. Tonight is a -big night for me. I've just crossed the line of accepting a preliminary -offer from O'Reilly. This book project has actually been underway for -quite some time now, but as of tonight it's quite a bit more "official." - - - - - -Cary Millsap - -Hotsos Enterprises, Ltd. - -http://www.hotsos.com - - - -Upcoming events: - -- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -Honolulu - -- 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas - -- Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark - - - - - - - ------Original Message----- - -From: Tim Bunce [mailto:Tim.Bunce@pobox.com] - -Sent: Thursday, September 12, 2002 5:58 PM - -To: Cary Millsap - -Cc: tim.bunce@pobox.com - -Subject: two Oracle parse calls - - - -On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap wrote: - -> Tim, - -> - -> How are you doing? I hope you've had a good two years since I saw you -on - -> the Oracle Geek Cruise event. - - - -Yes thanks. And you? - - - -> I've been working on a project this year to construct a book about - -> optimizing Oracle response time. In my research, I've discovered - -> something about the DBI that I didn't expect: it executes two Oracle - -> parse calls for every one that I would expect an efficient DBI layer -to - -> make. I've included my Perl source (below), the Oracle level-12 trace - -> data that shows the sequence of calls it's receiving from the Perl - -> application (below), a level-9 DBI trace from the application - -> (attached), and our version information (below). - -> - -> I was hoping that by showing you this specific data, you could make -the - -> problem go away. - - - -I can only do what OCI lets me do... but within that I'll do what I -can... - - - -I'm not familar with Oracle trace logs so I can't readily intrepret them - -and I'll take what you say at face value. - - - -But I am familar with DBD::Oracle :) and the logs it writes :) - - - -> $sth = $dbh->prepare(q(select key, fkey, value from t where key=?)); - -> $sth->execute($key); - - - - - - -> prepare for DBD::Oracle::db (DBI::db=HASH(0x8235b34)~0x8235a74 -'select key, fkey, value from t where key=?') - - dbd_preparse scanned 1 distinct placeholders - -OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=SUCCESS - -OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from t where -key=:p1',44,1,0)=SUCCESS - -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)=SUCCES -S - - dbd_st_prepare'd sql SELECT - - dbd_describe SELECT (EXPLICIT, lb 80)... - -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=SUCCESS - - dbd_describe'd 3 columns (row bytes: 76 max, 40 est avg, cache: 231) - - <- prepare= DBI::st=HASH(0x8240fe0) at ex1.pl line 50 - - -> execute for DBD::Oracle::st (DBI::st=HASH(0x8240fe0)~0x8240fb0 -'8542') - -OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x826cd78,4,1,0x826c -b6e,(nil),0x826cb6c,0,(nil),2)=SUCCESS - -OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40,0x401d -a090)=SUCCESS - - bind :p1 done with ftype 1 - - dbd_st_execute SELECT (out0, lob0)... - - in ':p1' [0,0]: len 4, ind 0 - -OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=SUCCESS - -OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec)=SUCCE -SS - - dbd_st_execute SELECT returned (SUCCESS, rpc0, fn4, out0) - - <- execute= '0E0' at ex1.pl line 51 - - - -Given those OCI calls, what is DBD::Oracle doing that it shouldn't? - - - -I'd guess that it's something to do with the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY) - -call that prepare() does. - - - -It doesn't do that for non-select statements so you could check if - -non-selects also have two parse calls. - - - -Also try doing - - $sth = $dbh->prepare(q(select key, fkey, value from t where key=?), { -ora_check_sql=> 0 }); - - - -which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till after the - -main OCIStmtExecute(). In that case the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY) - -is possibly redundant and could be removed (but Oracle ought to detect -that - -anyway and not make a round-trip for it, and certainly not call parse). - - - -If non-selects only have one parse call but ora_check_sql=>0 doesn't - -fix selects, then I might be able to do a simple patch to avoid the - -OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if ora_check_sql=>0. - - - -Then the issue will be: should ora_check_sql=>0 be the default... - - - -Tim. - - - -p.s. I'd love a copy of your book when it's ready! - - -------=_NextPart_000_0194_01C25AB3.6B1FD7D0 -Content-Type: text/html; - charset="us-ascii" -Content-Transfer-Encoding: quoted-printable - - - - - - - - - - - - - - - -
- -

Well, that was easy. Setting ora_check_sql=3D>0 = -does solve the -problem.

- -

 

- -

I now shift into "Please make 0 the = -default" mode.

- -

 

- -

Here are the Oracle trace files, by the way, with a = -splash -of color to illustrate how the Oracle kernel sees what’s going on = -(I hope -you have an HTML mail reader)...

- -

 

- -

With {ora_check_sql=3D>1} (or no setting at all), = -here’s -what Oracle does for the application:

- -

 

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR #2 len=3D44 dep=3D0 uid=3D12 = -oct=3D3 lid=3D12 tim=3D107312018 = -hv=3D1997601641 ad=3D'54af1384'

- -

select key, fkey, value from t where = -key=3D:p1

- -

END OF STMT

- -

PARSE = -#2:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312018

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR #1 len=3D44 dep=3D0 uid=3D12 = -oct=3D3 lid=3D12 tim=3D107312019 = -hv=3D1997601641 -ad=3D'54af1384'

- -

select key, fkey, value from t where = -key=3D:p1

- -

END OF = -STMT

- -

PARSE = -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312019

- -

EXEC = -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D107= -312019

- -

FETCH = -#1:c=3D0,e=3D0,p=3D2,cr=3D3,cu=3D0,mis=3D0,r=3D1,dep=3D0,og=3D3,tim=3D107= -312019

- -

 

- -

The PARSING IN CURSOR section tells us what SQL it is = -that -we’re executing. Each line beginning with “PARSE” is = -emitted -only when Oracle executes a parse call. There are two. The first is = -wasted.

- -

 

- -

Here’s the same application with = -{ora_check_sql=3D>1} (the official new = -default value, I -am sure J):

- -

 

- -

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D

- -

PARSING IN CURSOR #1 len=3D44 = -dep=3D0 uid=3D12 -oct=3D3 lid=3D12 tim=3D109776065 hv=3D1997601641 = -ad=3D'54af1384'

- -

select key, fkey, value from = -t where -key=3D:p1

- -

END OF STMT

- -

PARSE = -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D109= -776065

- -

EXEC = -#1:c=3D0,e=3D0,p=3D0,cr=3D0,cu=3D0,mis=3D0,r=3D0,dep=3D0,og=3D3,tim=3D109= -776065

- -

FETCH = -#1:c=3D0,e=3D0,p=3D0,cr=3D3,cu=3D0,mis=3D0,r=3D1,dep=3D0,og=3D3,tim=3D109= -776065

- -

 

- -

One parse call; problem solved.

- -

 

- -

Thank you sincerely for your help.

- -

 

- -

 

- -

Cary = -Millsap

- -

Hotsos Enterprises, Ltd.

- -

http://www.hotsos.com

- -

 

- -

Upcoming events:

- -

- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu

- -

- 2003 Hotsos Symposium on Oracle® System = -Performance, -Feb 9-12 Dallas

- -

- Next event: Miracle Database Forum, Sep 20-22 = -Middelfart Denmark

- -

 

- -

 

- -

 

- -

-----Original Message-----
-From: Cary Millsap [mailto:cary.millsap@hotsos.com]
-Sent: Thursday, September 12, 2002 11:00 PM
-To: 'Tim Bunce'
-Subject: RE: two Oracle parse calls

- -

 

- -

Tim,

- -

 

- -

Thanks so very much. The attribute ora_check_sql=3D>0 is new = -knowledge -to me; this is a nice reward for having written to you. I will test it = -either -tonight or the first thing tomorrow and then inform you of the results -immediately after that. If it solves the problem, then I will lobby you = -to make -0 the default value and probably consider the issue "problem = -solved."

- -

 

- -

Things are very well, thank you. I've been at home with my = -family now -for over three straight weeks, and we're having a nice time of our lives = -these -days with the business settling into stride a bit. Tonight is a big = -night for -me. I've just crossed the line of accepting a preliminary offer from = -O'Reilly. -This book project has actually been underway for quite some time now, = -but as of -tonight it's quite a bit more "official."

- -

 

- -

 

- -

Cary Millsap

- -

Hotsos Enterprises, Ltd.

- -

http://www.hotsos.com

- -

 

- -

Upcoming events:

- -

- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec = -9-11 -Honolulu

- -

- 2003 Hotsos Symposium on Oracle® System Performance, Feb = -9-12 -Dallas

- -

- Next event: Miracle Database Forum, Sep 20-22 Middelfart = -Denmark

- -

 

- -

 

- -

 

- -

-----Original Message-----

- -

From: Tim Bunce [mailto:Tim.Bunce@pobox.com]

- -

Sent: Thursday, September 12, 2002 5:58 PM

- -

To: Cary Millsap

- -

Cc: tim.bunce@pobox.com

- -

Subject: two Oracle parse calls

- -

 

- -

On Thu, Sep 12, 2002 at 05:21:17PM -0500, Cary Millsap = -wrote:

- -

> Tim,

- -

>

- -

> How are you doing? I hope you've had a good two years since = -I saw -you on

- -

> the Oracle Geek Cruise event.

- -

 

- -

Yes thanks. And you?

- -

 

- -

> I've been working on a project this year to construct a = -book about

- -

> optimizing Oracle response time. In my research, I've = -discovered

- -

> something about the DBI that I didn't expect: it executes = -two -Oracle

- -

> parse calls for every one that I would expect an efficient = -DBI -layer to

- -

> make. I've included my Perl source (below), the Oracle = -level-12 -trace

- -

> data that shows the sequence of calls it's receiving from = -the Perl

- -

> application (below), a level-9 DBI trace from the = -application

- -

> (attached), and our version information = -(below).

- -

>

- -

> I was hoping that by showing you this specific data, you = -could -make the

- -

> problem go away.

- -

 

- -

I can only do what OCI lets me do... but within that I'll do = -what I -can...

- -

 

- -

I'm not familar with Oracle trace logs so I can't readily = -intrepret -them

- -

and I'll take what you say at face value.

- -

 

- -

But I am familar with DBD::Oracle :) and the logs it writes = -:)

- -

 

- -

> $sth =3D $dbh->prepare(q(select key, fkey, value from t = -where -key=3D?));

- -

> $sth->execute($key);

- -

 

- -

 

- -

    -> prepare for DBD::Oracle::db -(DBI::db=3DHASH(0x8235b34)~0x8235a74 'select key, fkey, value from t = -where -key=3D?')

- -

    dbd_preparse scanned 1 distinct = -placeholders

- -

OCIHandleAlloc(0x82465d8,0x826cae8,OCI_HTYPE_STMT,0,(nil))=3DSUCC= -ESS

- -

OCIStmtPrepare(0x826e4a0,0x82559ec,'select key, fkey, value from = -t -where key=3D:p1',44,1,0)=3DSUCCESS

- -

OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0x826caec,(nil),24,0x82559ec)= -=3DSUCCESS

- -

    dbd_st_prepare'd sql SELECT

- -

    dbd_describe SELECT (EXPLICIT, lb = -80)...

- -

OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),16)=3D= -SUCCESS

- -

    dbd_describe'd 3 columns (row bytes: 76 max, = -40 est -avg, cache: 231)

- -

    <- prepare=3D DBI::st=3DHASH(0x8240fe0) at = -ex1.pl -line 50

- -

    -> execute for DBD::Oracle::st -(DBI::st=3DHASH(0x8240fe0)~0x8240fb0 '8542')

- -

OCIBindByName(0x826e4a0,0x826cb5c,0x82559ec,":p1",3,0x8= -26cd78,4,1,0x826cb6e,(nil),0x826cb6c,0,(nil),2)=3DSUCCESS - -

OCIBindDynamic(0x826dc40,0x82559ec,0x826cb40,0x401d9f60,0x826cb40= -,0x401da090)=3DSUCCESS

- -

       bind :p1 done with ftype = -1

- -

    dbd_st_execute SELECT (out0, = -lob0)...

- -

       in  ':p1' [0,0]: = -len  4, -ind 0

- -

OCIStmtExecute(0x82557c4,0x826e4a0,0x82559ec,0,0,(nil),(nil),0)=3D= -SUCCESS

- -

OCIAttrGet(0x826e4a0,OCI_HTYPE_STMT,0xbffff65a,(nil),10,0x82559ec= -)=3DSUCCESS

- -

    dbd_st_execute SELECT returned (SUCCESS, = -rpc0, fn4, -out0)

- -

    <- execute=3D '0E0' at ex1.pl line = -51

- -

 

- -

Given those OCI calls, what is DBD::Oracle doing that it = -shouldn't?

- -

 

- -

I'd guess that it's something to do with the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY)

- -

call that prepare() does.

- -

 

- -

It doesn't do that for non-select statements so you could check = -if

- -

non-selects also have two parse calls.

- -

 

- -

Also try doing

- -

  $sth =3D $dbh->prepare(q(select key, fkey, value from = -t where -key=3D?), { ora_check_sql=3D> 0 });

- -

 

- -

which refers the OCIStmtExecute(..., OCI_DESCRIBE_ONLY) till = -after the

- -

main OCIStmtExecute(). In that case the OCIStmtExecute(..., -OCI_DESCRIBE_ONLY)

- -

is possibly redundant and could be removed (but Oracle ought to = -detect -that

- -

anyway and not make a round-trip for it, and certainly not call = -parse).

- -

 

- -

If non-selects only have one parse call but = -ora_check_sql=3D>0 doesn't

- -

fix selects, then I might be able to do a simple patch to avoid = -the

- -

OCIStmtExecute(..., OCI_DESCRIBE_ONLY) if = -ora_check_sql=3D>0.

- -

 

- -

Then the issue will be: should ora_check_sql=3D>0 be the = -default...

- -

 

- -

Tim.

- -

 

- -

p.s. I'd love a copy of your book when it's = -ready!

- -
- - - - - -------=_NextPart_000_0194_01C25AB3.6B1FD7D0-- - - -From cary.millsap@hotsos.com Fri Sep 13 21:17:44 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DKHhC12417 - for ; Fri, 13 Sep 2002 21:17:43 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.59] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 21:17:43 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031946929:20:18513:70; Fri, 13 Sep 2002 19:55:29 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-2.mail.demon.net - id aa2018248; 13 Sep 2002 19:55 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 7FC402C01F - for ; Fri, 13 Sep 2002 15:55:06 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by dolly1.pobox.com (Postfix) with ESMTP id 76A5E2BFE1 - for ; Fri, 13 Sep 2002 15:55:05 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8DJt4n26736 - for ; Fri, 13 Sep 2002 14:55:04 -0500 -From: "Cary Millsap" -To: "Tim Bunce" -Subject: A little more data -Date: Fri, 13 Sep 2002 14:54:56 -0500 -Message-ID: <020201c25b5f$7248a760$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: multipart/alternative; - boundary="----=_NextPart_000_0203_01C25B35.89729F60" -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 4948 -Lines: 166 - -This is a multi-part message in MIME format. - -------=_NextPart_000_0203_01C25B35.89729F60 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit - -Tim, - - - -I hope this is helpful. I have noticed that I cannot produce the -extra-parse problem on my 8.1.7 laptop database, no matter what the -setting of ora_check_sql. All of the data I've sent you is from our -8.1.6 Linux database. If you really needed it, I could produce level-9 -DBI trace data from identical tests on both platforms, but I won't spend -the time doing that unless you say it will help... - - - -Cary Millsap -Hotsos Enterprises, Ltd. -http://www.hotsos.com - -Upcoming events: -- Hotsos Clinic , Oct 1-3 San -Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu -- 2003 Hotsos Symposium on -OracleR System Performance, Feb 9-12 Dallas -- Next event: Miracle Database Forum , Sep -20-22 Middlefart Denmark - - - - -------=_NextPart_000_0203_01C25B35.89729F60 -Content-Type: text/html; - charset="us-ascii" -Content-Transfer-Encoding: quoted-printable - - - - - - - - - - - - - - - -
- -

Tim,

- -

 

- -

I hope this is helpful… I have noticed that I = -cannot -produce the extra-parse problem on my 8.1.7 laptop database, no matter = -what the -setting of ora_check_sql. All of the data I’ve sent you is from = -our 8.1.6 -Linux database. If you really needed it, I could produce level-9 DBI = -trace data -from identical tests on both platforms, but I won’t spend the time = -doing -that unless you say it will help...

- -

 

- -

Cary = -Millsap
-Hotsos Enterprises, Ltd.
-http://www.hotsos.com
-
-Upcoming events:
-- Hotsos Clinic, = -Oct -1–3 San Francisco, Oct 15–17 = -Dallas, Dec -9–11 Honolulu
-- 2003 Hotsos = -Symposium on -Oracle® System Performance, Feb 9–12 = -Dallas
-- Next event: Miracle Database = -Forum, Sep -20–22 Middlefart Denmark

- -

 

- -
- - - - - -------=_NextPart_000_0203_01C25B35.89729F60-- - - -From timbo@dansat.data-plan.com Fri Sep 13 22:05:30 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DL5UC12942 - for ; Fri, 13 Sep 2002 22:05:30 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 22:05:30 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031948458:10:20432:5; Fri, 13 Sep 2002 20:20:58 GMT -Received: from cali-2.pobox.com ([64.71.166.115]) by punt-1.mail.demon.net - id aa1020174; 13 Sep 2002 20:20 GMT -Received: from cali-2.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-2.pobox.com (Postfix) with ESMTP id 8A60E3E659 - for ; Fri, 13 Sep 2002 16:20:41 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail05.svc.cra.dublin.eircom.net (mail05.svc.cra.dublin.eircom.net [159.134.118.21]) - by cali-2.pobox.com (Postfix) with SMTP id CAC663E685 - for ; Fri, 13 Sep 2002 16:20:36 -0400 (EDT) -Received: (qmail 37861 messnum 258096 invoked from network[159.134.164.124/p124.as1.limerick1.eircom.net]); 13 Sep 2002 20:20:35 -0000 -Received: from p124.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.164.124) - by mail05.svc.cra.dublin.eircom.net (qp 37861) with SMTP; 13 Sep 2002 20:20:35 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g8DKKhu12535; - Fri, 13 Sep 2002 21:20:43 +0100 (BST) - (envelope-from timbo) -Date: Fri, 13 Sep 2002 21:20:43 +0100 -From: Tim Bunce -To: Cary Millsap -Cc: Tim Bunce -Subject: Re: A little more data -Message-ID: <20020913202043.GO539@dansat.data-plan.com> -References: <020201c25b5f$7248a760$6501a8c0@CVMLAP01> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <020201c25b5f$7248a760$6501a8c0@CVMLAP01> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 1098 -Lines: 34 - -If they're using the same version of DBD::Oracle then -the change must me on the sever side. Maybe Oracle's -woken up to the fact they don't need a second parse! - -Tim. - -On Fri, Sep 13, 2002 at 02:54:56PM -0500, Cary Millsap wrote: -> Tim, -> -> -> -> I hope this is helpful. I have noticed that I cannot produce the -> extra-parse problem on my 8.1.7 laptop database, no matter what the -> setting of ora_check_sql. All of the data I've sent you is from our -> 8.1.6 Linux database. If you really needed it, I could produce level-9 -> DBI trace data from identical tests on both platforms, but I won't spend -> the time doing that unless you say it will help... -> -> -> -> Cary Millsap -> Hotsos Enterprises, Ltd. -> http://www.hotsos.com -> -> Upcoming events: -> - Hotsos Clinic , Oct 1-3 San -> Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu -> - 2003 Hotsos Symposium on -> OracleR System Performance, Feb 9-12 Dallas -> - Next event: Miracle Database Forum , Sep -> 20-22 Middlefart Denmark -> -> -> - -From cary.millsap@hotsos.com Fri Sep 13 22:04:47 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DL4kC12684 - for ; Fri, 13 Sep 2002 22:04:46 +0100 (BST) - (envelope-from cary.millsap@hotsos.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 22:04:46 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031949629:20:13745:23; Fri, 13 Sep 2002 20:40:29 GMT -Received: from cali-1.pobox.com ([64.71.166.114]) by punt-2.mail.demon.net - id aa2013849; 13 Sep 2002 20:40 GMT -Received: from cali-1.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-1.pobox.com (Postfix) with ESMTP id 7D90A3E650 - for ; Fri, 13 Sep 2002 16:40:20 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from www.hotsos.com (unknown [63.145.61.17]) - by cali-1.pobox.com (Postfix) with ESMTP id 785AB3E642 - for ; Fri, 13 Sep 2002 16:40:19 -0400 (EDT) -Received: from CVMLAP01 (66-169-133-3.ftwrth.tx.charter.com [66.169.133.3]) - (authenticated (0 bits)) - by www.hotsos.com (8.11.3/8.11.0) with ESMTP id g8DKeIn27106 - for ; Fri, 13 Sep 2002 15:40:18 -0500 -From: "Cary Millsap" -To: "'Tim Bunce'" -Subject: RE: A little more data -Date: Fri, 13 Sep 2002 15:40:10 -0500 -Message-ID: <020d01c25b65$c4056e70$6501a8c0@CVMLAP01> -MIME-Version: 1.0 -Content-Type: text/plain; - charset="us-ascii" -Content-Transfer-Encoding: 7bit -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook, Build 10.0.3416 -Importance: Normal -In-Reply-To: <20020913202043.GO539@dansat.data-plan.com> -X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300 -Status: RO -X-Status: A -Content-Length: 1999 -Lines: 63 - -Well, it's 1.06 on my Windows machine (the most up-to-date version -available from ActiveState), and 1.12 on Linux. Not exactly a fair test, -but interesting that (admitting now that there's a new degree of freedom -running loose amid the test) "the older version performs better than the -newer one." :) That's certainly not a fair statement if the diff between -8.1.6 and 8.1.7 OCI is the root cause of the behavior difference. - - -Cary Millsap -Hotsos Enterprises, Ltd. -http://www.hotsos.com - -Upcoming events: -- Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -Honolulu -- 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -- Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark - - - ------Original Message----- -From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -Sent: Friday, September 13, 2002 3:21 PM -To: Cary Millsap -Cc: Tim Bunce -Subject: Re: A little more data - -If they're using the same version of DBD::Oracle then -the change must me on the sever side. Maybe Oracle's -woken up to the fact they don't need a second parse! - -Tim. - -On Fri, Sep 13, 2002 at 02:54:56PM -0500, Cary Millsap wrote: -> Tim, -> -> -> -> I hope this is helpful. I have noticed that I cannot produce the -> extra-parse problem on my 8.1.7 laptop database, no matter what the -> setting of ora_check_sql. All of the data I've sent you is from our -> 8.1.6 Linux database. If you really needed it, I could produce level-9 -> DBI trace data from identical tests on both platforms, but I won't -spend -> the time doing that unless you say it will help... -> -> -> -> Cary Millsap -> Hotsos Enterprises, Ltd. -> http://www.hotsos.com -> -> Upcoming events: -> - Hotsos Clinic , Oct 1-3 San -> Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu -> - 2003 Hotsos Symposium on -> OracleR System Performance, Feb 9-12 Dallas -> - Next event: Miracle Database Forum , Sep -> 20-22 Middlefart Denmark -> -> -> - - -From timbo@dansat.data-plan.com Fri Sep 13 23:21:32 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g8DMLWC13692 - for ; Fri, 13 Sep 2002 23:21:32 +0100 (BST) - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.58] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 13 Sep 2002 23:21:32 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1031952887:10:13297:20; Fri, 13 Sep 2002 21:34:47 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1118141; 13 Sep 2002 21:34 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id C7D482BF23 - for ; Fri, 13 Sep 2002 17:34:38 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from mail00.svc.cra.dublin.eircom.net (mail00.svc.cra.dublin.eircom.net [159.134.118.16]) - by dolly1.pobox.com (Postfix) with SMTP id 8352A2BF6C - for ; Fri, 13 Sep 2002 17:34:36 -0400 (EDT) -Received: (qmail 5093 messnum 521124 invoked from network[159.134.164.134/p134.as1.limerick1.eircom.net]); 13 Sep 2002 21:34:34 -0000 -Received: from p134.as1.limerick1.eircom.net (HELO dansat.data-plan.com) (159.134.164.134) - by mail00.svc.cra.dublin.eircom.net (qp 5093) with SMTP; 13 Sep 2002 21:34:34 -0000 -Received: (from timbo@localhost) - by dansat.data-plan.com (8.11.6/8.11.6) id g8DLYeI13070; - Fri, 13 Sep 2002 22:34:40 +0100 (BST) - (envelope-from timbo) -Date: Fri, 13 Sep 2002 22:34:40 +0100 -From: Tim Bunce -To: Cary Millsap -Cc: "'Tim Bunce'" -Subject: Re: A little more data -Message-ID: <20020913213440.GS539@dansat.data-plan.com> -References: <20020913202043.GO539@dansat.data-plan.com> <020d01c25b65$c4056e70$6501a8c0@CVMLAP01> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <020d01c25b65$c4056e70$6501a8c0@CVMLAP01> -User-Agent: Mutt/1.4i -Status: O -Content-Length: 2282 -Lines: 69 - -According my RCS the default for ora_check_sql changed from 0 to 1 -around version 1.03. - -Tim. - -On Fri, Sep 13, 2002 at 03:40:10PM -0500, Cary Millsap wrote: -> Well, it's 1.06 on my Windows machine (the most up-to-date version -> available from ActiveState), and 1.12 on Linux. Not exactly a fair test, -> but interesting that (admitting now that there's a new degree of freedom -> running loose amid the test) "the older version performs better than the -> newer one." :) That's certainly not a fair statement if the diff between -> 8.1.6 and 8.1.7 OCI is the root cause of the behavior difference. -> -> -> Cary Millsap -> Hotsos Enterprises, Ltd. -> http://www.hotsos.com -> -> Upcoming events: -> - Hotsos Clinic, Oct 1-3 San Francisco, Oct 15-17 Dallas, Dec 9-11 -> Honolulu -> - 2003 Hotsos Symposium on OracleR System Performance, Feb 9-12 Dallas -> - Next event: Miracle Database Forum, Sep 20-22 Middelfart Denmark -> -> -> -> -----Original Message----- -> From: Tim Bunce [mailto:Tim.Bunce@pobox.com] -> Sent: Friday, September 13, 2002 3:21 PM -> To: Cary Millsap -> Cc: Tim Bunce -> Subject: Re: A little more data -> -> If they're using the same version of DBD::Oracle then -> the change must me on the sever side. Maybe Oracle's -> woken up to the fact they don't need a second parse! -> -> Tim. -> -> On Fri, Sep 13, 2002 at 02:54:56PM -0500, Cary Millsap wrote: -> > Tim, -> > -> > -> > -> > I hope this is helpful. I have noticed that I cannot produce the -> > extra-parse problem on my 8.1.7 laptop database, no matter what the -> > setting of ora_check_sql. All of the data I've sent you is from our -> > 8.1.6 Linux database. If you really needed it, I could produce level-9 -> > DBI trace data from identical tests on both platforms, but I won't -> spend -> > the time doing that unless you say it will help... -> > -> > -> > -> > Cary Millsap -> > Hotsos Enterprises, Ltd. -> > http://www.hotsos.com -> > -> > Upcoming events: -> > - Hotsos Clinic , Oct 1-3 San -> > Francisco, Oct 15-17 Dallas, Dec 9-11 Honolulu -> > - 2003 Hotsos Symposium on -> > OracleR System Performance, Feb 9-12 Dallas -> > - Next event: Miracle Database Forum , Sep -> > 20-22 Middlefart Denmark -> > -> > -> > -> - diff --git a/err_unsorted/err_xml.msg b/err_unsorted/err_xml.msg deleted file mode 100644 index 7a60a0cb..00000000 --- a/err_unsorted/err_xml.msg +++ /dev/null @@ -1,118 +0,0 @@ -From dbi-users-return-19852-Tim.Bunce=pobox.com@perl.org Fri Aug 15 14:41:14 2003 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id h7FDe3MA043557 - for ; Fri, 15 Aug 2003 14:41:13 +0100 (BST) - (envelope-from dbi-users-return-19852-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 15 Aug 2003 14:41:13 +0100 (BST) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 19nc4X-0006LQ-BC; - Fri, 15 Aug 2003 10:44:41 +0000 -Received: from [207.106.49.22] (helo=dolly1.pobox.com) - by punt-3.mail.demon.net with esmtp id 19nc4X-0006LQ-BC - for pobox@dbi.demon.co.uk; Fri, 15 Aug 2003 10:44:41 +0000 -Received: from dolly1.pobox.com (localhost[127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 16F6B21C13B - for ; Fri, 15 Aug 2003 06:44:41 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.develooper.com[63.251.223.166]) - by dolly1.pobox.com (Postfix) with SMTP id 021F121C36F - for ; Fri, 15 Aug 2003 06:44:40 -0400 (EDT) -Received: (qmail 78180 invoked by uid 1005); 15 Aug 2003 10:44:34 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 71287 invoked by uid 76); 15 Aug 2003 10:32:13 -0000 -Delivered-To: dbi-users@perl.org -Received-SPF: unknown (domain of sender andyhassall@yahoo.com does not designate mailers: NXDOMAIN) -Message-ID: <20030815103200.24313.qmail@web9605.mail.yahoo.com> -Date: Fri, 15 Aug 2003 11:32:00 +0100 (BST) -From: =?iso-8859-1?q?Andy=20Hassall?= -Reply-To: andy@andyh.co.uk -Subject: Re: ERROR OCIDefineObject call needed but not implemented yet using XMLElement function -To: Susan Cassidy , dbi-users@perl.org -In-Reply-To: -MIME-Version: 1.0 -Content-Type: text/plain; charset=iso-8859-1 -X-SMTPD: qpsmtpd/0.27-dev, http://develooper.com/code/qpsmtpd/ -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=-0.8 required=7.0 tests=CARRIAGE_RETURNS,IN_REP_TO,QUOTED_EMAIL_TEXT,SPAM_PHRASE_01_02 version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Content-Transfer-Encoding: 8bit -X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id h7FDe3MA043557 -Status: RO -Content-Length: 2299 -Lines: 65 - - --- Susan Cassidy wrote: > I am using DBD::Oracle. -I was on version 1.12, then I installed version -> 1.14, with the same result. -> -> This is Oracle 9.2.0. -> -> I have this select statement that works fine from SQL*Plus: -> -> select XMLElement("Sequences", -> XMLElement("Sequence", -> XMLATTRIBUTES ( b.local_name AS "ic-acckey", -> b.mol_type AS "molecule", -> n.seq_name AS "title"))) -> from gcg_bioseq b, gcg_annot_seq_name a, gcg_seq_name n -> where -> b.local_name = 'K00306' and -> b.seq_status = 'D' and -> b.seq_oid = a.seq_oid and -> a.seq_name_oid = n.seq_name_oid and -> n.name_type = 'LOCUS' -> -> -> When I run it via DBI/DBD I get this (trace level 2): -> -> DBI 1.32-nothread dispatch trace level set to 2 -> Note: perl is running without the recommended perl -w option -> -> prepare for DBD::Oracle::db (DBI::db=HASH(0x1b2314)~0x122bec ' -[snip -> Field 1 has an Oracle type (108) which is not explicitly supported -> fbh 1: -> -'XMLELEMENT("SEQUENCES",XMLELEMENT("SEQUENCE",XMLATTRIBUTES(B.LOCAL_NAMEAS"IC-ACCKEY",B.MOL_TYPEAS"MOLECULE",N.SEQ_NAMEAS"TITLE")))' -[snip] -> Error: prepare failed -> at line 56, error: ERROR OCIDefineObject call needed but not -> implemented yet -> -> Is there any other workaround for this than wrapping this up in a PL/SQL -> function? - - Don't rely on the implicit conversion to a string type that is done when -SQL*Plus displays an XMLElement; add .getClobVal() to the end of the -statement to retrieve it as a CLOB rather than the XMLElement object type -(which DBD::Oracle doesn't accept). - - i.e. - -select XMLElement("Sequences", - XMLElement("Sequence", - XMLATTRIBUTES ( b.local_name AS "ic-acckey", - b.mol_type AS "molecule", - n.seq_name AS "title"))).getClobVal() - from ... - - (or getStringVal() for a VARCHAR2) - -===== --- -Andy Hassall (andy@andyh.org) icq(5747695) http://www.andyh.co.uk -http://www.andyhsoftware.co.uk/space | disk usage analysis tool - -________________________________________________________________________ -Want to chat instantly with your online friends? Get the FREE Yahoo! -Messenger http://uk.messenger.yahoo.com/ - - diff --git a/err_unsorted/err_xml2.msg b/err_unsorted/err_xml2.msg deleted file mode 100644 index 3bb291c5..00000000 --- a/err_unsorted/err_xml2.msg +++ /dev/null @@ -1,700 +0,0 @@ -From dbi-dev-return-2935-Tim.Bunce=pobox.com@perl.org Fri Jan 30 12:50:15 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i0UClt3q069307 - for ; Fri, 30 Jan 2004 12:50:14 GMT - (envelope-from dbi-dev-return-2935-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 30 Jan 2004 12:50:14 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AmWGJ-00057X-AG; - Fri, 30 Jan 2004 10:52:35 +0000 -Received: from [194.217.242.210] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1AmWGJ-00057X-AG - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 10:52:35 +0000 -Received: from [207.8.214.3] (helo=puzzle.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1AmWGI-0007XK-P3 - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 10:52:34 +0000 -Received: from puzzle.pobox.com (localhost [127.0.0.1]) - by puzzle.pobox.com (Postfix) with ESMTP id 029E8701C6 - for ; Fri, 30 Jan 2004 05:52:34 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by puzzle.pobox.com (Postfix) with ESMTP id 12ABF701C1 - for ; Fri, 30 Jan 2004 05:52:30 -0500 (EST) -Received: from onion.perl.org (onion.develooper.com [63.251.223.166]) - by puzzle.pobox.com (Postfix) with SMTP - for ; Fri, 30 Jan 2004 05:51:10 -0500 (EST) -Received: (qmail 33345 invoked by uid 1005); 30 Jan 2004 10:50:36 -0000 -Mailing-List: contact dbi-dev-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-dev@perl.org -Received: (qmail 33175 invoked by uid 76); 30 Jan 2004 10:50:26 -0000 -Received: from qmailr@one.develooper.com (HELO ran-out.mx.develooper.com) (64.81.84.115) by onion.perl.org (qpsmtpd/0.26) with SMTP; Fri, 30 Jan 2004 02:50:25 -0800 -Received: (qmail 21117 invoked by uid 225); 30 Jan 2004 10:48:52 -0000 -Delivered-To: dbi-dev@perl.org -Received: (qmail 21080 invoked by uid 507); 30 Jan 2004 10:48:49 -0000 -Received: from [212.89.121.1] (HELO babel.morphochem.de) (212.89.121.1) by one.develooper.com (qpsmtpd/0.27-dev) with ESMTP; Fri, 30 Jan 2004 02:48:46 -0800 -Received: (qmail 31958 invoked from network); 30 Jan 2004 11:50:38 -0000 -Received: from unknown (HELO mail.morphochem.de) (10.1.15.5) by 212.89.121.1 with SMTP; 30 Jan 2004 11:50:38 -0000 -Received: (qmail 6921 invoked from network); 30 Jan 2004 10:49:58 -0000 -Received: from localhost.morphochem.de (HELO mail) ([127.0.0.1]) (envelope-sender ) by localhost.morphochem.de (qmail-ldap-1.03) with SMTP for ; 30 Jan 2004 10:49:58 -0000 -Received: from mars.MORPHOCHEM.de ([10.1.8.130]) by mail.morphochem.de (MailMonitor for SMTP v1.2.1 ) ; Fri, 30 Jan 2004 11:49:58 +0100 (CET) -Subject: DBD-Oracle and XMLType -From: Hendrik Fuss -To: "dbi-dev@perl.org" -Content-Type: multipart/mixed; boundary="=-fkyM33WAvQ5xV0uCPeSD" -X-Mailer: Ximian Evolution 1.0.8 -Date: 30 Jan 2004 11:41:31 +0100 -Message-Id: <1075459292.7305.46.camel@mars> -Mime-Version: 1.0 -X-Spam-Check-By: one.develooper.com -X-Spam-Status: No, hits=0.5 required=7.0 tests=MIME_LONG_LINE_QP,QUOTED_EMAIL_TEXT,SPAM_PHRASE_00_01,TO_ADDRESS_EQ_REAL version=2.44 -X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ -Status: RO -X-Status: A -Content-Length: 8148 -Lines: 302 - ---=-fkyM33WAvQ5xV0uCPeSD -Content-Type: text/plain; charset=ISO-8859-1 -Content-Transfer-Encoding: quoted-printable - -Hi everyone, - -It's been a while since I last posted here. In September 2003 I was -trying to add support for binding XMLType objects to DBD-Oracle, so that -you could easily insert large (ie >4k) XML data into an XMLType table. - -Unfortunately my employer fired me in October 2003 and in the remaining -time I had to work on other projects, so I wasn't able to complete the -DBD project. Since I won't have access to an oracle database from now -on, I thought the least I can do is to provide my code as it is to the -list. Blame German economy. :-( - -The attached patch (based on DBD-Oracle 1.15) enables you to upload -XMLType objects (OCIXMLTypePtr) by binding them as SQLT_NTY. In dbdimp.c -I added a function dbd_rebind_ph_nty for that purpose. You need to -create that XMLType object first using the C function -createxmlfromstring in xml.c. - -The XMLType object is either created from an OCIString or from a -temporary CLOB depending on the length of the source string. Have a look -at the bottom of ociap.h, all the (undocumented) XMLType functions are -there, and there are also some constants in oci.h. - -I'm not sure if the CLOB code currently works. - -Here is another code fragment: - - my $xml =3D createxml($dbh, 'Test document'); - my $sth =3D $dbh->prepare('INSERT INTO xml_type VALUES (?)'); - $sth->bind_param(1, $xml, { ora_type =3D> 108 }); # SQLT_NTY - $sth->execute(); - -Please note that this code is really just early development, which I -wouldn't publish under normal circumstances. :) I just hope it might me -useful to someone. - -Well then, time to say goodbye -thanks to Tim and everyone who contributed to dbi for a great piece of -software - -Cheers, -Hendrik - ---=20 -hendrik fu=DF - -morphochem AG -gmunder str. 37-37a -81379 muenchen - -tel. ++49-89-78005-0 -fax ++49-89-78005-555 - -hendrik.fuss@morphochem.de -http://www.morphochem.de - ---=-fkyM33WAvQ5xV0uCPeSD -Content-Description: -Content-Disposition: attachment; filename=dbdimp.c.diff -Content-Transfer-Encoding: quoted-printable -Content-Type: text/plain; charset=ISO-8859-1 - -151a152 -> case 108: /* SQLT_NTY */ -992a994,996 -> case SQL_UDT: -> return 108; /* Oracle NTY */ ->=20 -1004a1009,1072 -> static int -> dbd_rebind_ph_nty(sth, imp_sth, phs) -> SV* sth; -> imp_sth_t *imp_sth; -> phs_t *phs; -> { -> OCIType *tdo =3D NULL; -> sword status; -> SV* ptr; ->=20 -> if (phs->is_inout) -> croak("OUT binding for NTY is currently unsupported"); ->=20 -> /* ensure that the value is a support named object type */ -> /* (currently only OCIXMLType*) */ -> if ( sv_isa(phs->sv, "OCIXMLTypePtr") ) { -> OCITypeByName(imp_sth->envhp, imp_sth->errhp, imp_sth->svchp, -> (CONST text*)"SYS", 3, -> (CONST text*)"XMLTYPE", 7, -> (CONST text*)0, 0, -> OCI_DURATION_CALLOUT, OCI_TYPEGET_HEADER, -> &tdo); ->=20 -> ptr =3D SvRV(phs->sv); -> phs->progv =3D (void*) SvIV(ptr); -> phs->maxlen =3D sizeof(OCIXMLType*); -> } -> else -> croak("Unsupported named object type for bind parameter"); ->=20 ->=20 -> /* bind by name */ ->=20 -> OCIBindByName_log_stat(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 -> ); ->=20 -> if (status !=3D OCI_SUCCESS) { -> oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY"); -> return 0; -> } -> if (DBIS->debug >=3D 3) -> PerlIO_printf(DBILOGFP, " pp_rebind_ph_nty: END\n"); ->=20 ->=20 -> /* bind the object */ ->=20 -> OCIBindObject(phs->bndhp, imp_sth->errhp, -> (CONST OCIType*)tdo, -> (dvoid **)&phs->progv, -> (ub4*)NULL, -> (dvoid **)NULL, -> (ub4*)NULL); ->=20 -> return 2; -> } -1309a1378,1380 -> case 108: -> done =3D dbd_rebind_ph_nty(sth, imp_sth, phs); -> break; -1331c1403 -< int at_exec =3D (phs->desc_h =3D=3D NULL); ---- -> int at_exec =3D (phs->desc_h =3D=3D NULL) && (phs->ftype !=3D 108); -1419c1491 -< if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) ---- -> if (SvROK(newvalue) && (!IS_DBI_HANDLE(newvalue)) && (sql_type!=3DSQL= -T_NTY)) -1420a1493 -> /* ref allowed for OCIXMLType* */ -2219a2293 -> case SQLT_NTY: sql_fbh.dbtype =3D SQL_UDT; break; - ---=-fkyM33WAvQ5xV0uCPeSD -Content-Disposition: attachment; filename=xml.c -Content-Transfer-Encoding: quoted-printable -Content-Type: text/plain; name=xml.c; charset=ISO-8859-1 - -#include "oci.h" -#include - -/* This helper function creates an XMLType object from a string source. - * - * The resulting object can be bound to a placeholder, if ora_type =3D> - * SQLT_NTY is specified. - */ - -static void checkerr(errhp, status) -OCIError *errhp; -sword status; -{ - text errbuf[512]; - ub4 buflen; - sb4 errcode; - - switch (status) - { - case OCI_SUCCESS: - break; - case OCI_SUCCESS_WITH_INFO: - printf("Error - OCI_SUCCESS_WITH_INFO\n"); - break; - case OCI_NEED_DATA: - printf("Error - OCI_NEED_DATA\n"); - break; - case OCI_NO_DATA: - printf("Error - OCI_NO_DATA\n"); - break; - case OCI_ERROR: - OCIErrorGet ((dvoid *) errhp, (ub4) 1, (text *) NULL, &errcode, - errbuf, (ub4) sizeof(errbuf), (ub4) OCI_HTYPE_ERROR); - printf("Error - %s\n", errbuf); - exit(1); - break; - case OCI_INVALID_HANDLE: - printf("Error - OCI_INVALID_HANDLE\n"); - break; - case OCI_STILL_EXECUTING: - printf("Error - OCI_STILL_EXECUTE\n"); - break; - case OCI_CONTINUE: - printf("Error - OCI_CONTINUE\n"); - break; - default: - break; - } -} - - -#define MAX_OCISTRING_LEN 32766 - -SV* createxmlfromstring(SV* dbh, char* source) { - OCIXMLType *xml =3D NULL; - ub4 len; - ub1 src_type; - dvoid* src_ptr =3D NULL; - D_imp_dbh(dbh); - SV* sv_dest; - - len =3D strlen(source); - if(len > MAX_OCISTRING_LEN) { - src_type =3D OCI_XMLTYPE_CREATE_CLOB; - - printf("OCIDescriptorAlloc\n"); - checkerr( imp_dbh->errhp, - OCIDescriptorAlloc((dvoid*)imp_dbh->envhp, - (dvoid **)&src_ptr, - (ub4)OCI_DTYPE_LOB, - (size_t)0, - (dvoid**)0) ); - - printf("OCILobCreateTemporary\n"); - checkerr( imp_dbh->errhp, - OCILobCreateTemporary(imp_dbh->svchp, - imp_dbh->errhp,=20 - (OCILobLocator*) src_ptr, - (ub2)0,=20 - SQLCS_IMPLICIT,=20 - OCI_TEMP_CLOB,=20 - OCI_ATTR_NOCACHE,=20 - OCI_DURATION_SESSION) ); - - printf("OCILobWrite\n"); - checkerr (imp_dbh->errhp, - OCILobWriteAppend(imp_dbh->svchp, - imp_dbh->errhp, - (OCILobLocator*) src_ptr, - &len,=20 - (ub1*)source, - len, - OCI_ONE_PIECE, - (dvoid *)0,=20 - (sb4 (*)(dvoid*,dvoid*,ub4*,ub1 *))0, - 0, - SQLCS_IMPLICIT)); - - } else { - src_type =3D OCI_XMLTYPE_CREATE_OCISTRING; - - printf("OCIStringAssignText\n"); - checkerr( imp_dbh->errhp, - OCIStringAssignText(imp_dbh->envhp, - imp_dbh->errhp,=20 - (CONST text*) source,=20 - (ub2) strlen(source), - (OCIString **) &src_ptr) - ); - } - - printf("OCIXMLTypeCreateFromSrc\n"); - checkerr( imp_dbh->errhp, - OCIXMLTypeCreateFromSrc(imp_dbh->svchp, - imp_dbh->errhp, - (OCIDuration)OCI_DURATION_CALLOUT, - (ub1)src_type, - (dvoid *)src_ptr, - (sb4)OCI_IND_NOTNULL, - &xml) - ); - - - /* free temporary resources */ - if( src_type =3D=3D OCI_XMLTYPE_CREATE_CLOB ) { - checkerr( imp_dbh->errhp, - OCILobFreeTemporary(imp_dbh->svchp, imp_dbh->errhp, - (OCILobLocator*) src_ptr) ); - - checkerr( imp_dbh->errhp, - OCIDescriptorFree((dvoid *) src_ptr, (ub4) OCI_DTYPE_LOB) ); - } - - - sv_dest =3D newSViv(0); - sv_setref_pv(sv_dest, "OCIXMLTypePtr", xml); - return sv_dest; -} - ---=-fkyM33WAvQ5xV0uCPeSD-- - - - -From hendrik.fuss@morphochem.de Fri Jan 30 16:56:30 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i0UGsO3v071338 - for ; Fri, 30 Jan 2004 16:56:27 GMT - (envelope-from hendrik.fuss@morphochem.de) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 30 Jan 2004 16:56:27 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AmZJF-0001wN-DK; - Fri, 30 Jan 2004 14:07:49 +0000 -Received: from [194.217.242.211] (helo=lon1-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1AmZJF-0001wN-DK - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 14:07:49 +0000 -Received: from [208.58.1.193] (helo=boggle.pobox.com) - by lon1-hub.mail.demon.net with esmtp id 1AmZJE-0003GM-Bm - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 14:07:48 +0000 -Received: from boggle.pobox.com (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id 334DE30C57 - for ; Fri, 30 Jan 2004 09:07:47 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by boggle.pobox.com (Postfix) with ESMTP id E65B230C2C - for ; Fri, 30 Jan 2004 09:07:45 -0500 (EST) -Received: from babel.morphochem.de (unknown [212.89.121.1]) - by boggle.pobox.com (Postfix) with ESMTP - for ; Fri, 30 Jan 2004 09:07:04 -0500 (EST) -Received: (qmail 29768 invoked from network); 30 Jan 2004 15:10:09 -0000 -Received: from unknown (HELO mail.morphochem.de) (10.1.15.5) - by 212.89.121.1 with SMTP; 30 Jan 2004 15:10:09 -0000 -Received: (qmail 11736 invoked from network); 30 Jan 2004 14:09:30 -0000 -Received: from localhost.morphochem.de (HELO mail) ([127.0.0.1]) - (envelope-sender ) - by localhost.morphochem.de (qmail-ldap-1.03) with SMTP - for ; 30 Jan 2004 14:09:30 -0000 -Received: from mars.MORPHOCHEM.de ([10.1.8.130]) - by mail.morphochem.de (MailMonitor for SMTP v1.2.1 ) ; - Fri, 30 Jan 2004 15:09:30 +0100 (CET) -Subject: Re: DBD-Oracle and XMLType -From: Hendrik Fuss -To: Tim Bunce -Cc: "dbi-dev@perl.org" -In-Reply-To: <20040130133443.GC70215@dansat.data-plan.com> -References: <1075459292.7305.46.camel@mars> - <20040130133443.GC70215@dansat.data-plan.com> -Content-Type: multipart/mixed; boundary="=-Sq1IOPDEhKoqxUKefiS3" -X-Mailer: Ximian Evolution 1.0.8 -Date: 30 Jan 2004 15:01:03 +0100 -Message-Id: <1075471263.7305.73.camel@mars> -Mime-Version: 1.0 -Status: RO -X-Status: A -Content-Length: 5585 -Lines: 196 - - ---=-Sq1IOPDEhKoqxUKefiS3 -Content-Type: text/plain; charset=ISO-8859-1 -Content-Transfer-Encoding: quoted-printable - -> > The attached patch (based on DBD-Oracle 1.15) enables you to upload -> > XMLType objects (OCIXMLTypePtr) by binding them as SQLT_NTY. In dbdimp.= -c -> > I added a function dbd_rebind_ph_nty for that purpose. You need to -> > create that XMLType object first using the C function -> > createxmlfromstring in xml.c. ->=20 -> I there any chance you could post that as a context diff (diff -u ideally -> or else diff -c)? It's much safer and more useful. Thanks. - -Good idea. Here's a diff -u of dbdimp.c. - -By the way: I have thougt about general support of named types, not just -XMLType, but you need to get the type description (TDO) from somewhere. -My code just checks if the perl variable is a blessed reference of -"OCIXMLTypePtr". - -Also note that my code can't handle downloading of XMLType objects yet. - -best wishes, -Hendrik - ---=20 -hendrik fu=DF - -morphochem AG -gmunder str. 37-37a -81379 muenchen - -tel. ++49-89-78005-0 -fax ++49-89-78005-555 - -hendrik.fuss@morphochem.de -http://www.morphochem.de - ---=-Sq1IOPDEhKoqxUKefiS3 -Content-Description: Context diff for dbdimp.c -Content-Disposition: attachment; filename=dbdimp.c.diff -Content-Transfer-Encoding: quoted-printable -Content-Type: text/plain; charset=ISO-8859-1 - ---- dbdimp.c.orig 2004-01-30 14:48:55.000000000 +0100 -+++ dbdimp.c 2003-10-07 12:17:17.000000000 +0200 -@@ -1,5 +1,5 @@ - /* -- $Id: dbdimp.c,v 1.1.1.1 2003/10/02 10:45:20 hfuss Exp $ -+ $Id: dbdimp.c,v 1.3 2003/10/07 10:17:17 hfuss Exp $ -=20 - Copyright (c) 1994,1995,1996,1997,1998 Tim Bunce -=20 -@@ -149,6 +149,7 @@ - case 97: /* CHARZ */ - case 106: /* MLSLABEL */ - case 102: /* SQLT_CUR OCI 7 cursor variable */ -+ case 108: /* SQLT_NTY */ - case 112: /* SQLT_CLOB / long */ - case 113: /* SQLT_BLOB / long */ - case 116: /* SQLT_RSET OCI 8 cursor variable */ -@@ -990,6 +991,9 @@ - case SQL_LONGVARCHAR: - return 8; /* Oracle LONG */ -=20 -+ case SQL_UDT: -+ return 108; /* Oracle NTY */ -+ - case SQL_DATE: - case SQL_TIME: - case SQL_TIMESTAMP: -@@ -1002,6 +1006,70 @@ - } -=20 -=20 -+static int -+dbd_rebind_ph_nty(sth, imp_sth, phs) -+ SV* sth; -+ imp_sth_t *imp_sth; -+ phs_t *phs; -+{ -+ OCIType *tdo =3D NULL; -+ sword status; -+ SV* ptr; -+ -+ 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") ) { -+ OCITypeByName(imp_sth->envhp, imp_sth->errhp, imp_sth->svchp, -+ (CONST text*)"SYS", 3, -+ (CONST text*)"XMLTYPE", 7, -+ (CONST text*)0, 0, -+ OCI_DURATION_CALLOUT, OCI_TYPEGET_HEADER, -+ &tdo); -+ -+ ptr =3D SvRV(phs->sv); -+ phs->progv =3D (void*) SvIV(ptr); -+ phs->maxlen =3D sizeof(OCIXMLType*); -+ } -+ else -+ croak("Unsupported named object type for bind parameter"); -+ -+ -+ /* bind by name */ -+ -+ OCIBindByName_log_stat(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 -+ ); -+ -+ if (status !=3D OCI_SUCCESS) { -+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY"); -+ return 0; -+ } -+ if (DBIS->debug >=3D 3) -+ PerlIO_printf(DBILOGFP, " 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; -+} -=20 - static int=20 - dbd_rebind_ph_char(sth, imp_sth, phs, alen_ptr_ptr)=20 -@@ -1307,6 +1375,9 @@ - case SQLT_RSET: - done =3D dbd_rebind_ph_rset(sth, imp_sth, phs); - break; -+ case 108: -+ done =3D dbd_rebind_ph_nty(sth, imp_sth, phs); -+ break; - #else - case 102: /* SQLT_CUR */ - done =3D dbd_rebind_ph_cursor(sth, imp_sth, phs); -@@ -1315,6 +1386,7 @@ - default: - done =3D dbd_rebind_ph_char(sth, imp_sth, phs, &alen_ptr); - } -+ - if (done !=3D 1) { - if (done =3D=3D 2) { /* the rebind did the OCI bind call itself successfu= -lly */ - if (DBIS->debug >=3D 3) -@@ -1328,7 +1400,7 @@ - #ifdef OCI_V8_SYNTAX - if (phs->maxlen > phs->maxlen_bound) { - sword status; -- int at_exec =3D (phs->desc_h =3D=3D NULL); -+ int at_exec =3D (phs->desc_h =3D=3D NULL) && (phs->ftype !=3D 108); - OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, - (text*)phs->name, (sb4)strlen(phs->name), - phs->progv, -@@ -1416,8 +1488,9 @@ - } - assert(name !=3D Nullch); -=20 -- if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) -+ if (SvROK(newvalue) && (!IS_DBI_HANDLE(newvalue)) && (sql_type!=3DSQLT= -_NTY)) - /* dbi handle allowed for cursor variables */ -+ /* ref allowed for OCIXMLType* */ - 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)); -@@ -2217,6 +2290,7 @@ - #ifdef OCI_V8_SYNTAX - case SQLT_CLOB: sql_fbh.dbtype =3D SQL_CLOB; break; - case SQLT_BLOB: sql_fbh.dbtype =3D SQL_BLOB; break; -+ case SQLT_NTY: sql_fbh.dbtype =3D SQL_UDT; break; - #endif - #ifdef SQLT_TIMESTAMP_TZ - case SQLT_TIMESTAMP_TZ: sql_fbh.dbtype =3D SQL_TIMESTAMP; break; - ---=-Sq1IOPDEhKoqxUKefiS3-- - - - -From timbo@dansat.data-plan.com Fri Jan 30 18:32:30 2004 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i0UIVK3f073353 - for ; Fri, 30 Jan 2004 18:32:30 GMT - (envelope-from timbo@dansat.data-plan.com) -Received: from pop3.mail.demon.net [194.217.242.253] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Fri, 30 Jan 2004 18:32:30 +0000 (GMT) -Received: from punt-3.mail.demon.net by mailstore - for pobox@dbi.demon.co.uk id 1AmceP-000603-GP; - Fri, 30 Jan 2004 17:41:53 +0000 -Received: from [194.217.242.71] (helo=anchor-hub.mail.demon.net) - by punt-3.mail.demon.net with esmtp id 1AmceP-000603-GP - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 17:41:53 +0000 -Received: from [208.210.124.73] (helo=icicle.pobox.com) - by anchor-hub.mail.demon.net with esmtp id 1AmceO-0006dQ-DB - for pobox@dbi.demon.co.uk; Fri, 30 Jan 2004 17:41:52 +0000 -Received: from icicle.pobox.com (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 25AEA3F13D - for ; Fri, 30 Jan 2004 12:41:51 -0500 (EST) -Delivered-To: tim.bunce@pobox.com -Received: from colander (localhost [127.0.0.1]) - by icicle.pobox.com (Postfix) with ESMTP id 9FB863F16E - for ; Fri, 30 Jan 2004 12:41:49 -0500 (EST) -Received: from mail09.svc.cra.dublin.eircom.net (mail09.svc.cra.dublin.eircom.net [159.134.118.25]) - by icicle.pobox.com (Postfix) with SMTP - for ; Fri, 30 Jan 2004 12:41:11 -0500 (EST) -Received: (qmail 9504 messnum 226571 invoked from network[213.94.228.233/unknown]); 30 Jan 2004 17:40:43 -0000 -Received: from unknown (HELO dansat.data-plan.com) (213.94.228.233) - by mail09.svc.cra.dublin.eircom.net (qp 9504) with SMTP; 30 Jan 2004 17:40:43 -0000 -Received: from dansat.data-plan.com (localhost [127.0.0.1]) - by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i0UHf33A072739; - Fri, 30 Jan 2004 17:41:03 GMT - (envelope-from timbo@dansat.data-plan.com) -Received: (from timbo@localhost) - by dansat.data-plan.com (8.12.9/8.12.9/Submit) id i0UHf2Wr072738; - Fri, 30 Jan 2004 17:41:02 GMT -Date: Fri, 30 Jan 2004 17:41:02 +0000 -From: Tim Bunce -To: Hendrik Fuss -Cc: Tim Bunce , "dbi-dev@perl.org" -Subject: Re: DBD-Oracle and XMLType -Message-ID: <20040130174102.GB72657@dansat.data-plan.com> -References: <1075459292.7305.46.camel@mars> <20040130133443.GC70215@dansat.data-plan.com> <1075471263.7305.73.camel@mars> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -In-Reply-To: <1075471263.7305.73.camel@mars> -User-Agent: Mutt/1.4i -Status: RO -Content-Length: 1129 -Lines: 29 - -On Fri, Jan 30, 2004 at 03:01:03PM +0100, Hendrik Fuss wrote: -> > > The attached patch (based on DBD-Oracle 1.15) enables you to upload -> > > XMLType objects (OCIXMLTypePtr) by binding them as SQLT_NTY. In dbdimp.c -> > > I added a function dbd_rebind_ph_nty for that purpose. You need to -> > > create that XMLType object first using the C function -> > > createxmlfromstring in xml.c. -> > -> > I there any chance you could post that as a context diff (diff -u ideally -> > or else diff -c)? It's much safer and more useful. Thanks. -> -> Good idea. Here's a diff -u of dbdimp.c. - -Thanks. - -> By the way: I have thougt about general support of named types, not just -> XMLType, but you need to get the type description (TDO) from somewhere. -> My code just checks if the perl variable is a blessed reference of -> "OCIXMLTypePtr". - -Doing the equivalent of m/^OCI(\w+)Ptr$/ and then calling OCITypeByName -with $1 uppercased might take us (or someone) a step further. - -> Also note that my code can't handle downloading of XMLType objects yet. - -I'll trust that some kind soul with an itch will send a patch :-) - -Thanks again Hendrik. - -Tim. - diff --git a/err_unsorted/err_xmltypebindplsql.msg b/err_unsorted/err_xmltypebindplsql.msg deleted file mode 100644 index 08faa725..00000000 --- a/err_unsorted/err_xmltypebindplsql.msg +++ /dev/null @@ -1,174 +0,0 @@ -From dbi-users-return-11068-Tim.Bunce=pobox.com@perl.org Thu Apr 25 11:02:42 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3PA2gK34525 - for ; Thu, 25 Apr 2002 11:02:42 +0100 (BST) - (envelope-from dbi-users-return-11068-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.21] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Thu, 25 Apr 2002 11:02:42 +0100 (BST) -Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1019721492:10:18778:60; Thu, 25 Apr 2002 07:58:12 GMT -Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net - id aa1109782; 25 Apr 2002 7:58 GMT -Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) - by dolly1.pobox.com (Postfix) with ESMTP id 791692BF11 - for ; Thu, 25 Apr 2002 03:58:08 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) - by dolly1.pobox.com (Postfix) with SMTP id 976FB2BEE4 - for ; Thu, 25 Apr 2002 03:58:07 -0400 (EDT) -Received: (qmail 84467 invoked by uid 1005); 25 Apr 2002 07:58:05 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 77923 invoked by uid 76); 24 Apr 2002 23:08:56 -0000 -Date: Wed, 24 Apr 2002 19:08:54 -0400 -From: Mark Stillwell -To: dbi-users-help@perl.org, dbi-users@perl.org -Subject: Oracle 9 XMLTYPE insert -Message-ID: <20020424190852.C22854@byrd.biostat.ufl.edu> -Mime-Version: 1.0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline -User-Agent: Mutt/1.2.5.1i -Status: RO -Content-Length: 1469 -Lines: 43 - -I'm using DBI 1.21 and DBD 1.12 with an oracle9i database backend. - -Here is my problem, I have a table named 'test' with three fields: eid -(integer), x (SYS.XMLTYPE) and formname (text) - -I create a database handler and connect to the database just fine. - -I create a new statement handler with the following command: - -$sth = $dbh->prepare("INSERT INTO test (eid, x, formname) VALUES (?, -SYS.XMLTYPE.CREATEXML(?), ?"); - -I loop over some data, $eid gets and integer, $xmlvalue gets a string, -and $formname gets a string. So long as $xmlvalue is relatively short -$sth->execute($eid, $xmlvalue, $formname); works great, but as soon as -it becomes long enough to force the use of clob's I have a problem. - -So I tried the following: - -$sth->bind_param(1, $i); -$sth->bind_param(2, $xmlvalue, { ora_type => ORA_CLOB }); -$sth->bind_param(3, $intable); -$sth->execute; - -This works great if column 'x' is a normal CLOB and I omit the -sys.xmltype.createxml statement above, but when 'x' is of type -sys.xmltype I get the following error: - -nvalid LOB locator specified -ORA-06512: at "SYS.XMLTYPE", line 0 - -Right now I've hacked the setup so there is a supplemental table called -'y' of type CLOB that I submit to, then I do $dbh->do("UPDATE test SET x -= SYS.XMLTYPE.CREATEXML(y)");, which works but doesn't seem like the -right way to do this. - -Is there any way to do what I want in the current version of -DBI/OracleDBD? - --- -Mark Stillwell -marklee@ufl.edu -http://plaza.ufl.edu/marklee/ - -From dbi-users-return-11340-Tim.Bunce=pobox.com@perl.org Wed May 8 16:11:46 2002 -Received: from localhost (localhost [127.0.0.1]) - by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g48FBjo24814 - for ; Wed, 8 May 2002 16:11:45 +0100 (BST) - (envelope-from dbi-users-return-11340-Tim.Bunce=pobox.com@perl.org) -Received: from pop3.mail.demon.net [194.217.242.59] - by localhost with POP3 (fetchmail-5.8.5) - for timbo@localhost (single-drop); Wed, 08 May 2002 16:11:45 +0100 (BST) -Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@data-plan.com - id 1020870336:20:08175:2; Wed, 08 May 2002 15:05:36 GMT -Received: from cali-3.pobox.com ([64.71.166.116]) by punt-2.mail.demon.net - id aa2109147; 8 May 2002 15:05 GMT -Received: from cali-3.pobox.com (localhost.localdomain [127.0.0.1]) - by cali-3.pobox.com (Postfix) with ESMTP id 68FE23E6D4 - for ; Wed, 8 May 2002 11:01:49 -0400 (EDT) -Delivered-To: tim.bunce@pobox.com -Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) - by cali-3.pobox.com (Postfix) with SMTP id 33A783E64D - for ; Wed, 8 May 2002 11:01:49 -0400 (EDT) -Received: (qmail 65232 invoked by uid 1005); 8 May 2002 15:01:47 -0000 -Mailing-List: contact dbi-users-help@perl.org; run by ezmlm -Precedence: bulk -List-Post: -List-Help: -List-Unsubscribe: -List-Subscribe: -Delivered-To: mailing list dbi-users@perl.org -Delivered-To: moderator for dbi-users@perl.org -Received: (qmail 60079 invoked by uid 76); 8 May 2002 14:50:53 -0000 -From: "Ben Middleton" -To: -Cc: -Subject: Re: Oracle 9 XMLTYPE insert -Date: Wed, 8 May 2002 15:50:47 +0100 -Message-ID: -MIME-Version: 1.0 -Content-Type: text/plain; - charset="iso-8859-1" -Content-Transfer-Encoding: 7bit -X-Priority: 3 (Normal) -X-MSMail-Priority: Normal -X-Mailer: Microsoft Outlook IMO, Build 9.0.2416 (9.0.2911.0) -Importance: Normal -X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2600.0000 -Status: RO -Content-Length: 1311 -Lines: 39 - -Hi. - -Not sure if you ever resolved this: - -> I'm using DBI 1.21 and DBD 1.12 with an oracle9i database backend. - -> Here is my problem, I have a table named 'test' with three fields: -> eid (integer), x (SYS.XMLTYPE) and formname (text) - -> I create a new statement handler with the following command: - -> $sth = $dbh->prepare("INSERT INTO test (eid, x, formname) VALUES (?, -> SYS.XMLTYPE.CREATEXML(?), ?"); - -.... - -> Invalid LOB locator specified -> ORA-06512: at "SYS.XMLTYPE", line 0 - -> Right now I've hacked the setup so there is a supplemental table -> called 'y' of type CLOB that I submit to, then I do $dbh->do("UPDATE -> test SET x= SYS.XMLTYPE.CREATEXML(y)");, which works but doesn't seem -> like the right way to do this. - -> Is there any way to do what I want in the current version of -> DBI/OracleDBD? - -I don't think that the current DBI/DBD can bind a CLOB to a PL/SQL function -(which is all the CREATEXML function is) - hence you will have to go with -the intermediate CLOB table solution. - -Incidentally, if you are using Oracle9i - have you tried using a TEMPORARY -TABLE with a CLOB column (see SQL Reference Guide)? If setup correctly, this -is automatically truncated at the end of a transaction, is managed by the -Server, and provides some efficiency benefits. We use this here quite -effectively. - -Ben. - - diff --git a/examples/bind.pl b/examples/bind.pl index 303d96be..1f179822 100755 --- a/examples/bind.pl +++ b/examples/bind.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # # bind.pl # @@ -31,7 +31,7 @@ last if ! $_; $sth->execute( uc( $_ ) ); - # Note that the variable is in parenthesis to give an array context + # Note that the variable is in parentheses to force array context if ( ( $created ) = $sth->fetchrow_array ) { print "$created\n"; } diff --git a/examples/commit.pl b/examples/commit.pl index e6e0da3c..bef60655 100755 --- a/examples/commit.pl +++ b/examples/commit.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # # commit.pl # diff --git a/examples/curref.pl b/examples/curref.pl index 5ecb0b32..3c464aa4 100755 --- a/examples/curref.pl +++ b/examples/curref.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # # curref.pl - by Geoffrey Young # diff --git a/examples/ex.pl b/examples/ex.pl index 95ffa322..bd2016a4 100755 --- a/examples/ex.pl +++ b/examples/ex.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # Short example using bind_columns() to list a table's values use DBI; diff --git a/examples/inserting_longs.pl b/examples/inserting_longs.pl new file mode 100644 index 00000000..056ce18a --- /dev/null +++ b/examples/inserting_longs.pl @@ -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; + + diff --git a/examples/mktable.pl b/examples/mktable.pl index 28d01007..570a16db 100755 --- a/examples/mktable.pl +++ b/examples/mktable.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # Sample DBI program to create a new table and load data into it. # # Author: Kevin Stock (original oraperl script) diff --git a/examples/ora_explain.pl b/examples/ora_explain.pl index 36e2b3d5..ef6f41b3 100644 --- a/examples/ora_explain.pl +++ b/examples/ora_explain.pl @@ -1063,7 +1063,7 @@ ($$) } busy(0); -# Display the formated info +# Display the formatted info return(1); } @@ -1309,7 +1309,7 @@ sub grab_main ### SQL selection $frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised"); -$frame->Label(-text => "SQL Selection Criterea")->pack(-anchor => "w"); +$frame->Label(-text => "SQL Selection Criteria")->pack(-anchor => "w"); $frame1 = $frame->Frame(-highlightthickness => 1); ## SQL sort frame @@ -1584,7 +1584,7 @@ =head1 DESCRIPTION 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 +Explain allows a user to interactively edit a SQL statement 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. @@ -1698,7 +1698,7 @@ =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 +"SQL Statement Statistics" and "SQL Selection Criteria". 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 @@ -1708,16 +1708,16 @@ =head2 Capture SQL Cache functionality 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 +highlight the statement 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 +The "SQL Selection Criteria" 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 +criteria, 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" diff --git a/examples/oradump.pl b/examples/oradump.pl index 5477c569..5b1109cf 100755 --- a/examples/oradump.pl +++ b/examples/oradump.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/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) diff --git a/examples/proc.pl b/examples/proc.pl index a8a65a14..6e06b42e 100755 --- a/examples/proc.pl +++ b/examples/proc.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # Short examples of procedure calls from Oracle.pm # These PL/SQL examples come from: Eric Bartley . @@ -121,7 +121,7 @@ BEGIN $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 +# The execute will automatically update the value of $is_odd $sth->execute; print "$test_num is ", $is_odd ? "odd - ok" : "even - error!", "\n"; @@ -130,7 +130,7 @@ BEGIN # 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. +# we can access its value after execute. my $whoami = ""; diff --git a/examples/read_long_via_blob_read.pl b/examples/read_long_via_blob_read.pl new file mode 100644 index 00000000..d5a011ae --- /dev/null +++ b/examples/read_long_via_blob_read.pl @@ -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"; +} + diff --git a/examples/tabinfo.pl b/examples/tabinfo.pl index 307bd6b1..82c7f2ba 100755 --- a/examples/tabinfo.pl +++ b/examples/tabinfo.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # # tabinfo # diff --git a/hints/macos_syms.pl b/hints/macos_syms.pl index 8fb418fd..41a07089 100644 --- a/hints/macos_syms.pl +++ b/hints/macos_syms.pl @@ -109,7 +109,7 @@ s/...........(\w+)\n/$1/; $oracle{$_} = 1; } -} +} close FH; diff --git a/hints/svr4.pl b/hints/svr4.pl index 28d9ea91..14a9a8a6 100644 --- a/hints/svr4.pl +++ b/hints/svr4.pl @@ -8,7 +8,7 @@ # modified by Davide Migliavacca if ($archname eq 'RM400-svr4') { - @libs = qw(-lucb); + @libs = qw(-lucb); } push @libs, '-lc'; @@ -31,19 +31,19 @@ On Fri, 18 Aug 1995, Tim Bunce wrote: > > From: Alan Burlison -> > +> > > > Tim, -> > -> > The following hints file is required for DBD::Oracle on svr4, you might +> > +> > The following hints file is required for DBD::Oracle on svr4, you might > > like to add it to the next release :-) -> > +> > > > File: Oracle/hints/svr4.pl -> > +> > > > # Some SVR4 systems may need to link against -lc to pick up things like > > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; > > Umm, 'some', 'may', 'things like'. Care to clarify? -> +> > Why _exactly_ is this needed, and why doesn't MakeMaker do this already? > (CC'd to the MakeMaker mailing list.) @@ -56,21 +56,21 @@ $att{LIBS} = ['-ldbm -lucb -lc']; ################################################################### -"Some" includes Unisys 6000 (or something like that). I don't know -if it includes anything else. It doesn't include Unixware 2.1, but it +"Some" includes Unisys 6000 (or something like that). I don't know +if it includes anything else. It doesn't include Unixware 2.1, but it might include Esix. It's *really* hard to get accurate info. -"May" because some do and some don't, and any listing gets out of date -quickly as vendors issue different versions, and probably more than -half the info you *do* get about specific versions is wrong. Hence all +"May" because some do and some don't, and any listing gets out of date +quickly as vendors issue different versions, and probably more than +half the info you *do* get about specific versions is wrong. Hence all the vague weasel-words. -"Things like" is ecvt() for Unisys (for ODBM_File). Since some linkers -only report the first missing symbol, it's sometimes hard (and +"Things like" is ecvt() for Unisys (for ODBM_File). Since some linkers +only report the first missing symbol, it's sometimes hard (and sometimes pointless) to get a complete list of things that you need). -Basically, there are *many* SVR4-derived systems out there, and there are -many little idiosyncracies; the best bet is to put someone else's name +Basically, there are *many* SVR4-derived systems out there, and there are +many little idiosyncracies; the best bet is to put someone else's name and email address in the hint file so you can blame them :-). Andy Dougherty doughera@lafcol.lafayette.edu @@ -79,25 +79,25 @@ From: Tye McQueen Subject: Re: [MM] Re: hints file for Oracle Date: Fri, 18 Aug 1995 16:01:39 -0500 (CDT) -Cc: aburlison@cix.compulink.co.uk, perldb-interest@vix.com, +Cc: aburlison@cix.compulink.co.uk, perldb-interest@vix.com, makemaker@franz.ww.tu-berlin.de Excerpts from the mail message of Tim Bunce: ) > From: Alan Burlison -) > -) > The following hints file is required for DBD::Oracle on svr4, you might +) > +) > The following hints file is required for DBD::Oracle on svr4, you might ) > like to add it to the next release :-) -) > +) > ) > File: Oracle/hints/svr4.pl -) > +) > ) > # Some SVR4 systems may need to link against -lc to pick up things like ) > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; ) ) Umm, 'some', 'may', 'things like'. Care to clarify? -) +) ) Why _exactly_ is this needed, and why doesn't MakeMaker do this already? ) (CC'd to the MakeMaker mailing list.) -) +) ) Is anyone else using DBD::Oracle on an svr4 system (not solaris 2)? That looks like something I wrote. I'll take credit and blame @@ -119,7 +119,7 @@ I'm putting together a README.svr4 for Perl that will describe this and many other things in case people are curious or run into a problem and need to know why some of the strange things were done. --- +-- Tye McQueen tye@metronet.com || tye@doober.usu.edu Nothing is obvious unless you are overlooking something http://www.metronet.com/~tye/ (scripts, links, nothing fancy) diff --git a/Oracle.pm b/lib/DBD/Oracle.pm similarity index 74% rename from Oracle.pm rename to lib/DBD/Oracle.pm index f4811a34..dee46fe6 100644 --- a/Oracle.pm +++ b/lib/DBD/Oracle.pm @@ -7,236 +7,252 @@ require 5.006; -$DBD::Oracle::VERSION = '1.33_00'; - my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; { - package DBD::Oracle; +package DBD::Oracle; + # VERSION +# ABSTRACT: Oracle database driver for the DBI module use DBI (); use DynaLoader (); use Exporter (); use DBD::Oracle::Object(); + $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_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)], + 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 ); + @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 + OCI_SPOOL_ATTRVAL_FORCEGET OCI_SPOOL_ATTRVAL_NOWAIT OCI_SPOOL_ATTRVAL_TIMEDWAIT + OCI_SPOOL_ATTRVAL_WAIT + ora_env_var ora_cygwin_set_env ora_shared_release); + #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; + require_version DBI 1.623; - bootstrap DBD::Oracle $VERSION; + DBD::Oracle->bootstrap($DBD::Oracle::VERSION); + DBD::Oracle::dr::init_globals() ; - $drh = undef; # holds driver handle once initialized + $drh = undef; # holds driver handle once initialized sub CLONE { - $drh = undef ; + $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("ora_lob_read"); - DBD::Oracle::db->install_method("ora_lob_write"); - DBD::Oracle::db->install_method("ora_lob_append"); - DBD::Oracle::db->install_method("ora_lob_trim"); - DBD::Oracle::db->install_method("ora_lob_length"); - DBD::Oracle::db->install_method("ora_lob_chunk_size"); - DBD::Oracle::db->install_method("ora_lob_is_init"); - DBD::Oracle::db->install_method("ora_nls_parameters"); - DBD::Oracle::db->install_method("ora_can_unicode"); - DBD::Oracle::db->install_method("ora_can_taf"); - DBD::Oracle::db->install_method("ora_db_startup"); - DBD::Oracle::db->install_method("ora_db_shutdown"); - DBD::Oracle::st->install_method("ora_fetch_scroll"); - DBD::Oracle::st->install_method("ora_scroll_position"); - DBD::Oracle::st->install_method("ora_ping"); - DBD::Oracle::st->install_method("ora_stmt_type_name"); - DBD::Oracle::st->install_method("ora_stmt_type"); - $drh; - + 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 et. al.", + }); + + 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; + # 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; + (my $constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname); + *$AUTOLOAD = sub { $val }; + goto &$AUTOLOAD; } } -{ package DBD::Oracle::dr; # ====== DRIVER ====== +{ package # hide from PAUSE + DBD::Oracle::dr; # ====== DRIVER ====== use strict; - my %dbnames = (); # holds list of known databases (oratab + tnsnames) + 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 = )) { - 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'; + my ($drh) = @_; + my $debug = $drh->debug; + my $oracle_home = DBD::Oracle::ora_env_var($ORACLE_ENV); + 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(my $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 ( @tns_admin ) { - next TNS_ADMIN unless $d and -f $d; - open FH, '<', "$d/tnsnames.ora" or next TNS_ADMIN; - - $drh->trace_msg("Loading $d/tnsnames.ora\n") if $debug; - local *_; - while () { - 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) + foreach $d ( grep { $_ and -d $_ } @tns_admin ) { + open my $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; + 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*/, $_, -1; - Carp::carp("DSN component '$_' is not in 'name=value' format") - unless defined $v && defined $n; + 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 ); + } split /\s*;\s*/, $dbname; + my %dbname = ( PROTOCOL => 'tcp', @dbname ); - if ((exists $dbname{SERVER}) and ($dbname{SERVER} eq "POOLED")) { + 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; + } + + # 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'){ @@ -244,62 +260,99 @@ my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; $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} } } + $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} + } + if (exists $ENV{ORA_DRCP_RLB}) { + $attr->{ora_drcp_rlb} = $ENV{ORA_DRCP_RLB} + } + + if (exists $ENV{ORA_EVENTS}) { + $attr->{ora_events} = $ENV{ORA_EVENTS}; + } + + if (exists $ENV{ORA_EVENTS}) { + $attr->{ora_events} = $ENV{ORA_EVENTS}; + } + + # ORA8 does not like when "user/passwd" is used. + # so, it makes sense to separate those. This was done + # in XS, but there one didn't distinguish between + # undef and '' as password. So, to make it backward + # compatible I do the same here. + # Ignore $user eq '/' since it is special case + if((!defined $auth || $auth eq '') && length($user) > 1) + { + my $idx = index($user, '/'); + if($idx >= 0) + { + $auth = substr($user, $idx + 1); + $user = substr($user, 0, $idx); + } + } + + { + 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; + DBD::Oracle::db::_login($dbh, $dbname, $user, $auth, $attr) + or return undef; + } + + unless (length $user_only) { + # It may be we've already encountered a warning by this point, + # such as "ORA-28002: the password will expire within %d days". + # We'll cache it for reinstatement. + my ($err, $errstr, $state) = + ($dbh->err, $dbh->errstr, $dbh->state); + $user_only = $dbh->selectrow_array(q{ + SELECT SYS_CONTEXT('userenv','session_user') FROM DUAL + })||''; + # Now we'll reinstate the earlier warning. We're just + # appending it, so in the extremely unlikely case that the + # selectrow_array we just issued also issued a warning, the + # 2 warnings will appear out of order. + $dbh->set_err($err, $errstr, $state) if defined $err; + $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; } @@ -310,26 +363,27 @@ my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; } -{ package DBD::Oracle::db; # ====== DATABASE ====== +{ package # hide from PAUSE + DBD::Oracle::db; # ====== DATABASE ====== use strict; use DBI qw(:sql_types); sub prepare { - my($dbh, $statement, @attribs)= @_; + my($dbh, $statement, @attribs)= @_; - # create a 'blank' sth + # create a 'blank' sth - my $sth = DBI::_new_sth($dbh, { - 'Statement' => $statement, - }); + my $sth = DBI::_new_sth($dbh, { + 'Statement' => $statement, + }); - # Call Oracle OCI parse func in Oracle.xs file. - # and populate internal handle data. + # Call Oracle OCI parse func in Oracle.xs file. + # and populate internal handle data. - DBD::Oracle::st::_prepare($sth, $statement, @attribs) - or return undef; + DBD::Oracle::st::_prepare($sth, $statement, @attribs) + or return undef; - $sth; + $sth; } #Ah! I see you have the machine that goes PING!! @@ -338,75 +392,73 @@ my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; #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; + 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; + 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, + 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 => undef, - ora_taf_function => undef, - ora_taf_sleep => undef, - + ora_dbh_share => undef, + ora_svchp => undef, + ora_errhp => undef, + ora_init_mode => undef, + ora_events => 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_drcp_rlb => 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'; + 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 @@ -414,9 +466,9 @@ SELECT NULL TABLE_CAT , NULL REMARKS FROM DUAL SQL - } - elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b - $SQL = <<'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 @@ -430,9 +482,9 @@ SELECT NULL TABLE_CAT ) 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'; + } + 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 @@ -450,53 +502,52 @@ SELECT NULL TABLE_CAT ) t ORDER BY TABLE_TYPE SQL - } - else { - $SQL = <<'SQL'; -SELECT * - FROM -( - SELECT /*+ RULE*/ - 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 -) + } + 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 ' + , '' ) || DECODE(mv.MVIEW_NAME, NULL, t.TABLE_TYPE, 'VIEW' ) TABLE_TYPE + , c.COMMENTS REMARKS + FROM ALL_TAB_COMMENTS c + RIGHT JOIN ALL_CATALOG t on t.OWNER = c.OWNER + and t.TABLE_NAME = c.TABLE_NAME + and t.TABLE_TYPE = c.TABLE_TYPE + LEFT JOIN ALL_MVIEWS mv on mv.OWNER = t.OWNER + and mv.MVIEW_NAME = t.TABLE_NAME + ) 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; + 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; } @@ -506,11 +557,11 @@ SQL ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'}; $catalog = undef; } - my $SQL = <<'SQL'; + my $SQL = <<'SQL'; SELECT * FROM ( - SELECT /*+ RULE*/ + SELECT /*+ CHOOSE */ NULL TABLE_CAT , c.OWNER TABLE_SCHEM , c.TABLE_NAME TABLE_NAME @@ -523,27 +574,28 @@ SELECT * AND p.TABLE_NAME = c.TABLE_NAME AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME AND p.CONSTRAINT_TYPE = 'P' + AND p.STATUS = 'ENABLED' ) 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; + 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 + 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 /*+ RULE*/ + SELECT /*+ CHOOSE */ to_char( NULL ) UK_TABLE_CAT , uk.OWNER UK_TABLE_SCHEM , uk.TABLE_NAME UK_TABLE_NAME @@ -574,43 +626,49 @@ SELECT * AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME AND uk.OWNER = fk.R_OWNER AND uc.POSITION = fc.POSITION + AND fk.STATUS = 'ENABLED' ) 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; + 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($typecase,$typecaseend) = ('',''); - if (ora_server_version($dbh)->[0] >= 8) { - $typecase = <<'SQL'; + 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'; - } - my $SQL = <<"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 /*+ RULE*/ + SELECT $choose to_char( NULL ) TABLE_CAT , tc.OWNER TABLE_SCHEM , tc.TABLE_NAME TABLE_NAME @@ -650,7 +708,10 @@ SELECT * ) , 'FLOAT' , tc.DATA_PRECISION , 'DATE' , 19 - , 'VARCHAR2' , tc.CHAR_LENGTH + , '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 @@ -721,305 +782,404 @@ SELECT * ) 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; + 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 ($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; + 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 ); + # 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); + 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; + 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; + 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; + 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; + 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%', 'Personal Oracle%') .'']; -SELECT version - FROM product_component_version - WHERE product LIKE ? or product LIKE ? + 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; + } + + # TODO looks like a bug that we don't return + # $dbh->{ora_server_version} here } sub ora_nls_parameters { - my $dbh = shift; - my $refresh = shift; + my $dbh = shift; + my $refresh = shift; - if ($refresh || !$dbh->{ora_nls_parameters}) { + 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; + 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. + 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; + return $dbh->{ora_can_unicode} + if defined $dbh->{ora_can_unicode} && !$refresh; - my $nls = $dbh->ora_nls_parameters($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/; + $dbh->{ora_can_unicode} = 0; + $dbh->{ora_can_unicode} += 1 if $nls->{NLS_NCHAR_CHARACTERSET} =~ m/UTF/; + $dbh->{ora_can_unicode} += 2 if $nls->{NLS_CHARACTERSET} =~ m/UTF/; - return $dbh->{ora_can_unicode}; + return $dbh->{ora_can_unicode}; } } # end of package DBD::Oracle::db -{ package DBD::Oracle::st; # ====== STATEMENT ====== +{ 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'; + 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, "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 + 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} ||= { }; + # 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; + return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen, $attr); + 1; } @@ -1027,7 +1187,7 @@ SQL sub execute_for_fetch { my ($sth, $fetch_tuple_sub, $tuple_status) = @_; my $row_count = 0; - my $err_count = 0; + my $err_total = 0; my $tuple_count="0E0"; my $tuple_batch_status; my $dbh = $sth->{Database}; @@ -1047,19 +1207,23 @@ SQL } 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 + if (defined($res)) { #no error $row_count += $res; - } else { + } + else { $row_count = undef; } - $tuple_count+=@$tuple_batch_status; + $err_total += $err_count; + + $tuple_count+=@tuple_batch; push @$tuple_status, @$tuple_batch_status if defined($tuple_status); @@ -1067,27 +1231,24 @@ SQL } #error check here - return $sth->set_err($DBI::stderr, "executing $tuple_count generated $err_count errors") - if $err_count; - - if (!wantarray) { - return $tuple_count; - } - - return ($tuple_count, defined $row_count ? $row_count : undef); - + 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 {ora_lengths => undef, - ora_types => undef, - ora_rowid => undef, - ora_est_row_width => undef, - ora_type => undef, - ora_fail_over => undef, - }; + return { map { $_ => undef } qw/ + ora_lengths + ora_types + ora_rowid + ora_est_row_width + ora_type + ora_fail_over + / }; } } @@ -1097,7 +1258,8 @@ __END__ =head1 NAME -DBD::Oracle - Oracle database driver for the DBI module +DBD::Oracle - Perl module for accessing Oracle + =head1 SYNOPSIS @@ -1128,7 +1290,7 @@ consult the L documentation first! =item :ora_session_modes -ORA_SYSDBA ORA_SYSOPER +ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM =item :ora_types @@ -1185,7 +1347,7 @@ These constants are used to set the orientation of a fetch on a scrollable curso =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_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY =back @@ -1198,10 +1360,24 @@ To open a connection to an Oracle database you need to specify a database connec The connection string is always of the form: "dbi:Oracle:" 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: + +=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: @@ -1233,7 +1409,7 @@ 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. +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. @@ -1298,9 +1474,9 @@ 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. The main use of the callback is to give your -program the opportunity to inform the user that a failover is taking -place. +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 @@ -1308,9 +1484,13 @@ callback with $dbh->ora_can_taf(); -If you try to set up a callback without it being enabled DBD::Oracle will croak. +If you try to set up a callback without it being enabled DBD::Oracle +will croak. -It is outside the scope of this documents to go through all of the +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: @@ -1334,12 +1514,18 @@ attempts another event. #import the ora fail over constants #set up TAF on the connection - my $dbh = DBI->connect('dbi:Oracle:XE','hr','hr',{ora_taf=>1,taf_sleep=>5,ora_taf_function=>'handle_taf'}); + # 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 { - my ($fo_event,$fo_type) = @_; + # 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"; @@ -1362,7 +1548,9 @@ attempts another event. print " Failed over user. Resuming services\n"; } elsif ($fo_event == OCI_FO_ERROR){ - print " Failover error Sleeping...\n"; + print " Failover error ...\n"; + sleep 5; # sleep before having another go + return OCI_FO_RETRY; } else { printf(" Bad Failover Event: %d.\n", $fo_event); @@ -1406,12 +1594,26 @@ For Oracle 11.2 or greater. Set to I<1> to enable DRCP. Can also be set via the C environment variable. +Note, this really enables Session pools on Client side. Each pool is identified +by DB, user, charsets and pool mode. The latter one can be affected by +B. Sessions are kept open after disconnect, so next connect may +pick up session that was previously used. That means that any "alter session" +changes can be still in effect. One may use B to mark such sessions. + +Of course this allows saving resources and speeding up connecting. This also works +across thread-boundaries, unlike connect_cached. So, if there are multiple threads +that constantly connect and disconnect, then this option is the best solution. +It may even work in situations of single thread where libraries have to obtain connection +only for short operation and then release it. + +The feature can be combined with actual configuring of DRCP on the Server side. +Then connecting to ':pooled' DNS shall also optimize use of resources on the Server +side, since this enables sharing of server sessions between client sessions. + =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 +as well. OCI will ensure that connections belonging to a 'class' are not shared outside the class'. The values for ora_drcp_class cannot contain a '*' and must be less @@ -1420,16 +1622,24 @@ than 1024 characters. This value can be also be specified with the C environment variable. +Note that a connection class must be specified in order to enable +inter-process sharing of Server side sessions (:pooled connections) + =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. +initially allocated for the application process. New sessions are only +allocated after this value has been reached. + +The default value is 0 and any value greater than or equal to 0 is valid. -The default value is 4 and any value above 0 is valid. +For multi-process applications, it is recommended to leave the value at 0. +This ensures that each process is only occupying a server session while +the process is doing database work. -Generally, it should be set to the number of concurrent statements the -application is planning or expecting to run. +For multi-threaded applications, the value could be set to the number of +concurrent statements the application is planning or expecting to run. +Please note that DRCP has not been tested with multi-threading. This value can also be specified with the C environment variable. @@ -1438,7 +1648,7 @@ variable. 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 +until one becomes free. The default value is 40 and any value above 0 is valid. You should not set this value lower than ora_drcp_min as that will just waste resources. @@ -1449,43 +1659,84 @@ variable. 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 +ora_drcp_max. The default value is 1 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 environment variable. +=head4 ora_drcp_mode + +By default, when count of open session reaches ora_drcp_max, the call to +connect shall block untill some session becomes free. One can change it +by setting this attribute to one of OCI_SPOOL_ATTRVAL_NOWAIT, +OCI_SPOOL_ATTRVAL_FORCEGET, OCI_SPOOL_ATTRVAL_TIMEDWAIT. The latter one +needs time in milliseconds, which is passed using attribute ora_drcp_wait. +Default value is OCI_SPOOL_ATTRVAL_WAIT. These contants can be imported +from DBD::Oracle. Important, functionality with OCI_SPOOL_ATTRVAL_TIMEDWAIT +and OCI_SPOOL_ATTRVAL_NOWAIT was added by Oracle somewhere after version +12, so to make it safe, DBD::Oracle supports it when compiled against +OCI with Version > 18 + + +=head4 ora_drcp_tag + +This is similar to ora_drcp_class, but it is not so strict. If session +with given tag does not exist, then another session is returned, One can +check tag of that session after connection. The tag can be changed by changing +this attribute. But change happens only at "disconnect". + +=head4 ora_drcp_rlb + +This optional value controls whether run-time connection load balancing +is used for Oracle RAC. The default value is 0, which disables the feature. +Set the value to 1 to enable the feature. + +This value can also be specified with the C environment +variable. + =head4 ora_taf -If your Oracle instance has been configured to use TAF events you can -enable the TAF callback by setting this option to any I value. +This attribute was removed in 1.49_00 as it was redundant. To +enable TAF simply set L. =head4 ora_taf_function -The name of the Perl subroutine 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 two parameters, the failover event value -and the failover type. Below is an example of a 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{ - my ($event, $type) = @_; + # 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 -The amount of time in seconds the OCI client will sleep between attempting -successive failover events when the event is OCI_FO_ERROR. +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 -authorization and SYSOPER authorization. -The ORA_SYSDBA and ORA_SYSOPER constants can be imported using +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); @@ -1507,6 +1758,8 @@ 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. +Note that this does not work with DRCP. + =head4 ora_oratab_orahome Passing a true value for the ora_oratab_orahome attribute will make @@ -1528,6 +1781,8 @@ monitoring and performance tuning purposes. For example: 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. @@ -1551,6 +1806,8 @@ retrieved on the server side from the Ca view. $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. @@ -1575,42 +1832,45 @@ on the server side using C view. $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. +Requires at least Perl 5.8.0 compiled with ithreads (interpreter-based +threads). -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. +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 +After shared connection is not needed any more, one should call -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. + DBD::Oracle::ora_shared_release($orashr); + +This shall close shared connection. The function can be imported into +current namespace (use DBD::Oracle qw/ora_shared_release/) -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. +Please keep in mind, this functionality is rather dangerous. One should not +use single connection in multiple threads at the same time, since access to server +is not atomic. There can be problems with transactions or fetching of rows. +It is much better to use sessions-pooling activated with B. -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_events + +Set this attribute to C<1> to enable Oracle Fast Application Notification +(FAN) in a new OCI environment. Can also be set via the C +environment variable. =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 for all but the first connect. +ncharset with the ora_charset and ora_ncharset attributes. These attributes override the settings from environment variables. @@ -1632,6 +1892,12 @@ or set it directly on the DB handle like this; 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 @@ -1742,10 +2008,22 @@ For example: 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 -Implemented by DBI, no driver-specific impact. -Please note that connect_cached as not been tested with DRCP. +Implemented by DBI, no driver-specific impact. +Please note that connect_cached has not been tested with DRCP. =head2 B @@ -1917,7 +2195,7 @@ DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE. =head2 B Starts a new session against the current database using the credentials -supplied. +supplied. Note that this does not work with DRCP. =head2 B @@ -2041,7 +2319,12 @@ Should be rarely needed. =head2 B -Implemented by DBI, no driver-specific impact. +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 @@ -2075,7 +2358,7 @@ $refresh parameter to it. =head2 B -Returns true if the current connection supports TAF events. False if otherise. +Returns true if the current connection supports TAF events. False if otherwise. =head2 B @@ -2083,6 +2366,16 @@ 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 + + $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 @@ -2133,7 +2426,7 @@ 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 for more details. +See L for more details. See also the LOB tests in 05dbi.t of Oracle::OCI for examples of how to use LOB Locators. @@ -2173,7 +2466,7 @@ only one mode is supported; OCI_STMT_SCROLLABLE_READONLY - make result set scrollable -See L for more details. +See L for more details. =item ora_prefetch_rows @@ -2198,13 +2491,17 @@ See L for more details. =head3 B -There are two 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 specs 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). +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). -The other placeholder type is "named parameters" in the format ":foo" which is the one Oralce prefers. +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"); @@ -2212,6 +2509,17 @@ The other placeholder type is "named parameters" in the format ":foo" which is t $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. @@ -2271,7 +2579,7 @@ a warning is given and no COMMIT is issued. Returns true on success, false on er 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. +false on error. =head2 B @@ -2406,7 +2714,11 @@ 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. +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. @@ -2425,6 +2737,40 @@ So in the example the exact case "Bla_BLA" must be used to get it info on the co any case can be used to get info on the column. +=head2 B + +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 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, i.e. as the user provides or +Oracle returns it. +See L for more detailed information. + =head2 B @row_ary = $dbh->selectrow_array($sql); @@ -2467,7 +2813,7 @@ handle, then trying to merge the attributes. See the DBI documentation for compl 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. +calling L. =head2 B (boolean) @@ -2529,11 +2875,11 @@ Prepare Attribute 'ora_prefetch_memory'. Tweaking these values may yield improve $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, +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 +fetch that sets the current position 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. @@ -2576,7 +2922,7 @@ to change just the type and will be overwriting the value later. 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, +use one of the values provided by DBI or by DBD::Oracle. To use a SQL value, modify your "use DBI" statement at the top of your script as follows: use DBI qw(:sql_types); @@ -2589,7 +2935,7 @@ encounter are: To use Oracle SQL data types, import the list of values like this: - use DBD::Pg qw(:ora_types); + use DBD::Oracle qw(:ora_types); You can then set the data types by setting the value of the C key in the hash passed to L. @@ -2609,7 +2955,7 @@ doing the next execute. Examples: use DBI qw(:sql_types); - use DBD::Pg qw(:ora_types); + use DBD::Oracle qw(:ora_types); $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?"; $sth = $dbh->prepare($SQL); @@ -2672,13 +3018,13 @@ Additional values when DBD::Oracle was built using OCI 9.2 and later: See L for the correct way to use ORA_RSET. -See L for how to use ORA_CLOB and ORA_BLOB. +See L for how to use ORA_CLOB and ORA_BLOB. See L for ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. See L for the correct way to use SQLT_CHR and SQLT_BIN. -See L for more information. +See L for more information. See also L. @@ -2778,7 +3124,7 @@ with code like this: $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'; + print 'returned id='.$id.'\n'; } Which will return all the ids into @out_values. @@ -2860,9 +3206,9 @@ 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) ; + Col1 NUMBER, + Col2 VARCHAR2 (10), + Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- @@ -2877,9 +3223,9 @@ package. Here's the new package specification and body : 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 ; + l_Ret (i).Col1 := i ; + l_Ret (i).Col2 := 'Row : ' || i ; + l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; @@ -2889,13 +3235,13 @@ package. Here's the new package specification and body : 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 - ) - ) ; + PIPE ROW ( + tArray_Example__taRec ( + l_Set (i).Col1, + l_Set (i).Col2, + l_Set (i).Col3 + ) + ) ; END LOOP ; RETURN ; END ; @@ -2912,10 +3258,6 @@ the above example, the code would look something like this : ... } - - - - =head3 B DBD::Oracle has built-in support for B @@ -2923,13 +3265,13 @@ and B datatypes. The simple example is here: my $statement=' DECLARE - tbl SYS.DBMS_SQL.VARCHAR2_TABLE; + tbl SYS.DBMS_SQL.VARCHAR2_TABLE; BEGIN - tbl := :mytable; - :cc := tbl.count(); - tbl(1) := \'def\'; - tbl(2) := \'ijk\'; - :mytable := tbl; + tbl := :mytable; + :cc := tbl.count(); + tbl(1) := \'def\'; + tbl(2) := \'ijk\'; + :mytable := tbl; END; '; @@ -2943,20 +3285,18 @@ and B datatypes. The simple example is here: } ) ; $sth->bind_param_inout(":cc", \$cc, 100 ); $sth->execute(); - print "Result: cc=",$cc,"\n", - "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; + print "Result: cc=",$cc,"\n", + "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; =over =item B -=item Take careful note that we use '\\@arr' here because the 'bind_param_inout' +=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 SYS.DBMS_SQL.VARCHAR2_TABLE object is always bound to array reference. @@ -3117,7 +3457,7 @@ DBI documentation for more details. 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 +If there are no more rows or if an error occurs, this method returns undef. You should check C<< $sth->err >> afterwards (or use the L attribute) to discover if the undef returned was due to an error. @@ -3138,9 +3478,9 @@ a reference to a list. Do not use this in a scalar context. $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 as undef value. +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 +If there are no more rows or if an error occurs, this method returns undef. You should check C<< $sth->err >> afterwards (or use the L attribute) to discover if the undef returned was due to an error. @@ -3199,9 +3539,9 @@ Column numbers count up from 1. You do not need to bind output columns in order 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 a numeric bind type with the bind attributes -StrictlyTyped/DiscardString as these attributes are applied after the -column is retrieved. +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> @@ -3376,11 +3716,11 @@ The minimum value will always be 1 after the first fetch. The maximum value will =item ora_fetch_scroll - @ary = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset); + $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset); -Works the same as fetchrow_array method however, one passes in a 'Fetch Orientation' constant and a fetch_offset +Works the same as C, 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. +Null fields are returned as I values in the list. The valid orientation constant and fetch offset values combination are detailed below @@ -3391,37 +3731,39 @@ The valid orientation constant and fetch offset values combination are detailed 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_RELATIVE, fetches the row relative from the current position as 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. +The effect that a ora_fetch_scroll method call has on the current position 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 + OCI_FETCH_CURRENT, has no effect on the current position attribute. + OCI_FETCH_NEXT, increments current position attribute by 1 + OCI_FETCH_NEXT, when at the last row in the record set does not change current position 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 + OCI_FETCH_FIRST, sets the current position attribute to 1. + OCI_FETCH_LAST, sets the current position 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 + OCI_FETCH_PRIOR, decrements current position attribute by 1. + OCI_FETCH_PRIOR, when at the first row in the record set does not change current position 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, sets the current position 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. + current position 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 + the record set, does not change current position attribute, it is equivalent to a OCI_FETCH_CURRENT. - OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute + + OCI_FETCH_RELATIVE, sets the current position attribute to (current position 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. @@ -3429,11 +3771,11 @@ The effect that a ora_fetch_scroll method call has on the current_positon attrib 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. +The effects of the differing orientation constants on the first fetch (current position 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 + OCI_FETCH_CURRENT, dose not fetch a row or change the current position attribute. + OCI_FETCH_FIRST, fetches row 1 and sets the current position attribute to 1. + OCI_FETCH_LAST, fetches the last row in the record set and sets the current position 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. @@ -3475,7 +3817,7 @@ method; 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, +The current position 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 @@ -3484,7 +3826,7 @@ if the record set is large this could take some time. 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. +The current position attribute will still be 20 after this snippet. =item Fetching the First Row @@ -3492,7 +3834,7 @@ The current_positon attribute will still be 20 after this snippet. 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. +The current position attribute will be 1 after this snippet. =item Fetching the Next Row @@ -3502,7 +3844,7 @@ The current_positon attribute will be 1 after this snippet. } print "current scroll position=".$sth->ora_scroll_position()."\n"; -The current_positon attribute will be 5 after this snippet. +The current position attribute will be 5 after this snippet. =item Fetching the Prior Row @@ -3512,7 +3854,7 @@ The current_positon attribute will be 5 after this snippet. } print "current scroll position=".$sth->ora_scroll_position()."\n"; -The current_positon attribute will be 1 after this snippet. +The current position attribute will be 1 after this snippet. =item Fetching the 10th Row @@ -3520,7 +3862,7 @@ The current_positon attribute will be 1 after this snippet. 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. +The current position attribute will be 10 after this snippet. =item Fetching the 10th to 14th Row @@ -3530,7 +3872,7 @@ The current_positon attribute will be 10 after this snippet. } print "current scroll position=".$sth->ora_scroll_position()."\n"; -The current_positon attribute will be 14 after this snippet. +The current position attribute will be 14 after this snippet. =item Fetching the 14th to 10th Row @@ -3540,7 +3882,7 @@ The current_positon attribute will be 14 after this snippet. } print "current scroll position=".$sth->ora_scroll_position()."\n"; -The current_positon attribute will be 10 after this snippet. +The current position attribute will be 10 after this snippet. =item Fetching the 5th Row From the Present Position. @@ -3548,7 +3890,7 @@ The current_positon attribute will be 10 after this snippet. 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. +The current position attribute will be 15 after this snippet. =item Fetching the 9th Row Prior From the Present Position @@ -3556,7 +3898,7 @@ The current_positon attribute will be 15 after this snippet. 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. +The current position attribute will be 6 after this snippet. =item Use Finish @@ -3570,7 +3912,7 @@ cursor has to be explicitly cancelled on the server. If you do not do this you m =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) +'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) 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. @@ -3587,9 +3929,9 @@ BLOBs and CLOBs treating them exactly as if they were the same as the legacy LON 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 +=item 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. +This allows the user direct access to the LOB Locator methods, so you have to take care of the LOB Locator operations yourself. =back @@ -3635,16 +3977,16 @@ 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'. +There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be larger than the expected size of the LONG or LONG RAW. +If the size of the LONG or LONG RAW exceeds 'LongReadLen' DBD::Oracle will return an '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) + id NUMBER, + long1 long) this code; @@ -3700,13 +4042,13 @@ In the case above the query Got 28 characters (well really only 20 characters of =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'. +To use this interface for the CLOB and BLOB datatypes set the 'ora_pers_lob' attribute of the statement handle to '1' with the prepare method, and +set the database handle's 'LongReadLen' attribute to a value that will be larger than the expected size of the LOB. If the size of the LOB exceeds +'LongReadLen' DBD::Oracle will return an '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. +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 your CLOB is longer than this +and also larger than 'LongReadLen' then 'LongReadLen' chars are returned. It seems with BLOBs you are not limited by the 64k. @@ -3742,9 +4084,9 @@ before the execute will return all the lobs but they will be truncated at 2MBs. 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 and L 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 +you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be larger than the expected +size of the LOB. Like the L and L the if the size of the LOB exceeds 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB +or set '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. @@ -3784,9 +4126,9 @@ maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer th 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 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 +you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be larger than the expected +size of the LOB. Like the L and Simple Fetches if the size of the LOB exceeds 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB +or set '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. Using the table from the example above this code; @@ -3871,7 +4213,7 @@ Below are the limitations of Remote LOBs; so the following returns an error: SELECT t1.lobcol, - a2.lobcol + a2.lobcol FROM t1, t2.lobcol@dbs2 a2 W WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol); @@ -4072,6 +4414,12 @@ handle are lost, the handle is destroyed and the locators are freed. 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); @@ -4568,9 +4916,9 @@ 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" + ( "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; @@ -4664,7 +5012,7 @@ The following code will access the data; print $obj1->attr('NAME')."3\n"; # 'Black' is printed print $obj2->attr('NAME')."3\n"; # 'Smith' is printed - # get all atributes as hash reference + # get all attributes as hash reference my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25} my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44, # 'SALARY' => 5000 } @@ -4770,8 +5118,7 @@ Examples: print "$i0 to $o0, $i1 to $o1\n"; # Result is : "'' to '(undef)', 'Something else' to '1'" - -=head4 Support for Insert of XMLType (ORA_XMLTYPE) +=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 @@ -4783,17 +5130,17 @@ one can insert data using this code $SQL='insert into books values (1,:p_xml)'; $xml= ' - - Programming the Perl DBI - The Cheetah Book - - T. Bunce - Alligator Descartes - - - - ... - '; + + Programming the Perl DBI + The Cheetah Book + + T. Bunce + Alligator Descartes + + + + ... + '; my $sth =$dbh-> prepare($SQL); $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE }); $sth-> execute(); @@ -4801,7 +5148,7 @@ one can insert data using this code 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. -=head4 Binding Cursors +=head2 Binding Cursors Cursors can be returned from PL/SQL blocks, either from stored functions (or procedures with OUT parameters) or @@ -4860,18 +5207,28 @@ closes a cursor: $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 +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 script in the Oracle.ex directory in the DBD::Oracle source distribution for a complete working example. -=head4 Fetching Nested Cursors +=head2 Fetching Nested Cursors Oracle supports the use of select list expressions of type REF CURSOR. These may be explicit cursor expressions - C, or @@ -4918,7 +5275,6 @@ shows: } } - The cursor returned by the function C defined in the previous section can be fetched as a nested cursor as follows: @@ -4927,7 +5283,7 @@ previous section can be fetched as a nested cursor as follows: my ($nested) = $sth->fetchrow_array; while ( my @row = $nested->fetchrow_array ) { ... } -=head4 Pre-fetching Nested Cursors +=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, @@ -5027,7 +5383,7 @@ Most of these PL/SQL examples come from: Eric Bartley . # See the DBI docs now if you're not familiar with RaiseError. $db->{RaiseError} = 1; - # Example 1 Eric Bartley + # Example 1 Eric Bartley # # 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 @@ -5044,7 +5400,7 @@ Most of these PL/SQL examples come from: Eric Bartley . $csr->execute; - # Example 2 Eric Bartley + # Example 2 Eric Bartley # # 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 @@ -5057,9 +5413,9 @@ Most of these PL/SQL examples come from: Eric Bartley . my $err_code = -20001; $csr = $db->prepare(q{ - BEGIN - PLSQL_EXAMPLE.PROC_IN(:err_code); - END; + BEGIN + PLSQL_EXAMPLE.PROC_IN(:err_code); + END; }); $csr->bind_param(":err_code", $err_code); @@ -5072,7 +5428,7 @@ Most of these PL/SQL examples come from: Eric Bartley . print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n"; - # Example 3 Eric Bartley + # Example 3 Eric Bartley # # 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 @@ -5087,9 +5443,9 @@ Most of these PL/SQL examples come from: Eric Bartley . my $is_odd; $csr = $db->prepare(q{ - BEGIN - PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd); - END; + BEGIN + PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd); + END; }); # The value of $test_num is _copied_ here @@ -5103,19 +5459,19 @@ Most of these PL/SQL examples come from: Eric Bartley . print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n"; - # Example 4 Eric Bartley + # Example 4 Eric Bartley # # 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. + # we can access its value after execute. my $whoami = ""; $csr = $db->prepare(q{ - BEGIN - :whoami := PLSQL_EXAMPLE.FUNC_NP; - END; + BEGIN + :whoami := PLSQL_EXAMPLE.FUNC_NP; + END; }); $csr->bind_param_inout(":whoami", \$whoami, 20); @@ -5150,64 +5506,6 @@ 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). 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. - -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 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 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 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 @@ -5216,13 +5514,6 @@ 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 Oracle Related Links - =head1 WHICH VERSION OF DBD::ORACLE IS FOR ME? From version 1.25 onwards DBD::Oracle only support Oracle clients @@ -5292,12 +5583,6 @@ It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go 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 PL/SQL function. -See L for the details. - =head1 SEE ALSO @@ -5311,11 +5596,11 @@ Oracle.ex directory =item DBD::Oracle Tutorial -http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-oracle.html +https://blog.pythian.com/wp-content/uploads/introduction-dbd-oracle.html =item Oracle Instant Client -http://www.oracle.com/technology/tech/oci/instantclient/index.html +https://www.oracle.com/database/technologies/instant-client/downloads.html =item Oracle on Linux @@ -5325,45 +5610,26 @@ http://www.ixora.com.au/ ora_explain supplied and installed with DBD::Oracle. -http://www.orafaq.com/ +https://www.orafaq.com/ -http://vonnieda.org/oracletool/ +https://www.oracletool.com/ =item Commercial Oracle Tools and Links Assorted tools and references for general information. No recommendation implied. -http://www.platinum.com - -http://www.SoftTreeTech.com +https://www.SoftTreeTech.com Also PL/Vision from RevealNet and Steven Feuerstein, and "Q" from Savant Corporation. =back -=head1 AUTHORS - -DBI by Tim Bunce L. - -The original C 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). - =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. - =cut diff --git a/lib/DBD/Oracle/GetInfo.pm b/lib/DBD/Oracle/GetInfo.pm index b1c088e3..0e31d9c4 100644 --- a/lib/DBD/Oracle/GetInfo.pm +++ b/lib/DBD/Oracle/GetInfo.pm @@ -1,7 +1,12 @@ +#!perl +# ABSTRACT: Wrapper to get Oracle information +use strict; +use warnings; + package DBD::Oracle::GetInfo; +# VERSION -use strict; -use DBD::Oracle(); +use DBD::Oracle (); my $sql_driver = 'Oracle'; my $sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.##### @@ -17,7 +22,7 @@ my $sql_driver_ver = sprintf $sql_ver_fmt, $a, $b, $c; sub sql_dbms_version { my $dbh = shift; local $^W; # for ora_server_version having too few parts - return sprintf $sql_ver_fmt, @{DBD::Oracle::db::ora_server_version($dbh)}; + return sprintf $sql_ver_fmt, @{DBD::Oracle::db::ora_server_version($dbh)}[0..2]; } my @Keywords = qw( @@ -89,27 +94,59 @@ sub sql_user_name { our %info = ( - 20 => 'Y', # SQL_ACCESSIBLE_PROCEDURES + 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 - 0 => 0, # SQL_ACTIVE_CONNECTIONS - 116 => 0, # SQL_ACTIVE_ENVIRONMENTS - 1 => 0, # SQL_ACTIVE_STATEMENTS - 169 => 64, # SQL_AGGREGATE_FUNCTIONS - 117 => 0, # SQL_ALTER_DOMAIN - 86 => 1029739, # SQL_ALTER_TABLE - 10021 => 2, # SQL_ASYNC_MODE - 120 => 0, # SQL_BATCH_ROW_COUNT - 121 => 0, # SQL_BATCH_SUPPORT - 82 => 88, # SQL_BOOKMARK_PERSISTENCE - 114 => 2, # SQL_CATALOG_LOCATION - 10003 => 'N', # SQL_CATALOG_NAME - 41 => '@', # SQL_CATALOG_NAME_SEPARATOR - 42 => 'Database Link', # SQL_CATALOG_TERM - 92 => 3, # SQL_CATALOG_USAGE - 10004 => '', # SQL_COLLATING_SEQUENCE - 10004 => '', # SQL_COLLATION_SEQ - 87 => 'Y', # SQL_COLUMN_ALIAS + 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 @@ -118,12 +155,7 @@ our %info = ( 58 => 10518015, # SQL_CONVERT_DECIMAL 59 => 10514943, # SQL_CONVERT_DOUBLE 60 => 10514943, # SQL_CONVERT_FLOAT - 48 => 1, # SQL_CONVERT_FUNCTIONS - 173 => 0, # SQL_CONVERT_GUID 61 => 10518015, # SQL_CONVERT_INTEGER - 123 => 0, # SQL_CONVERT_INTERVAL_DAY_TIME - 124 => 0, # SQL_CONVERT_INTERVAL_YEAR_MONTH - 71 => 265216, # SQL_CONVERT_LONGVARBINARY 62 => 14680833, # SQL_CONVERT_LONGVARCHAR 63 => 10518015, # SQL_CONVERT_NUMERIC 64 => 10514943, # SQL_CONVERT_REAL @@ -133,10 +165,62 @@ our %info = ( 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 - 74 => 2, # SQL_CORRELATION_NAME 127 => 0, # SQL_CREATE_ASSERTION 128 => 0, # SQL_CREATE_CHARACTER_SET 129 => 0, # SQL_CREATE_COLLATION @@ -145,29 +229,7 @@ our %info = ( 132 => 14305, # SQL_CREATE_TABLE 133 => 0, # SQL_CREATE_TRANSLATION 134 => 3, # SQL_CREATE_VIEW - 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR - 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR - 10001 => 1, # SQL_CURSOR_SENSITIVITY - 16 => 'DEVEL', # SQL_DATABASE_NAME - 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME - 25 => 'N', # SQL_DATA_SOURCE_READ_ONLY - 119 => 0, # SQL_DATETIME_LITERALS - 17 => 'Oracle', # SQL_DBMS_NAME - 18 => \&sql_dbms_version, # SQL_DBMS_VER - 18 => \&sql_dbms_version, # SQL_DBMS_VERSION - 170 => 3, # SQL_DDL_INDEX - 26 => 8, # SQL_DEFAULT_TRANSACTION_ISOLATION - 26 => 8, # SQL_DEFAULT_TXN_ISOLATION - 10002 => 'Y', # SQL_DESCRIBE_PARAMETER - 171 => '03.52.0002.0002', # SQL_DM_VER - 3 => 147209344, # SQL_DRIVER_HDBC # 135 => undef, # SQL_DRIVER_HDESC - 4 => 147212776, # SQL_DRIVER_HENV -# 76 => undef, # SQL_DRIVER_HLIB -# 5 => undef, # SQL_DRIVER_HSTMT - 6 => $INC{'DBD/Oracle.pm'}, # SQL_DRIVER_NAME - 77 => '03.52', # SQL_DRIVER_ODBC_VER - 7 => $sql_driver_ver, # SQL_DRIVER_VER 136 => 0, # SQL_DROP_ASSERTION 137 => 0, # SQL_DROP_CHARACTER_SET 138 => 0, # SQL_DROP_COLLATION @@ -178,107 +240,15 @@ our %info = ( 143 => 1, # SQL_DROP_VIEW 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 - 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY - 8 => 191, # SQL_FETCH_DIRECTION - 84 => 0, # SQL_FILE_USAGE 146 => 57345, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 147 => 2183, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 - 81 => 15, # SQL_GETDATA_EXTENSIONS - 88 => 2, # SQL_GROUP_BY - 28 => 1, # SQL_IDENTIFIER_CASE - 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR 148 => 3, # SQL_INDEX_KEYWORDS 149 => 65568, # SQL_INFO_SCHEMA_VIEWS - 172 => 7, # SQL_INSERT_STATEMENT - 73 => 'N', # SQL_INTEGRITY 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 - 89 => \&sql_keywords, # SQL_KEYWORDS - 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE - 78 => 1, # SQL_LOCK_TYPES - 34 => 0, # SQL_MAXIMUM_CATALOG_NAME_LENGTH - 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 - 30 => 30, # SQL_MAXIMUM_COLUMN_NAME_LENGTH - 1 => 0, # SQL_MAXIMUM_CONCURRENT_ACTIVITIES - 31 => 30, # SQL_MAXIMUM_CURSOR_NAME_LENGTH - 0 => 0, # SQL_MAXIMUM_DRIVER_CONNECTIONS - 10005 => 30, # SQL_MAXIMUM_IDENTIFIER_LENGTH - 102 => 0, # SQL_MAXIMUM_INDEX_SIZE - 104 => 0, # SQL_MAXIMUM_ROW_SIZE - 32 => 30, # SQL_MAXIMUM_SCHEMA_NAME_LENGTH - 105 => 0, # SQL_MAXIMUM_STATEMENT_LENGTH -# 20000 => undef, # SQL_MAXIMUM_STMT_OCTETS -# 20001 => undef, # SQL_MAXIMUM_STMT_OCTETS_DATA -# 20002 => undef, # SQL_MAXIMUM_STMT_OCTETS_SCHEMA - 106 => 0, # SQL_MAXIMUM_TABLES_IN_SELECT - 35 => 30, # SQL_MAXIMUM_TABLE_NAME_LENGTH - 107 => 30, # SQL_MAXIMUM_USER_NAME_LENGTH - 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS - 112 => 0, # SQL_MAX_BINARY_LITERAL_LEN - 34 => 0, # SQL_MAX_CATALOG_NAME_LEN - 108 => 0, # SQL_MAX_CHAR_LITERAL_LEN - 97 => 0, # SQL_MAX_COLUMNS_IN_GROUP_BY - 98 => 0, # SQL_MAX_COLUMNS_IN_INDEX - 99 => 0, # SQL_MAX_COLUMNS_IN_ORDER_BY - 100 => 1000, # SQL_MAX_COLUMNS_IN_SELECT - 101 => 1000, # SQL_MAX_COLUMNS_IN_TABLE - 30 => 30, # SQL_MAX_COLUMN_NAME_LEN - 1 => 0, # SQL_MAX_CONCURRENT_ACTIVITIES - 31 => 30, # SQL_MAX_CURSOR_NAME_LEN - 0 => 0, # SQL_MAX_DRIVER_CONNECTIONS - 10005 => 30, # SQL_MAX_IDENTIFIER_LEN - 102 => 0, # SQL_MAX_INDEX_SIZE - 32 => 30, # SQL_MAX_OWNER_NAME_LEN - 33 => 92, # SQL_MAX_PROCEDURE_NAME_LEN - 34 => 0, # SQL_MAX_QUALIFIER_NAME_LEN - 104 => 0, # SQL_MAX_ROW_SIZE - 103 => 'N', # SQL_MAX_ROW_SIZE_INCLUDES_LONG - 32 => 30, # SQL_MAX_SCHEMA_NAME_LEN - 105 => 0, # SQL_MAX_STATEMENT_LEN - 106 => 0, # SQL_MAX_TABLES_IN_SELECT - 35 => 30, # SQL_MAX_TABLE_NAME_LEN - 107 => 30, # SQL_MAX_USER_NAME_LEN - 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN - 36 => 'Y', # SQL_MULT_RESULT_SETS - 111 => 'N', # SQL_NEED_LONG_DATA_LEN - 75 => 1, # SQL_NON_NULLABLE_COLUMNS - 85 => 1, # SQL_NULL_COLLATION - 49 => 16646015, # SQL_NUMERIC_FUNCTIONS - 9 => 1, # SQL_ODBC_API_CONFORMANCE 152 => 3, # SQL_ODBC_INTERFACE_CONFORMANCE - 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE - 15 => 1, # SQL_ODBC_SQL_CONFORMANCE - 73 => 'N', # SQL_ODBC_SQL_OPT_IEF - 10 => '03.52', # SQL_ODBC_VER - 115 => 127, # SQL_OJ_CAPABILITIES - 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT - 38 => 'Y', # SQL_OUTER_JOINS - 115 => 127, # SQL_OUTER_JOIN_CAPABILITIES - 39 => 'Owner', # SQL_OWNER_TERM - 91 => 31, # SQL_OWNER_USAGE 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS 154 => 3, # SQL_PARAM_ARRAY_SELECTS - 80 => 7, # SQL_POSITIONED_STATEMENTS - 79 => 1, # SQL_POS_OPERATIONS - 21 => 'Y', # SQL_PROCEDURES - 40 => 'Procedure', # SQL_PROCEDURE_TERM - 114 => 2, # SQL_QUALIFIER_LOCATION - 41 => '@', # SQL_QUALIFIER_NAME_SEPARATOR - 42 => 'Database Link', # SQL_QUALIFIER_TERM - 92 => 3, # SQL_QUALIFIER_USAGE - 93 => 3, # SQL_QUOTED_IDENTIFIER_CASE - 11 => 'Y', # SQL_ROW_UPDATES - 39 => 'Owner', # SQL_SCHEMA_TERM - 91 => 31, # SQL_SCHEMA_USAGE - 43 => 7, # SQL_SCROLL_CONCURRENCY - 44 => 19, # SQL_SCROLL_OPTIONS - 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE - 13 => sub {"$_[0]->{Name}"}, # SQL_SERVER_NAME - 94 => '$#', # SQL_SPECIAL_CHARACTERS 155 => 0, # SQL_SQL92_DATETIME_FUNCTIONS 156 => 0, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE 157 => 0, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE @@ -290,26 +260,25 @@ our %info = ( 163 => 0, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR 164 => 0, # SQL_SQL92_STRING_FUNCTIONS 165 => 1, # SQL_SQL92_VALUE_EXPRESSIONS - 118 => 1, # SQL_SQL_CONFORMANCE 166 => 3, # SQL_STANDARD_CLI_CONFORMANCE 167 => 57935, # SQL_STATIC_CURSOR_ATTRIBUTES1 168 => 4231, # SQL_STATIC_CURSOR_ATTRIBUTES2 - 83 => 0, # SQL_STATIC_SENSITIVITY - 50 => 8355839, # SQL_STRING_FUNCTIONS - 95 => 31, # SQL_SUBQUERIES - 51 => 7, # SQL_SYSTEM_FUNCTIONS - 45 => 'Table', # SQL_TABLE_TERM - 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS - 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS - 52 => 1023999, # SQL_TIMEDATE_FUNCTIONS - 46 => 3, # SQL_TRANSACTION_CAPABLE - 72 => 10, # SQL_TRANSACTION_ISOLATION_OPTION - 46 => 3, # SQL_TXN_CAPABLE - 72 => 10, # SQL_TXN_ISOLATION_OPTION - 96 => 3, # SQL_UNION - 96 => 3, # SQL_UNION_STATEMENT - 47 => \&sql_user_name, # SQL_USER_NAME + 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; diff --git a/lib/DBD/Oracle/Object.pm b/lib/DBD/Oracle/Object.pm index 4af4cdbc..faca14fc 100644 --- a/lib/DBD/Oracle/Object.pm +++ b/lib/DBD/Oracle/Object.pm @@ -1,24 +1,27 @@ -package DBD::Oracle::Object; - -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; \ No newline at end of file +#!perl +# ABSTRACT: Wrapper for Oracle objects +use strict; +use warnings; + +package DBD::Oracle::Object; +# VERSION + +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; diff --git a/lib/DBD/Oracle/Troubleshooting.pm b/lib/DBD/Oracle/Troubleshooting.pm deleted file mode 100644 index c0675fe9..00000000 --- a/lib/DBD/Oracle/Troubleshooting.pm +++ /dev/null @@ -1,407 +0,0 @@ -=pod - -=head1 NAME - -DBD::Oracle::Troubleshooting - Tips and Hints to Troubleshoot DBD::Oracle - -=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, F, F) 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). - - -=head1 LONGS - -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 algorithm... - - 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. - -=head2 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"; - } - -=head2 Example for inserting LONGS - - # 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; - -=head1 LINUX - -=head2 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 - -=head2 undefined symbol: __cmpdi2 comes up when Oracle isn't properly linked to the libgcc.a library. - -In version 8, this was correctd 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. - - -=head2 cc1: invalid option `tune=pentium4'" error - -If you get the above it seems that eiter 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 - -=head2 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. - -=head2 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. - -=head2 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 - -=head2 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 work arounds - - 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 CYGWIN - -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. - -=head2 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'); - -=head2 SUN - -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. - -=head2 VMS - -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 examble by changing NLS_LANG. - -PERL has the abillity 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 enviroment 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 functionallity, 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 :) - -=cut diff --git a/lib/DBD/Oracle/Troubleshooting.pod b/lib/DBD/Oracle/Troubleshooting.pod new file mode 100644 index 00000000..bb0a82c9 --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting.pod @@ -0,0 +1,125 @@ +#PODNAME: DBD::Oracle::Troubleshooting +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle + +=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, F, F) 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 +and L +for more gory details. + + +=head1 USING THE LONG TYPES + +Some examples related to the use of LONG types are available in +the C directory of the distribution. + +=head1 Can't find I + +I 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 to a different machine or Oracle version. +If DBD::Oracle was built on a machine with a different path to I +then you'll need to set an environment variable, typically +I, to include the directory containing I. + +I 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 set to include the path to I +or create a symbolic link so that I 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 bind_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. diff --git a/lib/DBD/Oracle/Troubleshooting/Aix.pod b/lib/DBD/Oracle/Troubleshooting/Aix.pod new file mode 100644 index 00000000..c2eda4c6 --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Aix.pod @@ -0,0 +1,250 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Aix +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on AIX + +=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 successful -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: + + 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 + ======================= + 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. + + -------------------------------------------------------------------------------------- + + diff --git a/lib/DBD/Oracle/Troubleshooting/Cygwin.pod b/lib/DBD/Oracle/Troubleshooting/Cygwin.pod new file mode 100644 index 00000000..ba1ab97d --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Cygwin.pod @@ -0,0 +1,67 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Cygwin +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Cygwin + +=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'); diff --git a/README.hpux.txt b/lib/DBD/Oracle/Troubleshooting/Hpux.pod similarity index 85% rename from README.hpux.txt rename to lib/DBD/Oracle/Troubleshooting/Hpux.pod index 0c483d00..26e98b01 100644 --- a/README.hpux.txt +++ b/lib/DBD/Oracle/Troubleshooting/Hpux.pod @@ -1,3 +1,6 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Hpux +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on HP-UX + =head1 INTRODUCTION Building a working dynamically linked version of the Oracle DBD driver @@ -12,7 +15,7 @@ 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 describes the combined knowledge of a number of +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 @@ -39,7 +42,7 @@ scope of this document, some information can be found in the section L, or see your friendly Oracle DBA. One final remark, 3 years after this was first written. This has been -updated numberous times over the years. And some of the new biuld +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 @@ -86,9 +89,6 @@ 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 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 @@ -113,7 +113,7 @@ 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 prefered over +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. @@ -124,7 +124,7 @@ versions of the compiler are unreliable. Both Roger Foskett, I and most others have been using the HP Softbench C compiler normally installed in: - /opt/softbench/bin/cc. + /opt/softbench/bin/cc. While the DBD-Oracle F checks for some of the conditions which, when met, we know will produce a working build, there are many @@ -166,11 +166,6 @@ 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, 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 @@ -179,19 +174,6 @@ instructions provided by Gram Ludlow, using the default /usr/bin/cc bundled compiler. Please note that perl itself will I build using that compiler. -=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 F. 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.8.8 @@ -200,7 +182,7 @@ 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 +We want to build a Perl that understands large files (over 2GB, which 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: @@ -216,17 +198,15 @@ 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. -I use this in my standard build now. (See F) - When asked: Any additional cc flags? - Answer by prepending: I<+Z> to enable - position independant code. + position independent code. For example: Any additional cc flags? [-D_HP-UX_SOURCE -Aa] -Ae +Z -z -Though this should be the default inmore recent perl versions. +Though this should be the default in more recent perl versions. Lastly, and this is optional, when asked: @@ -330,9 +310,9 @@ If you have trouble, see the L 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 +=head1 Trouble Shooting -=head2 "Unresolved symbol" +=head2 "Unresolved symbol" In general, find the symbols, edit the Makefile, and make test. @@ -386,9 +366,9 @@ 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 + 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). @@ -430,11 +410,11 @@ is b present. and that B 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 +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 + perl -pi -e's/-Wl,\+[sn]//' Makefile =head1 Building on a Oracle Client Machine @@ -563,7 +543,7 @@ caused problems on HP (the user 'www' may need to be created) =head1 CONTRIBUTORS -The following folks contributed to this README: +The following folks contributed to this document: Lincoln A. Baxter H.Merijn Brand @@ -572,7 +552,7 @@ The following folks contributed to this README: Weiguo Sun Tony Foiani Hugh J. Hitchcock - Heiko Herms + Heiko Herms Waldemar Zurowski Michael Schuh Gram M. Ludlow @@ -584,74 +564,15 @@ And probably others unknown to me. Lincoln A. Baxter H.Merijn Brand -=head1 EXAMPLE FILES - -Example files have been split off this document to README-files/hpux/ - -=head2 Lincoln's Makefile - -Lincoln's Makefile can be found in README-files/hpux/Makefile-Lincoln - -It contains the text of the makefile Lincoln uses to build Perl on all -platforms he runs on. - -=head2 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. - -=head3 Lincoln Baxter's DBD-Oracle-1.07 Configuration - -See F - -=head3 Lincoln Baxter's DBD-Oracle-1.06 Configuration - -See F - -=head3 Roger Foskett's Configuration (works with Apache and mod_perl) - -See F - -Roger also provides a link to some threads containing some of his -DBD-Oracle and HP-UX 11 trials... -L - -=head3 Mike Shuh's Configuration. - -See also appendix C - -See F - -=head3 H.Merijn Brand's Configurations - -See -F, -F, -F, -F, -F, -F, -F, -F, -F, and -F - -=head3 RE problem with libjava.sl - -A copy of the message Lincoln received from Jon Stevenson concerning a -problem with the libjava.sl can be found in L. -Note that the gcc build described in L 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. - =head1 APPENDICES -=head2 Appendix A (gcc build info from Waldemar Zurowski) +=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. Differences for building on -PA-RISC2.0 would be welcome and incorporated into the next README. +that this build was on a PA-RISC1.1 machine. =head3 Host @@ -702,7 +623,7 @@ Please note output of ldd command: [...] 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 +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 @@ -728,12 +649,14 @@ 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) +=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 +another application that required SH_LIBRARY_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 @@ -803,7 +726,7 @@ Then unpack and build: 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 enviroment +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. @@ -826,7 +749,9 @@ ships Oracle 9 and up for HP-UX only in 64bit builds. make test make install -=head2 Appendix C (Miscellaneous links which might be useful) +=head2 Appendix C + +(Miscellaneous links which might be useful) Michael Schuh writes: @@ -872,12 +797,10 @@ statements, etc.: 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 +(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. -The output of perl -V can be found in README-files/hpux/Conf-Mike - =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 @@ -885,11 +808,13 @@ 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 not from from the SAS support people documenting the +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) +=head1 Appendix D + +(Why Dynamic Linking) Some one posted to the DBI email list the following question: @@ -913,7 +838,7 @@ 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 +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. @@ -921,21 +846,23 @@ warnings;". However, it was annoying, since all my scripts had -w in the 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. +Dynamically 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) +=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 +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 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 @@ -946,35 +873,37 @@ The solution from this page is below; To work around this problem, complete the following procedure: -=item 1 Log in to your Oracle account: +=over + +=item 1 Log in to your Oracle account: - su - oracle + su - oracle -=item 2 In a text editor, open the following file: +=item 2 In a text editor, open the following file: $ORACLE_HOME/rdbms/admin/shrept.lst -=itme 3 Add the following line: - +=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. +=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 +=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 + 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. diff --git a/lib/DBD/Oracle/Troubleshooting/Linux.pod b/lib/DBD/Oracle/Troubleshooting/Linux.pod new file mode 100644 index 00000000..d42d728a --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Linux.pod @@ -0,0 +1,123 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Linux +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Linux + +=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); diff --git a/README.macosx.txt b/lib/DBD/Oracle/Troubleshooting/Macos.pod similarity index 72% rename from README.macosx.txt rename to lib/DBD/Oracle/Troubleshooting/Macos.pod index e854e4c6..21b3352a 100644 --- a/README.macosx.txt +++ b/lib/DBD/Oracle/Troubleshooting/Macos.pod @@ -1,3 +1,8 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Macos +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on MacOs + +=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 @@ -9,8 +14,8 @@ 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 + Installing Perl 5.8 on Jaguar + http://developer.apple.com/internet/macosx/perl.html for Perl 5.8.0 installation instructions. @@ -47,41 +52,50 @@ 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. -====================================================================== -Instructions for 10.7.x (Lion) +=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. +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 * -Because the 64 bit instantclient is currently [incompatible with Lion][], -DBD::Oracle can only be compiled with the 32-bit instantclient libraries, and -therefore requires 32-bit Perl. If your Perl is 64-bit (which, by default, it -is on Mac OS X), you will not be able to build DBD::Oracle until an updated -64-bit instantclient is released. +Download and install the basic, sqlplus, and sdk instantclient libraries and +install them in a central location, such as F. +L -[incompatible with Lion]: http://only4left.jpiwowar.com/2011/08/instant-client-osx-lion-32-bit-only/ +=item * -If you have a 32-bit Perl, however, then the following steps should work: +Create a symlink from F to F: -* Download and install the 32-bit basic, sqlplus, and sdk instantclient - libraries and install them in a central location, such as - `/usr/oracle_instantclient`. [Downloads here][]. - - [Downloads here]: http://www.oracle.com/technetwork/topics/intel-macsoft-096467.html + cd /usr/oracle_instantclient/ + ln -s libclntsh.dylib.* libclntsh.dylib + ln -s libocci.dylib.* libocci.dylib -* Create a symlink from `libclntsh.dylib.10.1` to `libclntsh.dylib`: +=item * - cd /usr/oracle_instantclient/ - link -s libclntsh.dylib.10.1 libclntsh.dylib +Update your environment to point to the libraries: -* Update your environment to point to the libraries: + export ORACLE_HOME=/usr/oracle_instantclient + export DYLD_LIBRARY_PATH=$DYLD_LIBRARY_PATH:/usr/oracle_instantclient - 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: +You should now be able to install DBD::Oracle from CPAN: cpan DBD::Oracle -====================================================================== -Instructions for 10.6.x (Snow Leopard) +=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 @@ -170,8 +184,7 @@ install DBI Now you're all set - enjoy your perly oracley new life -====================================================================== -Instructions for 10.2.x (Jaguar) +=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. @@ -226,102 +239,102 @@ follow nonetheless. 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 + +=+=+=+=+=+=+= 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: @@ -343,8 +356,7 @@ diff -c ../IO-orig/IO-1.20/poll.h ./poll.h $ make test $ make install -====================================================================== -Instructions for 10.3.x (Panther) +=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 @@ -388,34 +400,34 @@ That said, here are the details. 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 + +=+=+=+=+=+=+= 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 @@ -498,16 +510,13 @@ 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 - + 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 -To: -Message-ID: +From: Danial Pearce In regards to a previous message on this list: @@ -546,6 +555,3 @@ anything Apple are going to do about it. cheers Danial - -PS: Personal replies please, I have not subscribed to this list. - diff --git a/lib/DBD/Oracle/Troubleshooting/Sun.pod b/lib/DBD/Oracle/Troubleshooting/Sun.pod new file mode 100644 index 00000000..3fe61c40 --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Sun.pod @@ -0,0 +1,31 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Sun +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Sun + +=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. diff --git a/lib/DBD/Oracle/Troubleshooting/Vms.pod b/lib/DBD/Oracle/Troubleshooting/Vms.pod new file mode 100644 index 00000000..ec4aff78 --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Vms.pod @@ -0,0 +1,85 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Vms +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Vms + +=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 :) diff --git a/lib/DBD/Oracle/Troubleshooting/Win32.pod b/lib/DBD/Oracle/Troubleshooting/Win32.pod new file mode 100644 index 00000000..59130f5a --- /dev/null +++ b/lib/DBD/Oracle/Troubleshooting/Win32.pod @@ -0,0 +1,238 @@ +#PODNAME: DBD::Oracle::Troubleshooting::Win32 +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win32 + +=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 against 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 skipped 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. diff --git a/README.win64.txt b/lib/DBD/Oracle/Troubleshooting/Win64.pod similarity index 96% rename from README.win64.txt rename to lib/DBD/Oracle/Troubleshooting/Win64.pod index 7f423e2b..d0575fda 100644 --- a/README.win64.txt +++ b/lib/DBD/Oracle/Troubleshooting/Win64.pod @@ -1,4 +1,7 @@ -DBD::Oracle and Windows 64bit +#PODNAME: DBD::Oracle::Troubleshooting::Win64 +#ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win64 + +=head1 DBD::Oracle and Windows 64bit I have successfully compiled and installed DBD::Oracle on Windows 2008 server 64bit operating system today. @@ -115,6 +118,7 @@ The main thing to remember is you will have to compile using 32 bit Perl and com 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 @@ -157,15 +161,7 @@ else to support this configuration). SET ORACLE_SID=xyz123 <== SID of Production Database - SET NLS_LANG=.WE8ISO8859P1 <== Default Language from Database (preceeding "." Is required) + 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 - - -Hopefully, you will be able to include these instructions in the next build of DBD::Oracle to help out other poor souls that are fighting -this same battle. - - - - diff --git a/maint/Dockerfile b/maint/Dockerfile new file mode 100644 index 00000000..cc0e0bfa --- /dev/null +++ b/maint/Dockerfile @@ -0,0 +1,35 @@ +FROM perl:5.32.1-threaded-buster + +# This will install Oracle XE database and the Oracle SDK to make developing easier +# It leans on the same scripts used by travis, so they can be tweaked here too + +# build then run this throw away docker image with: +# cd DBD-Oracle +# docker build -f maint/Dockerfile . -t testoracle +# docker run -it testoracle +# perl Makefile.PL +# make +# make test + +# Adjust the FROM line to pick a perl version and distro. See also https://hub.docker.com/_/perl +# Adjust the two variables below to set the Oracle XE server version and client version + +ENV ORACLEDBV=11.2 \ + ORACLEV=19.6 + +# These are used by DBD::Oracle unit tests +ENV ORACLE_USERID=kermit/foobar \ + ORACLE_USERID_2=mspiggy/barfoo \ + ORACLE_DSN='dbi:Oracle://localhost:1521/XE' + +COPY . /usr/src/DBD-Oracle +RUN apt-get update && apt-get install -y libaio-dev && \ + apt-get install -y vim less net-tools && \ + cpanm --verbose --notest --installdeps /usr/src/DBD-Oracle && \ + /usr/src/DBD-Oracle/maint/scripts/01_install_oracle_xe.bash && \ + /usr/src/DBD-Oracle/maint/scripts/02_install_oracle_instantclient.bash && \ + sync && /etc/init.d/oracle-xe stop && apt-get clean + +WORKDIR /usr/src/DBD-Oracle + +CMD /usr/src/DBD-Oracle/maint/docker-init.sh diff --git a/maint/docker-init.sh b/maint/docker-init.sh new file mode 100755 index 00000000..4ab8db49 --- /dev/null +++ b/maint/docker-init.sh @@ -0,0 +1,7 @@ +#!/bin/sh + +set -ex + +/etc/init.d/oracle-xe start + +bash -l diff --git a/maint/scripts/01_install_oracle_xe.bash b/maint/scripts/01_install_oracle_xe.bash new file mode 100755 index 00000000..06796910 --- /dev/null +++ b/maint/scripts/01_install_oracle_xe.bash @@ -0,0 +1,68 @@ +#!/bin/bash + +set -ex + +# 11.2 +if [ "$ORACLEDBV" = "11.2" ]; then + +# wget --content-disposition https://packagecloud.io/mojotech/cloud/packages/debian/jessie/oracle-xe_11.2.0-1.0_amd64.deb/download.deb + +## This is a pile of sucky suck suck + +pwd +wget --quiet https://raw.githubusercontent.com/wnameless/docker-oracle-xe-11g/master/assets/oracle-xe_11.2.0-1.0_amd64.debaa +wget --quiet https://raw.githubusercontent.com/wnameless/docker-oracle-xe-11g/master/assets/oracle-xe_11.2.0-1.0_amd64.debab +wget --quiet https://raw.githubusercontent.com/wnameless/docker-oracle-xe-11g/master/assets/oracle-xe_11.2.0-1.0_amd64.debac +cat oracle-xe_11.2.0-1.0_amd64.deba* > oracle-xe_11.2.0-1.0_amd64.deb +sha256sum oracle-xe_11.2.0-1.0_amd64.deb +dpkg --install oracle-xe_11.2.0-1.0_amd64.deb + +# Hack needed because oracle configuration looks for awk in /bin instead of $PATH +ln -s /usr/bin/awk /bin/awk +# Oracle also needs this: +mkdir -p /var/lock/subsys + +# Docker containers and stuff dont work with memory_target +perl -pi -e 's/^(memory_target=.*)/#$1/' /u01/app/oracle/product/11.2.0/xe/config/scripts/init.ora +perl -pi -e 's/^(memory_target=.*)/#$1/' /u01/app/oracle/product/11.2.0/xe/config/scripts/initXETemp.ora + +# These seem to be needed too +echo -e "pga_aggregate_target=200540160\nsga_target=601620480" >> /u01/app/oracle/product/11.2.0/xe/config/scripts/init.ora +echo -e "pga_aggregate_target=200540160\nsga_target=601620480" >> /u01/app/oracle/product/11.2.0/xe/config/scripts/initXETemp.ora + +# Now configure Oracle XE +printf 8080\\n1521\\nadminpass\\nadminpass\\ny\\n | /etc/init.d/oracle-xe configure + +# Replace the containers hostname with 0.0.0.0 +sed -i 's/'$(hostname)'/0.0.0.0/g' /u01/app/oracle/product/11.2.0/xe/network/admin/listener.ora +sed -i 's/'$(hostname)'/0.0.0.0/g' /u01/app/oracle/product/11.2.0/xe/network/admin/tnsnames.ora + +sqlplusbin="/u01/app/oracle/product/11.2.0/xe/bin/sqlplus" +# ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" $sqlplusbin -H +USER1=`echo $ORACLE_USERID|sed 's/\/.*//'` +USER2=`echo $ORACLE_USERID_2|sed 's/\/.*//'` +PASS1=`echo $ORACLE_USERID|sed 's/.*\///'` +PASS2=`echo $ORACLE_USERID_2|sed 's/.*\///'` + +echo "create user $USER1 identified by $PASS1;" \ + | ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" \ + $sqlplusbin -L -S SYSTEM/adminpass +ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" $sqlplusbin -L -S SYSTEM/adminpass <<< "grant connect,resource to $USER1;" + +echo "create user $USER2 identified by $PASS2;" \ + | ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" \ + $sqlplusbin -L -S SYSTEM/adminpass +ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" $sqlplusbin -L -S SYSTEM/adminpass <<< "grant connect,resource to $USER2;" + +# ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" $sqlplusbin -L -S SYSTEM/adminpass @/dev/stdin <<< "create database dbusasci character set US7ASCII national character set utf8 undo tablespace undotbs1 default temporary tablespace temp;" +# ORACLE_SID=XE ORACLE_HOME="/u01/app/oracle/product/11.2.0/xe" $sqlplusbin -L -S SYSTEM/adminpass @/dev/stdin <<< "create database dbutf character set AL32UTF8 national character set AL16UTF16 undo tablespace undotbs1 default temporary tablespace temp;" + + +fi + + +if [ "$ORACLEDBV" = "18" ]; then + +echo "TODO See https://github.com/fuzziebrain/docker-oracle-xe/blob/master/Dockerfile" + +fi diff --git a/maint/scripts/02_install_oracle_instantclient.bash b/maint/scripts/02_install_oracle_instantclient.bash new file mode 100755 index 00000000..6d69cc43 --- /dev/null +++ b/maint/scripts/02_install_oracle_instantclient.bash @@ -0,0 +1,101 @@ +#!/bin/bash + +set -ex + +if [ "$ORACLEV" == "11.2" ]; then + export LONGV="11.2.0.4.0" +fi +if [ "$ORACLEV" == "12.2" ]; then + export LONGV="12.2.0.1.0" +fi +if [ "$ORACLEV" == "18.3" ]; then + export LONGV="18.3.0.0.0" +fi +if [ "$ORACLEV" == "18.5" ]; then + export LONGV="18.5.0.0.0" +fi +if [ "$ORACLEV" == "19.6" ]; then + export LONGV="19.6.0.0.0" +fi + +SUFFIX="" +if [ -n "$ORACLEV" ]; then + if [[ "$ORACLEV" == "18.3" || "$ORACLEV" == "18.5" || "$ORACLEV" == "19.6" ]]; then + SUFFIX="dbru" + fi + echo "Installing Oracle SDK $ORACLEV" + mkdir /etc/oracle + mkdir -p "/usr/lib/oracle/$ORACLEV/client/bin" + mkdir -p "/usr/lib/oracle/$ORACLEV/client/lib" + mkdir -p "/usr/include/oracle/$ORACLEV/client" + mkdir -p "/usr/share/oracle/$ORACLEV/client" + pushd `pwd` + cd /usr/lib/oracle + for i in "basic" "sdk" "sqlplus"; do + # Repo intended for Dockerfiles, see https://github.com/bumpx/oracle-instantclient/blob/master/README.md + wget --quiet "https://github.com/bumpx/oracle-instantclient/raw/master/instantclient-$i-linux.x64-$LONGV$SUFFIX.zip" + done + for i in `ls *zip`; do unzip $i; done +fi +if [[ "$ORACLEV" == "12.2" || "$ORACLEV" == "18.3" || "$ORACLEV" == "18.5" || "$ORACLEV" == "19.6" ]]; then + STUB=$(echo $ORACLEV | sed 's/\./_/') + MAJOR=$(echo $ORACLEV | sed 's/\.[0-9]//') + echo "# Moving contents of instantclient-basic-linux.x64-$LONGV$SUFFIX.zip" + find "instantclient_$STUB" + mv "instantclient_$STUB/adrci" "$ORACLEV/client/bin/" + mv "instantclient_$STUB/genezi" "$ORACLEV/client/bin/" + mv "instantclient_$STUB/uidrvci" "$ORACLEV/client/bin/" + mv instantclient_$STUB/{libclntshcore.so.$MAJOR.1,libclntsh.so.$MAJOR.1,libipc1.so,libmql1.so,libnnz$MAJOR.so,libocci.so.$MAJOR.1,libociei.so,libocijdbc$MAJOR.so,liboramysql$MAJOR.so,ojdbc8.jar,xstreams.jar} $ORACLEV/client/lib/ + if [ "$MAJOR" != "19" ]; then + mv "instantclient_$STUB/libons.so" "$ORACLEV/client/lib/" + fi + echo "# Moving contents of instantclient-sqlplus-linux.x64-$LONGV.zip" + mv "instantclient_$STUB/sqlplus" "$ORACLEV/client/bin/" + mv "instantclient_$STUB/glogin.sql" "instantclient_$STUB/libsqlplus.so" "instantclient_$STUB/libsqlplusic.so" "$ORACLEV/client/lib/" + echo "# Moving contents of instantclient-sdk-linux.x64-$LONGV$SUFFIX.zip" + mv instantclient_$STUB/sdk/include/*h /usr/include/oracle/$ORACLEV/client/ + mv instantclient_$STUB/sdk/demo/* /usr/share/oracle/$ORACLEV/client/ + mv instantclient_$STUB/sdk/ott /usr/share/oracle/$ORACLEV/client/ + mv instantclient_$STUB/sdk/ottclasses.zip $ORACLEV/client/lib/ottclasses.zip + ln -s "libclntshcore.so.$MAJOR.1" "$ORACLEV/client/lib/libclntshcore.so" + ln -s "libclntsh.so.$MAJOR.1" "$ORACLEV/client/lib/libclntsh.so" + ln -s "libocci.so.$MAJOR.1" "$ORACLEV/client/lib/libocci.so" + echo "# FYI What wasnt moved from Oracle zip files:" + find "instantclient_$STUB" + echo "# Clean up" + rm -rf "instantclient_$STUB" +fi +if [ "$ORACLEV" = "11.2" ]; then + echo "# Moving contents of instantclient-basic-linux.x64-$LONGV.zip" + mv instantclient_11_2/adrci $ORACLEV/client/bin/ + mv instantclient_11_2/genezi $ORACLEV/client/bin/ + mv instantclient_11_2/uidrvci $ORACLEV/client/bin/ + mv instantclient_11_2/{libclntsh.so.11.1,libnnz11.so,libocci.so.11.1,libociei.so,libocijdbc11.so,ojdbc5.jar,ojdbc6.jar,xstreams.jar} $ORACLEV/client/lib/ + echo "# Moving contents of instantclient-sqlplus-linux.x64-$LONGV.zip" + mv instantclient_11_2/sqlplus $ORACLEV/client/bin/ + mv instantclient_11_2/glogin.sql instantclient_11_2/libsqlplus.so instantclient_11_2/libsqlplusic.so $ORACLEV/client/lib/ + echo "# Moving contents of instantclient-sdk-linux.x64-$LONGV.zip" + mv instantclient_11_2/sdk/include/*h /usr/include/oracle/$ORACLEV/client/ + mv instantclient_11_2/sdk/demo/* /usr/share/oracle/$ORACLEV/client/ + mv instantclient_11_2/sdk/ott /usr/share/oracle/$ORACLEV/client/ + mv instantclient_11_2/sdk/ottclasses.zip $ORACLEV/client/lib/ottclasses.zip + ln -s libclntsh.so.11.1 $ORACLEV/client/lib/libclntsh.so + ln -s libocci.so.11.1 $ORACLEV/client/lib/libocci.so + echo "# FYI What wasnt moved from Oracle zip files:" + find instantclient_11_2 + echo "# Clean up" + rm -rf instantclient_11_2 +fi +if [ -n "$ORACLEV" ]; then + echo "# Place paths in ENV" + echo "export ORACLE_HOME=/usr/lib/oracle/$ORACLEV/client" >> /etc/profile.d/oracle.sh + echo "export PATH=\$PATH:\$ORACLE_HOME/bin" >> /etc/profile.d/oracle.sh + echo "export TNS_ADMIN=/etc/oracle" >> /etc/profile.d/oracle.sh + echo "export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:\$ORACLE_HOME/lib" >> /etc/profile.d/oracle.sh + echo "/usr/lib/oracle/$ORACLEV/client/lib" > /etc/ld.so.conf.d/oracle-instantclient.conf + echo "# Make sure stuff is +x" + chmod +x $ORACLEV/client/bin/* + ldconfig + popd + cat /etc/profile +fi diff --git a/maint/scripts/03_install_oracle_instantclient_rpm.bash b/maint/scripts/03_install_oracle_instantclient_rpm.bash new file mode 100755 index 00000000..91e30ca4 --- /dev/null +++ b/maint/scripts/03_install_oracle_instantclient_rpm.bash @@ -0,0 +1,29 @@ +#!/bin/bash + +set -ex + +if [ "$ORACLEV" = "latest" ]; then + # Get lastest RPMs from Oracle Client permanent links + for i in "basic" "devel" "sqlplus"; do + wget --quiet "https://download.oracle.com/otn_software/linux/instantclient/oracle-instantclient-$i-linuxx64.rpm" + done + + # Convert rpm to deb pkgs + alien -k *.rpm + dpkg -i *.deb + + find /usr/lib/oracle + + ORACLEV=$(ls /usr/lib/oracle | sed 's/\///') + + echo "# Place paths in ENV" + echo "export ORACLE_HOME=/usr/lib/oracle/$ORACLEV/client64" >> /etc/profile.d/oracle.sh + echo "export PATH=\$PATH:\$ORACLE_HOME/bin" >> /etc/profile.d/oracle.sh + echo "export TNS_ADMIN=/etc/oracle" >> /etc/profile.d/oracle.sh + echo "export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:\$ORACLE_HOME/lib" >> /etc/profile.d/oracle.sh + echo "/usr/lib/oracle/$ORACLEV/client64/lib" > /etc/ld.so.conf.d/oracle-instantclient.conf + echo "# Make sure stuff is +x" + chmod +x /usr/lib/oracle/$ORACLEV/client64/bin/* + ldconfig + cat /etc/profile +fi diff --git a/mkta.pl b/mkta.pl index f6da46b4..8db6b51e 100755 --- a/mkta.pl +++ b/mkta.pl @@ -1,4 +1,4 @@ -#!/bin/env perl -w +#!/bin/env perl # mkta - make-test-all # @@ -7,6 +7,8 @@ # keep log files from failures use strict; +use warnings; + use Symbol; local $| = 1; @@ -26,13 +28,13 @@ 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); +my @cs_utf8 = (ORA_OCI() < 9.2) ? ('UTF8') : ('AL32UTF8', ($opt_full) ? ('UTF8') : ()); +my @cs_8bit = ($opt_full) ? ('WE8ISO8859P1', 'WE8MSWIN1252') : ('WE8MSWIN1252'); +my @charsets = (q||, @cs_utf8, @cs_8bit); # need to add in: -# multiple perl versions/achitectures -# multiple oracle versions +# multiple perl versions/achitectures +# multiple oracle versions for my $sid (@sid) { mkta_sid_cs($sid, \@charsets); @@ -43,34 +45,34 @@ sub mkta_sid_cs { my $start_time = time; local $ENV{ORACLE_SID} = $sid; - my $dbh = DBI->connect("dbi:Oracle:", $dbuser, undef, { PrintError=>0 }); + my $dbh = DBI->connect('dbi:Oracle:', $dbuser, undef, { PrintError=>0 }); unless ($dbh) { (my $errstr = $DBI::errstr) =~ s/\n.*//s; - push @{ $skipped{$errstr} }, $sid; - return; + push @{ $skipped{$errstr} }, $sid; + return; } mkdir $opt_dir, 0771 unless -d $opt_dir; print "$sid: testing with @$charsets ...\n"; - system("make") == 0 + 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 ]; - } + # 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(); + 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; @@ -92,13 +94,13 @@ sub start_test { } sub wait_for_tests { - while(%running) { + while (keys %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}; + my $tag = $running[0] or die; + close $running{ $tag }; + printf "$tag: %s\n", ($?) ? "FAILED" : "pass"; + push @fail, $tag if $?; + delete $running{$tag}; } } diff --git a/oci8.c b/oci8.c index 351410ba..921f2a9d 100644 --- a/oci8.c +++ b/oci8.c @@ -15,6 +15,7 @@ #include #endif +#undef sv_set_undef #define sv_set_undef(sv) if (SvROK(sv)) sv_unref(sv); else SvOK_off(sv) DBISTATE_DECLARE; @@ -40,6 +41,10 @@ dbd_init_oci(dbistate_t *dbistate) { dTHX; DBIS = dbistate; + // Use Perl's IO to print debug messages that this function has been called + // and announce the thread (tid) using STDERR. + // tracer(DBIS, 3, 3, "# dbd_init_oci() called by thread %ld\n", (long)PERL_GET_THX); + // PerlIO_printf(PerlIO_stderr(), "# dbd_init_oci called by thread %ld\n", (long)PERL_GET_THX); } void @@ -109,7 +114,7 @@ oci_ptype_name(int ptype) return SvPVX(sv); } */ - + char * oci_exe_mode(ub4 mode) { @@ -156,6 +161,7 @@ sql_typecode_name(int dbtype) { case 97: return "CHARZ"; case 100: return "BINARY FLOAT oracle-endian"; case 101: return "BINARY DOUBLE oracle-endian"; + case 104: return "ROWID"; case 106: return "MLSLABEL"; case 102: return "SQLT_CUR OCI 7 cursor variable"; case 112: return "SQLT_CLOB / long"; @@ -163,7 +169,7 @@ sql_typecode_name(int dbtype) { 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 */ + case ORA_XMLTYPE: return "ORA_XMLTYPE or SQLT_NTY";/* SQLT_NTY must be careful here as its value (108) is the same for an embedded object Well really only XML clobs not embedded objects */ } sv = sv_2mortal(newSVpv("",0)); @@ -288,7 +294,9 @@ oci_mode(ub4 mode) dTHX; SV *sv; switch (mode) { - case 3: return "THREADED | OBJECT"; + case OCI_THREADED | OCI_OBJECT: return "THREADED | OBJECT"; + case OCI_OBJECT | OCI_EVENTS: return "OBJECT | EVENTS"; + case OCI_THREADED | OCI_OBJECT | OCI_EVENTS: return "THREADED | OBJECT | EVENTS"; case OCI_DEFAULT: return "DEFAULT"; /* the default value for parameters and attributes */ /*-------------OCIInitialize Modes / OCICreateEnvironment Modes -------------*/ @@ -323,10 +331,10 @@ oci_mode(ub4 mode) /*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 */ + case OCI_LOGON2_PROXY: return "LOGON2_PROXY"; /* Proxy authentication */ /*------------------------- 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_HOMOGENEOUS: return "SPC_HOMOGENEOUS"; ""; Session pool is homogeneous */ /*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 ---------------------------*/ @@ -542,7 +550,7 @@ oci_attr_name(ub4 attr) 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_MAXDATA_SIZE: return "OCI_ATTR_MAXDATA_SIZE"; /* Maximum size 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 */ @@ -681,8 +689,8 @@ oci_attr_name(ub4 attr) 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 */ + case OCI_ATTR_SUBSCR_RECPT: return "OCI_ATTR_SUBSCR_RECPT"; /* recipient of subscription */ + case OCI_ATTR_SUBSCR_RECPTPROTO: return "OCI_ATTR_SUBSCR_RECPTPROTO";/* protocol for recipient */ /* 8.2 dpapi support of ADTs */ case OCI_ATTR_DIRPATH_EXPR_TYPE: return "OCI_ATTR_DIRPATH_EXPR_TYPE"; /* expr type of OCI_ATTR_NAME */ @@ -697,7 +705,7 @@ oci_attr_name(ub4 attr) 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_LDAP_CTX: return "OCI_ATTR_LDAP_CTX"; /* LDAP administration 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 */ @@ -740,7 +748,7 @@ oci_attr_name(ub4 attr) 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_RESERVED_5: return "OCI_ATTR_RESERVED_5"; /* reserved */ 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 */ @@ -754,7 +762,7 @@ oci_attr_name(ub4 attr) 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 --------------------- */ + /* --------------------------- Miscellaneous 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 */ @@ -778,9 +786,12 @@ oci_attr_name(ub4 attr) 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)); @@ -812,7 +823,8 @@ oci_fetch_options(ub4 fetchtype) static sb4 -oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug) +oci_error_get(imp_xxh_t *imp_xxh, + OCIError *errhp, sword status, char *what, SV *errstr, int debug) { dTHX; text errbuf[1024]; @@ -834,12 +846,13 @@ oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug) } while( ++recno - && OCIErrorGet_log_stat(errhp, recno, (text*)NULL, &eg_errcode, errbuf, + && 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(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", + PerlIO_printf(DBIc_LOGPIO(imp_xxh), + " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", what ? what : "", (long)recno, (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status), status, (long)eg_errcode, errbuf); @@ -871,14 +884,28 @@ oci_error_err(SV *h, OCIError *errhp, sword status, char *what, sb4 force_err) dTHX; D_imp_xxh(h); sb4 errcode; + int utf8_is_implied = 0; SV *errstr_sv = sv_newmortal(); SV *errcode_sv = sv_newmortal(); - errcode = oci_error_get(errhp, status, what, errstr_sv, DBIS->debug); - if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) { + errcode = oci_error_get(imp_xxh, errhp, status, what, errstr_sv, + DBIc_DBISTATE(imp_xxh)->debug); + + if(DBIc_TYPE(imp_xxh) == DBIt_ST) + { + imp_sth_t * imp_sth = (imp_sth_t*)imp_xxh; + D_imp_dbh_from_sth; + utf8_is_implied = CSFORM_IMPLIES_UTF8(imp_dbh, SQLCS_IMPLICIT); + } + else if(DBIc_TYPE(imp_xxh) == DBIt_DB) + utf8_is_implied = CSFORM_IMPLIES_UTF8((imp_dbh_t *)imp_xxh, SQLCS_IMPLICIT); + else if(DBIc_TYPE(imp_xxh) == DBIt_DR) + utf8_is_implied = 0; + + if (utf8_is_implied) { #ifdef sv_utf8_decode - sv_utf8_decode(errstr_sv); + sv_utf8_decode(errstr_sv); #else - SvUTF8_on(errstr_sv); + SvUTF8_on(errstr_sv); #endif } @@ -1051,14 +1078,14 @@ dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) - OCIHandleAlloc_ok(imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status); - OCIStmtPrepare_log_stat(imp_sth->stmhp, imp_sth->errhp, + 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 (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare"); - OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status); return 0; } @@ -1066,8 +1093,10 @@ dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status); - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s ( auto_lob%d, check_sql%d)\n", + 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); @@ -1119,7 +1148,7 @@ dbd_phs_in(dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, phs->alen = 0; phs->indp = 0; } - else + else if (SvOK(phs->sv)) { *bufpp = SvPV(phs->sv, phs_len); phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;; @@ -1130,15 +1159,20 @@ dbd_phs_in(dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, phs->alen = 0; phs->indp = -1; } - *alenp = phs->alen; - *indpp = &phs->indp; - *piecep = OCI_ONE_PIECE; - 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); + *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; } @@ -1213,23 +1247,26 @@ dbd_phs_out(dvoid *octxp, OCIBind *bindp, sv_setpv(sv,""); } - *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 : phs->maxlen)+1)/*for null*/); + *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 @@ -1281,7 +1318,7 @@ presist_lob_fetch_cbk(dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp, } -/* TAF or Trasarent Application Failoever callback +/* 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. @@ -1292,14 +1329,25 @@ 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; - call_pv(cb->function, G_DISCARD); + 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){ @@ -1312,8 +1360,9 @@ taf_cbk(dvoid *svchp, dvoid *envhp, dvoid *fo_ctx,ub4 fo_type, ub4 fo_event ) } case OCI_FO_ERROR: { - sleep(cb->sleep); - return OCI_FO_RETRY; + if (ret == OCI_FO_RETRY) { + return OCI_FO_RETRY; + } break; } @@ -1322,35 +1371,34 @@ taf_cbk(dvoid *svchp, dvoid *envhp, dvoid *fo_ctx,ub4 fo_type, ub4 fo_event ) break; } } + PUTBACK; + return 0; } sb4 -reg_taf_callback( imp_dbh_t *imp_dbh) +reg_taf_callback(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; OCIFocbkStruct tafailover; sword status; - taf_callback_t *cb = NULL; -/*allocate space for the callback */ - Newz(1, cb, 1, taf_callback_t); - cb->function= (char*)safemalloc(strlen(imp_dbh->taf_function)); - cb->sleep = imp_dbh->taf_sleep; - strcpy((char *)cb->function,imp_dbh->taf_function); + + imp_dbh->taf_ctx.function = imp_dbh->taf_function; + imp_dbh->taf_ctx.dbh_ref = newRV_inc(dbh); if (dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, " In reg_taf_callback\n"); + 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 = cb; + tafailover.fo_ctx = &imp_dbh->taf_ctx; tafailover.callback_function = &taf_cbk; /* register the callback */ - OCIAttrSet_log_stat(imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER, - (dvoid *) &tafailover, (ub4) 0, - (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status); + 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; } @@ -1427,15 +1475,18 @@ fetch_func_varfield(SV *sth, imp_fbh_t *fbh, SV *dest_sv) return 0; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " fetching field %d of %d. LONG value truncated from %lu to %lu.\n", + 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); - if (CSFORM_IMPLIES_UTF8(fbh->csform)) + if (CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform)) SvUTF8_on(dest_sv); } else { #else @@ -1451,6 +1502,7 @@ static void fetch_cleanup_rset(SV *sth, imp_fbh_t *fbh) { dTHX; + D_imp_sth(sth); SV *sth_nested = (SV *)fbh->special; fbh->special = NULL; @@ -1465,8 +1517,8 @@ fetch_cleanup_rset(SV *sth, imp_fbh_t *fbh) if (fbh_nested->fetch_cleanup) fbh_nested->fetch_cleanup(sth_nested, fbh_nested); } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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)); @@ -1487,10 +1539,11 @@ fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv) HV *init_attr = newHV(); int count; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " fetch_func_rset - allocating handle for cursor nested within %s ...\n", - neatsvpv(sth, 0)); + 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)))); @@ -1507,10 +1560,11 @@ fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv) SvREFCNT_dec(init_attr); PUTBACK; FREETMPS; LEAVE; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " fetch_func_rset - ... allocated %s for nested cursor\n", - neatsvpv(dest_sv, 0)); + 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)); fbh->special = (void *)newSVsv(dest_sv); @@ -1542,8 +1596,11 @@ dbd_rebind_ph_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; - if (DBIS->debug >= 6 || dbd_verbose >= 6 ) - PerlIO_printf(DBILOGFP, " dbd_rebind_ph_rset phs->is_inout=%d\n",phs->is_inout); + 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) { @@ -1592,11 +1649,11 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (!phs->desc_h) { ++imp_sth->has_lobs; phs->desc_t = OCI_DTYPE_LOB; - OCIDescriptorAlloc_ok(imp_sth->envhp, + OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t); } - OCIAttrSet_log_stat(phs->desc_h, phs->desc_t, + OCIAttrSet_log_stat(imp_sth, phs->desc_h, phs->desc_t, &lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status); if (status != OCI_SUCCESS) @@ -1608,7 +1665,7 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) sv_2pv(phs->sv, &PL_na); } else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */ - if(SvUPGRADE(phs->sv, SVt_PV)){} /* For GCC not to warn on unused result */ + (void)SvUPGRADE(phs->sv, SVt_PV); } } @@ -1627,7 +1684,7 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) src = INT2PTR(OCILobLocator *, SvIV(SvRV(phs->sv))); dest = (OCILobLocator **) phs->progv; - OCILobLocatorAssign_log_stat(imp_dbh->svchp, imp_sth->errhp, src, dest, status); + 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; @@ -1639,7 +1696,7 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) imp_sth->stmt_type == OCI_STMT_DECLARE) { ub4 amtp; - if(SvUPGRADE(phs->sv, SVt_PV)){/* For GCC not to warn on unused result */}; /* just in case */ + (void)SvUPGRADE(phs->sv, SVt_PV); amtp = SvCUR(phs->sv); /* XXX UTF8? */ @@ -1647,7 +1704,7 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if (amtp > 0) { ub1 lobtype = (phs->ftype == 112 ? OCI_TEMP_CLOB : OCI_TEMP_BLOB); - OCILobCreateTemporary_log_stat(imp_dbh->svchp, imp_sth->errhp, + 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) { @@ -1658,28 +1715,40 @@ dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) if( ! phs->csid ) { ub1 csform = SQLCS_IMPLICIT; ub2 csid = 0; - OCILobCharSetForm_log_stat( imp_sth->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csform, status ); + 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->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csid, status ); + 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); + csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(imp_dbh, csform); phs->csid = csid; phs->csform = csform; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " calling OCILobWrite phs->csid=%d phs->csform=%d amtp=%d\n", + 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->svchp, imp_sth->errhp, + 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) { @@ -1697,6 +1766,7 @@ 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) { dTHX; + D_imp_dbh_from_sth; ub4 loblen = 0; ub4 buflen; ub4 amtp = 0; @@ -1712,7 +1782,12 @@ ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, */ ub1 csform = SQLCS_IMPLICIT; - OCILobCharSetForm_log_stat( imp_sth->envhp, imp_sth->errhp, lobl, &csform, status ); + 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 */ @@ -1727,7 +1802,7 @@ ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, return 0; } - OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp, + 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"); @@ -1748,13 +1823,16 @@ ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, New(42, buffer, buflen, ub1); - OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobl, + 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(DBILOGFP, " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %lu\n", + 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) { @@ -1774,21 +1852,27 @@ ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, assert(amtp == 0); SvGROW(dest_sv, byte_destoffset + 1); if (dbis->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " 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); + 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(DBILOGFP, " 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)); + 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, (unsigned long) len, + destoffset, ul_t(amtp)); 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)) + if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(imp_dbh, csform)) SvUTF8_on(dest_sv); return 1; @@ -1800,6 +1884,7 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, UV len, long destoffset) { dTHX; + D_imp_dbh_from_sth; ub4 loblen = 0; ub4 buflen; ub4 amtp = 0; @@ -1824,14 +1909,19 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, return 0; } - OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status); + 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; } - OCILobCharSetForm_log_stat( imp_sth->envhp, imp_sth->errhp, lobl, &csform, status ); + 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 */ @@ -1859,7 +1949,7 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, /* 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)) { + if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(imp_dbh, csform)) { buflen = amtp * 4; /* XXX destoffset would be counting chars here as well */ SvGROW(dest_sv, (destoffset*4) + buflen + 1); @@ -1874,10 +1964,11 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, buflen = amtp; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " blob_read field %d: ftype %d %s, offset %ld, len %lu." - "LOB csform %d, len %lu, amtp %lu, (destoffset=%ld)\n", + 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); @@ -1885,13 +1976,15 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, ub1 * bufp = (ub1 *)(SvPVX(dest_sv)); bufp += destoffset; - OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobl, + 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, amtp %lu\n", + 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) { @@ -1899,14 +1992,16 @@ ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, sv_set_undef(dest_sv); /* signal error */ return 0; } - if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) + if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(imp_dbh, csform)) SvUTF8_on(dest_sv); } else { assert(amtp == 0); - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %lu\n", + 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)); } @@ -1928,6 +2023,7 @@ static int fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name) { dTHX; + D_imp_dbh_from_sth; ub4 loblen = 0; ub4 buflen = 0; ub4 amtp = 0; @@ -1941,7 +2037,7 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des /* 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->svchp, imp_sth->errhp, lobloc, &loblen, status); + 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; @@ -2001,7 +2097,12 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des if (loblen > 0) { ub1 csform = 0; - OCILobCharSetForm_log_stat(imp_sth->envhp, imp_sth->errhp, lobloc, &csform, status ); + 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); @@ -2009,7 +2110,7 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des } if (ftype == ORA_BFILE) { - OCILobFileOpen_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, + 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"); @@ -2018,7 +2119,7 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des } } - OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, + 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); @@ -2046,20 +2147,23 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des - if (DBIS->debug >= 3 || dbd_verbose >= 3 || oci_warn){ + 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(DBILOGFP, - " 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); + 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->svchp, imp_sth->errhp, + OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, status); } @@ -2072,18 +2176,20 @@ fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *des /* 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 */ + if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(imp_dbh, csform)) /* Don't set UTF8 on BLOBs */ SvUTF8_on(dest_sv); - ora_free_templob(sth, imp_sth, lobloc); + 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %lu\n", + 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)); } @@ -2115,18 +2221,18 @@ fetch_func_getrefpv(SV *sth, imp_fbh_t *fbh, SV *dest_sv) #ifdef OCI_DTYPE_REF static void -fbh_setup_getrefpv(imp_fbh_t *fbh, int desc_t, char *bless) +fbh_setup_getrefpv(imp_sth_t *imp_sth, imp_fbh_t *fbh, int desc_t, char *bless) { dTHX; - if (DBIS->debug >= 2 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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(fbh->imp_sth->envhp, &fbh->desc_h, fbh->desc_t); + OCIDescriptorAlloc_ok(imp_sth, fbh->imp_sth->envhp, &fbh->desc_h, fbh->desc_t); } #endif @@ -2183,6 +2289,7 @@ calc_cache_rows(int cache_rows, int num_fields, int est_width, int has_longs,ub4 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; @@ -2196,8 +2303,10 @@ static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeC SV *raw_sv; /* get the data based on the type code*/ - if (DBIS->debug >= 5 || dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, " getting value of object attribute named %s with typecode=%s\n",name,oci_typecode_name(typecode)); + 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) @@ -2206,13 +2315,14 @@ static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeC case OCI_TYPECODE_INTERVAL_YM : case OCI_TYPECODE_INTERVAL_DS : - OCIIntervalToText_log_stat(fbh->imp_sth->envhp, - fbh->imp_sth->errhp, - attr_value, - str_buf, - (size_t) 200, - &str_len, - status); + 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; @@ -2223,12 +2333,17 @@ static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeC ub4_str_len = 200; - OCIDateTimeToText_log_stat(fbh->imp_sth->envhp, - fbh->imp_sth->errhp,attr_value,&ub4_str_len,str_buf,status); + 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"; + char s_tz_hour[6]="000"; + char s_tz_min[6]="000"; sb1 tz_hour; sb1 tz_minute; status = OCIDateTimeGetTimeZoneOffset (fbh->imp_sth->envhp, @@ -2257,7 +2372,12 @@ static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeC case OCI_TYPECODE_DATE : /* fixed length string*/ ub4_str_len = 200; - OCIDateToText_log_stat(fbh->imp_sth->errhp, (CONST OCIDate *) attr_value,&ub4_str_len,str_buf,status); + 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; @@ -2345,6 +2465,7 @@ 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; @@ -2360,8 +2481,10 @@ get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObje OCIType *tdo = instance_tdo ? instance_tdo : obj->tdo; - if (DBIS->debug >= 5 || dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, " getting attributes of object named %s with typecode=%s\n",obj->type_name,oci_typecode_name(obj->typecode)); + 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) { @@ -2389,7 +2512,11 @@ get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObje return 0; } - OCITypeByRef_log_stat(fbh->imp_sth->envhp,fbh->imp_sth->errhp,type_ref,&tdo,status); + 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"); @@ -2413,15 +2540,15 @@ get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObje } if (tdo != obj->tdo) { /* new subtyped -> get obj description */ - if (DBIS->debug >= 5 || dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, " describe subtype (tdo=%p) of object type %s (tdo=%p)\n",(void*)tdo,base_obj->type_name,(void*)base_obj->tdo); + 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 (DBIS->debug >= 5 || dbd_verbose >= 5 ){ + if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ dump_struct(fbh->imp_sth,obj,0); } } @@ -2430,8 +2557,8 @@ get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObje } } - if (DBIS->debug >= 5 || dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, " getting attributes of object subtype %s\n",obj->type_name); + 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); } } @@ -2460,18 +2587,30 @@ the concept is simple really 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 + 5. interate over the attributes 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. */ - status = OCIObjectGetAttr(fbh->imp_sth->envhp, fbh->imp_sth->errhp, value, - obj_ind, tdo, - (CONST oratext**)&fld->type_name, &fld->type_namel, 1, - (ub4 *)0, 0, &attr_null_status, &attr_null_struct, - &attr_value, &attr_tdo); + 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"); @@ -2510,8 +2649,12 @@ id only shows you examples with the C struct built in and only a single record. 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->envhp, fbh->imp_sth->errhp, - (OCIColl*) value, &itr,status); + 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");*/ @@ -2539,8 +2682,11 @@ id only shows you examples with the C struct built in and only a single record. } /*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->envhp, - fbh->imp_sth->errhp, &itr,status ); + 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; @@ -2569,8 +2715,12 @@ static int fetch_func_oci_object(SV *sth, imp_fbh_t *fbh,SV *dest_sv) { dTHX; - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) { - PerlIO_printf(DBILOGFP, " getting an embedded object named %s with typecode=%s\n",fbh->obj->type_name,oci_typecode_name(fbh->obj->typecode)); + 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) { @@ -2597,19 +2747,28 @@ fetch_clbk_lob(SV *sth, imp_fbh_t *fbh,SV *dest_sv){ dTHX; D_imp_sth(sth); + D_imp_dbh_from_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 (DBIS->debug >= 6 || dbd_verbose >= 6 ) - PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (char/bytes) with callback in 1 piece of %d (Char/Bytes)\n",actual_bufl,fb_ary->bufl); + 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 (DBIS->debug >= 6 || dbd_verbose >= 6 ) - PerlIO_printf(DBILOGFP," 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); + 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 ); } @@ -2619,7 +2778,7 @@ fetch_clbk_lob(SV *sth, imp_fbh_t *fbh,SV *dest_sv){ 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) ){ + if (CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform) ){ SvUTF8_on(dest_sv); } } @@ -2632,6 +2791,7 @@ fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) { dTHX; D_imp_sth(sth); + D_imp_dbh_from_sth; fb_ary_t *fb_ary = fbh->fb_ary; ub4 buflen = fb_ary->bufl; ub4 actual_bufl = 0; @@ -2643,21 +2803,22 @@ fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) ub2 rcode = 0; sword status = OCI_NEED_DATA; - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) { - PerlIO_printf(DBILOGFP, "in fetch_get_piece \n"); + 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->stmhp, - fbh->imp_sth->errhp, - &hdlptr, - &hdltype, - &in_out, - &iter, - &idx, - &piece, - status); + 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 @@ -2672,7 +2833,8 @@ fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) */ if ( hdlptr==fbh->defnp){ - OCIStmtSetPieceInfo_log_stat(fbh->defnp, + OCIStmtSetPieceInfo_log_stat(fbh->imp_sth, + fbh->defnp, fbh->imp_sth->errhp, fb_ary->abuf, &buflen, @@ -2681,7 +2843,7 @@ fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) &rcode,status); - OCIStmtFetch_log_stat(fbh->imp_sth->stmhp,fbh->imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,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)){ @@ -2699,21 +2861,33 @@ fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) } - if (DBIS->debug >= 6 || dbd_verbose >= 6 ){ + if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ){ if (fb_ary->piece_count==1){ - PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (Char/Bytes) with Polling in 1 piece\n",actual_bufl); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + " Fetch persistent lob of %d (Char/Bytes) with Polling " + "in 1 piece\n", + actual_bufl); } else { - PerlIO_printf(DBILOGFP," 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); + 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 (actual_bufl > 0){ + 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); + if (CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform) ){ /* do the UTF 8 magic*/ + SvUTF8_on(dest_sv); + } } + } else { + sv_set_undef(dest_sv); } return 1; @@ -2779,6 +2953,8 @@ empty_oci_object(fbh_obj_t *obj){ 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*/ } @@ -2788,8 +2964,8 @@ fetch_cleanup_pres_lobs(SV *sth,imp_fbh_t *fbh){ 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 (DBIS->debug >= 5 || dbd_verbose >= 5 ) - PerlIO_printf(DBILOGFP," fetch_cleanup_pres_lobs \n"); + if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) + PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_pres_lobs \n"); return; } @@ -2797,6 +2973,7 @@ fetch_cleanup_pres_lobs(SV *sth,imp_fbh_t *fbh){ 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*/ } @@ -2806,8 +2983,8 @@ fetch_cleanup_oci_object(SV *sth, imp_fbh_t *fbh){ } } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP," fetch_cleanup_oci_object \n"); + if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) + PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_oci_object \n"); return; } @@ -2820,11 +2997,15 @@ void rs_array_init(imp_sth_t *imp_sth) imp_sth->rs_fetch_count =0; imp_sth->rs_array_status =OCI_SUCCESS; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " 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)); + 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 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) { @@ -2910,7 +3091,7 @@ sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int num_fields, /* is prefetch_rows are greater than the RowCahceSize then use prefetch_rows*/ } - OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, + OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, &prefetch_mem, sizeof(prefetch_mem), OCI_ATTR_PREFETCH_MEMORY, imp_sth->errhp, status); @@ -2920,7 +3101,7 @@ sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int num_fields, ++num_errors; } - OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, + OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, &prefetch_rows, sizeof(prefetch_rows), OCI_ATTR_PREFETCH_ROWS, imp_sth->errhp, status); @@ -2948,12 +3129,15 @@ sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int num_fields, - if (DBIS->debug >= 3 || dbd_verbose >= 3 || oci_warn) /*will also display if oci_warn is on*/ - PerlIO_printf(DBILOGFP, - " 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"); - - + 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; } @@ -2968,8 +3152,10 @@ describe_obj(SV *sth,imp_sth_t *imp_sth,OCIParam *parm,fbh_obj_t *obj,int level sword status; OCIRef *type_ref; - if (DBIS->debug >= 5 || dbd_verbose >= 5 ) { - PerlIO_printf(DBILOGFP, "At level=%d in description an embedded object \n",level); + 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 */ @@ -2981,7 +3167,12 @@ describe_obj(SV *sth,imp_sth_t *imp_sth,OCIParam *parm,fbh_obj_t *obj,int level return 0; } - OCITypeByRef_log_stat(imp_sth->envhp,imp_sth->errhp,type_ref,&obj->tdo,status); + 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"); @@ -2999,7 +3190,7 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { ub4 type_namel, schema_namel; - OCIDescribeAny_log_stat(imp_sth->svchp,imp_sth->errhp,obj->tdo,(ub4)0,OCI_OTYPE_PTR,(ub1)1,OCI_PTYPE_TYPE,imp_sth->dschp,status); + 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) { @@ -3045,15 +3236,21 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { return 0; } - if (DBIS->debug >= 6 || dbd_verbose >= 6 ) { - PerlIO_printf(DBILOGFP, "Getting the properties of object named =%s at level %d typecode=%d\n",obj->type_name,level,obj->typecode); + 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 (DBIS->debug >= 6 || dbd_verbose >= 6 ) { - PerlIO_printf(DBILOGFP, "Object named =%s at level %d is an Object\n",obj->type_name,level); + 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); @@ -3064,7 +3261,7 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { } /*we will need a reff to the TDO for the pin operation*/ - OCIObjectPin_log_stat(imp_sth->envhp,imp_sth->errhp, obj->obj_ref,(dvoid **)&obj->obj_type,status); + 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"); @@ -3101,7 +3298,7 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { OCIParam *parmdf= (OCIParam *) 0; fbh_obj_t *fld = &obj->fields[pos-1]; /*get the field holder*/ - OCIParamGet_log_stat((dvoid *) list_attr,(ub4) OCI_DTYPE_PARAM, imp_sth->errhp,(dvoid *)&parmdf, (ub4) pos ,status); + 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"); @@ -3124,8 +3321,11 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { return 0; } - if (DBIS->debug >= 6 || dbd_verbose >= 6 ) { - PerlIO_printf(DBILOGFP, "Getting property #%d, named=%s and its typecode is %d \n",pos,fld->type_name,fld->typecode); + 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){ @@ -3138,8 +3338,11 @@ describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { } else { /*well this is an embedded table or varray of some form so find out what is in it*/ - if (DBIS->debug >= 6 || dbd_verbose >= 6 ) { - PerlIO_printf(DBILOGFP, "Object named =%s at level %d is an Varray or Table\n",obj->type_name,level); + 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); @@ -3184,28 +3387,40 @@ dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level){ int i; /*dumps the contents of the current fbh->obj*/ - PerlIO_printf(DBILOGFP, " level=%d type_name = %s\n",level,obj->type_name); - PerlIO_printf(DBILOGFP, " type_namel = %u\n",obj->type_namel); - PerlIO_printf(DBILOGFP, " parmdp = %p\n",obj->parmdp); - PerlIO_printf(DBILOGFP, " parmap = %p\n",obj->parmap); - PerlIO_printf(DBILOGFP, " tdo = %p\n",obj->tdo); - PerlIO_printf(DBILOGFP, " typecode = %s\n",oci_typecode_name(obj->typecode)); - PerlIO_printf(DBILOGFP, " col_typecode = %d\n",obj->col_typecode); - PerlIO_printf(DBILOGFP, " element_typecode = %s\n",oci_typecode_name(obj->element_typecode)); - PerlIO_printf(DBILOGFP, " obj_ref = %p\n",obj->obj_ref); - PerlIO_printf(DBILOGFP, " obj_value = %p\n",obj->obj_value); - PerlIO_printf(DBILOGFP, " obj_type = %p\n",obj->obj_type); - PerlIO_printf(DBILOGFP, " is_final_type = %u\n",obj->is_final_type); - PerlIO_printf(DBILOGFP, " field_count = %d\n",obj->field_count); - PerlIO_printf(DBILOGFP, " fields = %p\n",obj->fields); + 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(DBILOGFP, " \n--->sub objects\n "); + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + " \n--->sub objects\n "); dump_struct(imp_sth,fld,level+1); } - PerlIO_printf(DBILOGFP, " \n--->done %s\n ",obj->type_name); + PerlIO_printf(DBIc_LOGPIO(imp_sth), " \n--->done %s\n ",obj->type_name); return 1; } @@ -3239,22 +3454,26 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) /* 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); + ? 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s\n", + 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 */ + /* imp_sth memory was cleared when created so no setup required here */ return 1; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_describe %s (%s, lb %lu)...\n", + 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); @@ -3262,13 +3481,13 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) /* 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); + 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")); + ora_sql_error(imp_sth, "OCIStmtExecute/Describe")); if (status != OCI_SUCCESS_WITH_INFO) - return 0; + return 0; } } OCIAttrGet_stmhp_stat(imp_sth, &num_fields, 0, OCI_ATTR_PARAM_COUNT, status); @@ -3277,9 +3496,11 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) return 0; } if (num_fields == 0) { - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s (no fields returned)\n", - oci_stmt_type_name(imp_sth->stmt_type)); + 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; } @@ -3288,7 +3509,7 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) 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*/ + /* 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; @@ -3299,8 +3520,8 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) fbh->field_num = i; fbh->define_mode = OCI_DEFAULT; - OCIParamGet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, imp_sth->errhp, - (dvoid**)&fbh->parmdp, (ub4)i, status); + 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"); @@ -3323,7 +3544,7 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) 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 */ + /* 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); @@ -3338,283 +3559,295 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) fbh->name = SvPVX(fbh->name_sv); fbh->ftype = 5; /* default: return as null terminated string */ - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) - PerlIO_printf(DBILOGFP, "Describe col #%d type=%d(%s)\n",i,fbh->dbtype,sql_typecode_name(fbh->dbtype)); + /* 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->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->envhp, &fbh->desc_h, fbh->desc_t); - - - } - - break; + /* 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(imp_dbh, 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(imp_dbh, 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 */ + fbh->disize = 20; + fbh->prec = fbh->disize; + break; + case 104: /* ROWID Desc */ + fbh->disize = 2000; + 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(fbh, OCI_DTYPE_REF, "OCIRefPtr"); - break; + 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: + 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 (DBIS->debug >= 1 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, p, i, fbh->dbtype, "\n"); - if (PL_dowarn) - warn(p, i, fbh->dbtype, ""); - break; + 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - "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 (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 ...' */ + /* dbsize can be zero for 'select NULL ...' */ imp_sth->t_dbsize += fbh->dbsize; @@ -3623,16 +3856,16 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) est_width += avg_width; - if (DBIS->debug >= 2 || dbd_verbose >= 3 ) - dbd_fbh_dump(fbh, (int)i, 0); + 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 ); + (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; @@ -3663,33 +3896,36 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) } if (fbh->ftype == ORA_RSET) { /* RSET */ - OCIHandleAlloc_ok(imp_sth->envhp, - (dvoid*)&((OCIStmt **)fb_ary->abuf)[0], - OCI_HTYPE_STMT, status); + OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, + (dvoid*)&((OCIStmt **)fb_ary->abuf)[0], + OCI_HTYPE_STMT, status); } - OCIDefineByPos_log_stat(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); + 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(fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status); + /* use a dynamic callback for persistent binary and char lobs*/ + OCIDefineDynamic_log_stat(imp_sth, fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status); } if (fbh->ftype == 108) { /* Embedded object bind it differently*/ - if (DBIS->debug >= 5 || dbd_verbose >= 5 ){ - PerlIO_printf(DBILOGFP,"Field #%d is a object or colection of some sort. Using OCIDefineObject and or OCIObjectPin \n",i); + 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; @@ -3697,10 +3933,10 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) ++num_errors; } - if (DBIS->debug >= 5 || dbd_verbose >= 5 ){ + if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ dump_struct(imp_sth,fbh->obj,0); } - OCIDefineObject_log_stat(fbh->defnp,imp_sth->errhp,fbh->obj->tdo,(dvoid**)&fbh->obj->obj_value,(dvoid**)&fbh->obj->obj_ind,status); + 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"); @@ -3717,11 +3953,14 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) #ifdef OCI_ATTR_CHARSET_FORM if ( (fbh->dbtype == 1) && fbh->csform ) { - /* csform may be 0 when talking to Oracle 8.0 database*/ - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " calling OCIAttrSet OCI_ATTR_CHARSET_FORM with csform=%d (%s)\n", fbh->csform,oci_csform_name(fbh->csform) ); - OCIAttrSet_log_stat( fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform, - (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status ); + /* 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; @@ -3731,10 +3970,12 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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); + (int)num_fields, imp_sth->t_dbsize, imp_sth->est_width, + imp_sth->prefetch_rows); return (num_errors>0) ? 0 : 1; } @@ -3774,43 +4015,55 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ status = OCI_SUCCESS; } else { - if (DBIS->debug >= 3 || dbd_verbose >= 3 ){ - PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth)); + 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 (DBIS->debug >= 4 || dbd_verbose >= 4 ) - PerlIO_printf(DBILOGFP," Scrolling Fetch, postion before fetch=%d, Orientation = %s , Fetchoffset =%d\n", - imp_sth->fetch_position,oci_fetch_options(imp_sth->fetch_orient),imp_sth->fetch_offset); + 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->stmhp, imp_sth->errhp,1, imp_sth->fetch_orient,imp_sth->fetch_offset, status); + 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*/ - /* defualt and OCI_FETCH_NEXT are the same so this avoids miscaluation on the next value*/ - OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status); + /* default and OCI_FETCH_NEXT are the same so this avoids miscaluation on the next value*/ + if (status==OCI_NO_DATA){ + return Nullav; + } - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) - PerlIO_printf(DBILOGFP," Scrolling Fetch, postion after fetch=%d\n",imp_sth->fetch_position); + 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 (imp_sth->row_cache_off){ /*Do not use array fetch or local cache */ - 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,1,(ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status); imp_sth->rs_fetch_count++; imp_sth->rs_array_idx=0; } - else { /*Array Fetch the New Noraml Super speedy and very nice*/ + else { /*Array Fetch the New Normal Super speedy and very nice*/ 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(DBILOGFP, " dbd_st_fetch fields...b\n");*/ +/* PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_fetch fields...b\n");*/ - OCIStmtFetch_log_stat(imp_sth->stmhp,imp_sth->errhp,imp_sth->rs_array_size,(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++; @@ -3822,8 +4075,10 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ imp_dbh->RowsInCache =imp_sth->rs_array_size; imp_sth->RowsInCache =imp_sth->rs_array_size; - if (DBIS->debug >= 4 || dbd_verbose >= 4 || oci_warn) - PerlIO_printf(DBILOGFP,"...Fetched %d rows\n",imp_sth->rs_array_num_rows); + 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--; @@ -3846,8 +4101,11 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ if (status == OCI_NO_DATA) { dTHR; /* for DBIc_ACTIVE_off */ DBIc_ACTIVE_off(imp_sth); /* eg finish */ - if (DBIS->debug >= 3 || dbd_verbose >= 3 || oci_warn) - PerlIO_printf(DBILOGFP, " dbd_st_fetch no-more-data, fetch count=%d\n",imp_sth->rs_fetch_count-1); + 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) { @@ -3865,10 +4123,13 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ /* 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 || dbd_verbose >= 3 ) { - PerlIO_printf(DBILOGFP, " dbd_st_fetched %d fields with status of %d(%s)\n", num_fields,status, 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); @@ -3882,8 +4143,10 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */; - if (DBIS->debug >= 4 || dbd_verbose >= 4 ) { - PerlIO_printf(DBILOGFP, " field #%d with rc=%d(%s)\n",i+1,rc,oci_col_return_codes(rc)); + 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 */ @@ -3930,7 +4193,6 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ --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)) { @@ -3938,31 +4200,30 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ char errstr[256]; sts = DBIc_DBISTATE(imp_sth)->sql_type_cast_svpv( - aTHX_ sv, fbh->req_type, fbh->bind_flags, NULL); + 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); + "over/under flow converting column %d to type %ld", + i+1, (long)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); + "unsupported bind type %ld for column %d", + (long)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) ){ + if (CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform) ){ SvUTF8_on(sv); } } } else -#endif /* DBISTATE_VERSION > 94 */ { - if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ + if (CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform) ){ SvUTF8_on(sv); } } @@ -3982,7 +4243,7 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ /* 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)){ + if ((CSFORM_IMPLIES_UTF8(imp_dbh, fbh->csform)) && (fbh->ftype != SQLT_BIN)){ SvUTF8_on(sv); } } @@ -4002,73 +4263,134 @@ dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ oci_error(sth, imp_sth->errhp, OCI_ERROR, buf); } - if (DBIS->debug >= 5 || dbd_verbose >= 5 ){ - PerlIO_printf(DBILOGFP, "\n %p (field=%d): %s\n", av, i,neatsvpv(sv,10)); + 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_t *imp_dbh, char **uidp, char **pwdp) +static int +local_error(pTHX_ SV * h, const char * fmt, ...) { - 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->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); - } - else { -#endif - OCIAttrSet_log_stat(imp_dbh->seshp, OCI_HTYPE_SESSION, - *uidp, strlen(*uidp), - (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status); - - OCIAttrSet_log_stat(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; + va_list ap; + SV * txt_sv = sv_newmortal(); + SV * code_sv = get_sv("DBI::stderr", 0); + D_imp_xxh(h); + if(code_sv == NULL) + { + code_sv = sv_newmortal(); + sv_setiv(code_sv, 2000000000); + } + va_start(ap, fmt); + sv_vsetpvf(txt_sv, fmt, &ap); + va_end(ap); + DBIh_SET_ERR_SV(h, imp_xxh, code_sv, txt_sv, &PL_sv_undef, &PL_sv_undef); + return FALSE; } - int ora_db_reauthenticate(SV *dbh, imp_dbh_t *imp_dbh, char *uid, char *pwd) { 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->svchp, imp_dbh->errhp, - imp_dbh->seshp, OCI_DEFAULT, status); /* XXX check status here?*/ - OCISessionBegin_log_stat( imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, - ora_parse_uid(imp_dbh, &uid, &pwd), (ub4) OCI_DEFAULT, status); + OCISession *seshp; + char * driver_name; + ub4 namelen, ulen, plen, credt; +#ifdef ORA_OCI_112 + if (cnx_is_pooled_session(aTHX_ dbh, imp_dbh)) + return local_error(aTHX_ dbh, "Can't reauthenticate pooled session"); +#endif +#if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) + if (imp_dbh->is_shared) + return local_error(aTHX_ dbh, "Can't reauthenticate shared session"); +#endif + OCIHandleAlloc_ok( + imp_dbh, imp_dbh->envhp, + &seshp, OCI_HTYPE_SESSION, status + ); + OCIAttrGet_log_stat( + imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, + &driver_name, &namelen, OCI_ATTR_DRIVER_NAME, + imp_dbh->errhp, status + ); + if(status == OCI_SUCCESS && namelen != 0) + { + OCIAttrSet_log_stat( + imp_dbh, seshp, OCI_HTYPE_SESSION, + driver_name, namelen, OCI_ATTR_DRIVER_NAME, + imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) + { + (void)oci_error(dbh, imp_dbh->errhp, + status, "OCIAttrSet OCI_ATTR_DRIVER_NAME" + ); + OCIHandleFree_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, status); + return 0; + } + } + plen = (ub4)strlen(pwd); + ulen = (ub4)strlen(uid); + if (plen == 0 && ulen == 0) credt = OCI_CRED_EXT; + else + { + OCIAttrSet_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, + uid, ulen, + (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status); + if (status != OCI_SUCCESS) + { + (void)oci_error(dbh, imp_dbh->errhp, + status, "OCIAttrSet OCI_ATTR_USERNAME" + ); + OCIHandleFree_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, status); + return 0; + } + + OCIAttrSet_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, + ((plen) ? pwd : NULL), plen, + (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status); + if (status != OCI_SUCCESS) + { + (void)oci_error(dbh, imp_dbh->errhp, + status, "OCIAttrSet OCI_ATTR_PASSWORD" + ); + OCIHandleFree_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, status); + return 0; + } + credt = OCI_CRED_RDBMS; + } + + OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, seshp, + credt, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { - oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin"); - return 0; - } + oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin"); + OCIHandleFree_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, status); + return 0; + } + OCIAttrSet_log_stat( + imp_dbh, imp_dbh->svchp, + (ub4) OCI_HTYPE_SVCCTX, + seshp, 0, OCI_ATTR_SESSION, + imp_dbh->errhp, status + ); + if (status != OCI_SUCCESS) + { + (void)oci_error( + dbh, imp_dbh->errhp, status, "OCIAttrSet OCI_ATTR_SESSION" + ); + OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, + seshp, OCI_DEFAULT, status); + OCIHandleFree_log_stat(imp_dbh, seshp, OCI_HTYPE_SESSION, status); + return 0; + } + OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, + imp_dbh->seshp, OCI_DEFAULT, status); + OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, status); + imp_dbh->seshp = seshp; return 1; } @@ -4173,6 +4495,7 @@ static int init_lob_refetch(SV *sth, imp_sth_t *imp_sth) { dTHX; + D_imp_dbh_from_sth; SV *sv; SV *sql_select; HV *lob_cols_hv = NULL; @@ -4207,32 +4530,34 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) "Unable to parse table name for LOB refetch"); if (!imp_sth->dschp){ - OCIHandleAlloc_ok(imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); + 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->svchp, errhp, tablename, strlen(tablename), + 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]; + char *syn_name; ub4 tn_len = 0, syn_schema_len = 0; - strncpy(syn_name,tablename,strlen(tablename)); + Newx(syn_name, 1 + strlen(tablename), char); + + strcpy(syn_name,tablename); /* Put the synonym name here for later user */ - OCIAttrGet_log_stat(imp_sth->dschp, OCI_HTYPE_DESCRIBE, + OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, &parmhp, 0, OCI_ATTR_PARAM, errhp, status); - OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM, + OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &syn_schema, &syn_schema_len, OCI_ATTR_SCHEMA_NAME, errhp, status); - OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM, + 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); @@ -4242,65 +4567,73 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) tablename=new_tablename; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " lob refetch using a synonym named=%s for %s \n", syn_name,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); + Safefree(syn_name); } - OCIDescribeAny_log_stat(imp_sth->svchp, errhp, tablename, strlen(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->svchp, errhp, tablename, strlen(tablename), + 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->dschp, OCI_HTYPE_DESCRIBE, status); + 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->dschp, OCI_HTYPE_DESCRIBE, + 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, + 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, + OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &collisthd, 0, OCI_ATTR_LIST_COLUMNS, errhp, status); } if (status != OCI_SUCCESS) { - OCIHandleFree_log_stat(imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch"); } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " lob refetch from table %s, %d columns:\n", tablename, numcols); + 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(collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd, i, status); + OCIParamGet_log_stat(imp_sth, collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd, i, status); if (status) break; - OCIAttrGet_log_stat(colhd, OCI_DTYPE_PARAM, &col_dbtype, 0, + OCIAttrGet_log_stat(imp_sth, 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, + OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_name, &col_name_len, OCI_ATTR_NAME, errhp, status); if (status) break; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " lob refetch table col %d: '%.*s' otype %d\n", + 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) @@ -4312,22 +4645,22 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) sv = newSViv(col_dbtype); (void)sv_setpvn(sv, col_name, col_name_len); - if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) + if (CSFORM_IMPLIES_UTF8(imp_dbh, 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(colhd, OCI_DTYPE_PARAM); + OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM); colhd = NULL; } if (colhd) - OCIDescriptorFree(colhd, OCI_DTYPE_PARAM); + 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->dschp, OCI_HTYPE_DESCRIBE, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); return 0; } @@ -4380,10 +4713,12 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) while( (sv_other = hv_iternextsv(lob_cols_hv, &p_other, &i)) != NULL ) { if (phs->ftype != SvIV(sv_other)) continue; - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " both %s and %s have type %d - ambiguous\n", - neatsvpv(sv,0), neatsvpv(sv_other,0), (int)SvIV(sv_other)); + 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, @@ -4397,9 +4732,10 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]); sv_catpv(sql_select, sql_field); - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, - " lob refetch %s param: otype %d, matched field '%s' %s(%s)\n", + 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); @@ -4409,15 +4745,16 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) fbh->dbtype = phs->ftype; fbh->disize = 99; fbh->desc_t = OCI_DTYPE_LOB; - OCIDescriptorAlloc_ok(imp_sth->envhp, &fbh->desc_h, fbh->desc_t); + OCIDescriptorAlloc_ok(imp_sth, 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 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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); } @@ -4433,16 +4770,17 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) 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 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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->envhp, &lr->stmthp, OCI_HTYPE_STMT, status); - OCIStmtPrepare_log_stat(lr->stmthp, errhp, + 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); @@ -4453,11 +4791,11 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) } /* 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, + 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(lr->rowid, OCI_DTYPE_ROWID); + 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"); @@ -4473,16 +4811,17 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) 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 (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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, + 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) { - OCIDescriptorFree(lr->rowid, OCI_DTYPE_ROWID); + OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID); OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT); Safefree(lr); fb_ary_free(fbh->fb_ary); @@ -4491,7 +4830,7 @@ init_lob_refetch(SV *sth, imp_sth_t *imp_sth) } } - OCIHandleFree_log_stat(imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); + OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); imp_sth->lob_refetch = lr; /* structure copy */ return 1; @@ -4528,7 +4867,7 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl if (phs->desc_h && !phs->is_inout){ - OCILobFreeTemporary_log_stat(imp_sth->svchp, imp_sth->errhp, phs->desc_h, status); + OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, phs->desc_h, status); /* boolean lobEmpty=1;*/ @@ -4558,7 +4897,7 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl 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 */ + 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, @@ -4571,7 +4910,7 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl phs_t *phs = (phs_t*)fbh->special; ub4 amtp; - if(SvUPGRADE(phs->sv, SVt_PV)){/* For GCC not to warn on unused result */ }; /* just in case */ + (void)SvUPGRADE(phs->sv, SVt_PV); amtp = SvCUR(phs->sv); /* XXX UTF8? */ if (rc == 1405) { /* NULL - return undef */ @@ -4582,26 +4921,38 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl if( ! fbh->csid ) { ub1 csform = SQLCS_IMPLICIT; ub2 csid = 0; - OCILobCharSetForm_log_stat( imp_sth->envhp, errhp, (OCILobLocator*)fbh->desc_h, &csform, status ); + 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->envhp, errhp, (OCILobLocator*)fbh->desc_h, &csid, status ); + 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); + csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(imp_dbh, csform); fbh->csid = csid; fbh->csform = csform; } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, " calling OCILobWrite fbh->csid=%d fbh->csform=%d amtp=%d\n", + 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->svchp, errhp, + 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); @@ -4610,7 +4961,7 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl } } else { /* amtp==0 so truncate LOB to zero length */ - OCILobTrim_log_stat(imp_sth->svchp, errhp, (OCILobLocator*)fbh->desc_h, 0, status); + 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"); @@ -4618,8 +4969,9 @@ post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handl } - if (DBIS->debug >= 3 || dbd_verbose >= 3 ) - PerlIO_printf(DBILOGFP, + 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)); @@ -4643,15 +4995,15 @@ ora_free_lob_refetch(SV *sth, imp_sth_t *imp_sth) int i; sword status; if (lr->rowid) - OCIDescriptorFree(lr->rowid, OCI_DTYPE_ROWID); - OCIHandleFree_log_stat(lr->stmthp, OCI_HTYPE_STMT, status); + 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(fbh); + ora_free_fbh_contents(sth, fbh); } sv_free(lr->fbh_ary_sv); Safefree(imp_sth->lob_refetch); @@ -4673,7 +5025,7 @@ ora_db_version(SV *dbh, imp_dbh_t *imp_dbh) /* 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->svchp, imp_dbh->errhp, buf, 2,OCI_HTYPE_SVCCTX, &vernum , status); + 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; diff --git a/ocitrace.h b/ocitrace.h index 39c0fdb7..1adc8a7c 100644 --- a/ocitrace.h +++ b/ocitrace.h @@ -6,8 +6,8 @@ Macros named "_log_stat" return status in last parameter. */ -#define DBD_OCI_TRACEON (DBIS->debug >= 6 || dbd_verbose>=6) -#define DBD_OCI_TRACEFP (DBILOGFP) +#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*)"") #define ul_t(v) ((unsigned long)(v)) @@ -36,114 +36,121 @@ If done well the log will read like a compilable program. */ -#define OCIServerRelease_log_stat(sc,errhp,b,bl,ht,ver,stat)\ +#define OCIServerRelease_log_stat(impdbh,sc,errhp,b,bl,ht,ver,stat) \ stat =OCIServerRelease(sc,errhp,b,bl,ht,ver);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(svchp, errhp,stat)\ - stat =OCISessionRelease(svchp, errhp, NULL, (ub4)0, OCI_DEFAULT);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%sOCISessionRelease(svchp=%p)=%s\n",\ - OciTp, svchp,oci_status_name(stat)),stat \ +#define OCISessionRelease_log_stat(impdbh,svchp,errhp,tag,tagl,mode,stat) \ + stat =OCISessionRelease(svchp, errhp, tag, tagl, mode);\ + (DBD_OCI_TRACEON(impdbh)) \ + ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ + "%sOCISessionRelease(svchp=%p,mode=%u)=%s\n",\ + OciTp, svchp,mode,oci_status_name(stat)),stat \ : stat -#define OCISessionPoolDestroy_log_stat(ph, errhp,stat )\ +#define OCISessionPoolDestroy_log_stat(impdbh, ph, errhp,stat ) \ stat =OCISessionPoolDestroy(ph, errhp,OCI_DEFAULT);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%sOCISessionGet(envhp=%p,sh=%p,ah=%p,pn=%p,pnl=%d)=%s\n",\ - OciTp, envhp,sh,ah,pn,pnl,oci_status_name(stat)),stat \ +#define OCISessionGet_log_stat(impdbh,envhp,errhp,sh,ah,pn,pnl,tag,tagl,rettag,rettagl,found,stat) \ + stat =OCISessionGet(envhp, errhp, sh, ah,pn,pnl,tag,tagl,rettag,rettagl,found, OCI_SESSGET_SPOOL);\ + (DBD_OCI_TRACEON(impdbh)) \ + ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ + "%sOCISessionGet(envhp=%p,sh=%p,ah=%p,pn=%p,pnl=%d,found=%d)=%s\n",\ + OciTp, envhp,sh,ah,pn,pnl,*found,oci_status_name(stat)),stat \ : stat -#define OCISessionPoolCreate_log_stat(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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%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 \ +#define OCISessionPoolCreate_log_stat(impdbh,envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,mode,stat) \ + stat =OCISessionPoolCreate(envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,mode);\ + (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=%lu,pw=%s,pwl=%lu,mode=%u)=%s\n",\ + OciTp, envhp,ph,pn,pnl,sn,sm,si,un,(unsigned long)unl,pw,(unsigned long)pwl,mode,oci_status_name(stat)),stat \ : stat #if defined(ORA_OCI_102) -#define OCIPing_log_stat(sc,errhp,stat)\ +#define OCIPing_log_stat(impdbh,sc,errhp,stat) \ stat =OCIPing(sc,errhp,OCI_DEFAULT);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(sc,errhp,b,bl,ht,stat)\ +#define OCIServerVersion_log_stat(impdbh,sc,errhp,b,bl,ht,stat) \ stat =OCIServerVersion(sc,errhp,b,bl,ht);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(ptr,errhp,buf,blen,p,indp,rc,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(defnp,errhp,fbh,stat)\ +#define OCIDefineDynamic_log_stat(impsth,defnp,errhp,fbh,stat) \ stat =OCIDefineDynamic(defnp,errhp,fbh,(OCICallbackDefine) presist_lob_fetch_cbk );\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(svchp,envhp,src_type,src_ptr,xml,stat)\ - stat =OCIXMLTypeCreateFromSrc (svchp,envhp,(OCIDuration)OCI_DURATION_CALLOUT,(ub1)src_type,(dvoid *)src_ptr,(sb4)OCI_IND_NOTNULL, xml);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%sOCIXMLTypeCreateFromSrc_log_stat(%p,%p,%p,%p,%p)=%s\n",\ - OciTp, (void*)svchp,(void*)envhp, src_type, src_ptr,oci_status_name(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 OCILobLocatorIsInit_log_stat(envhp,errhp,loc,is_initp,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(envhp,errhp,or,ot,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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) \ @@ -151,8 +158,8 @@ "%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) \ @@ -160,60 +167,60 @@ "%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(envhp,errhp,v,no,ot,tn,tnl,ani,ans,av,atdo, stat)\ - stat = OCIObjectGetAttr(errhp,errhp,v,no,ot,tn,tnl,1,(ub4 *)0, 0,ani,ans,av,atdo,stat);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%sOCIObjectGetAttr_log_stat(%p,%p,%d,%d,%d,%d,%d,%d,%d,%d,%d)=%s\n",\ - OciTp, (void*)envhp,(void*)errhp,v,no,ot,tn,tnl,ani,ans,av,atdo,(void*)errhp,oci_status_name(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(envhp,errhp,di,sb,ln,sl,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(envhp,errhp,d,sl,sb,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(errhp,d,sl,sb,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(envhp,errhp,itr,stat)\ +#define OCIIterDelete_log_stat(impsth,envhp,errhp,itr,stat) \ stat = OCIIterDelete(envhp,errhp,itr );\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(envhp,errhp,coll,itr,stat)\ +#define OCIIterCreate_log_stat(impsth,envhp,errhp,coll,itr,stat) \ stat = OCIIterCreate(envhp,errhp,coll,itr);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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) \ @@ -221,105 +228,109 @@ "%sOCICollSize_log_stat(%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,oci_status_name(stat)),stat \ : stat - -#define OCIDefineObject_log_stat(defnp,errhp,tdo,eo_buff,eo_ind,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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_stat(envhp,errhp,svchp,p1,l,tdo,stat)\ - stat = OCITypeByName(envhp,errhp,svchp,(const oratext*)"",0,p1,l,0,0,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ - "%sTypeByName(%p,%p,%p,%s,%d)=%s\n",\ - OciTp, (void*)envhp, (void*)errhp, (void*)svchp, (char*)(p1),(l),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(envhp,errhp,ref,tdo,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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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( envhp, errhp, locp, csidp, stat ) \ +#define OCILobCharSetId_log_stat(impxxh, envhp, errhp, locp, csidp, stat ) \ stat = OCILobCharSetId( envhp, errhp, locp, csidp ); \ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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( envhp, errhp, locp, formp, stat ) \ +#define OCILobCharSetForm_log_stat(impxxh, envhp, errhp, locp, formp, stat ) \ stat = OCILobCharSetForm( envhp, errhp, locp, formp ); \ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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( valp, size, item, charset, rsizep ,stat ) \ +#define OCINlsEnvironmentVariableGet_log_stat(impdbh, valp, size, item, charset, rsizep ,stat ) \ stat = OCINlsEnvironmentVariableGet( valp, size, item, charset, rsizep ); \ - (DBD_OCI_TRACEON) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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( envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ,stat ) \ +#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) \ - ? PerlIO_printf(DBD_OCI_TRACEFP,\ + (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(th,ht,ah,sp,at,eh,stat) \ +#define OCIAttrGet_log_stat(impxxh, th,ht,ah,sp,at,eh,stat) \ stat = OCIAttrGet(th,ht,ah,sp,at,eh); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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_d_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, \ + (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(dh, ht, \ + 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(parmdp, OCI_DTYPE_PARAM, \ + OCIAttrGet_d_log_stat(imp_sth, parmdp, OCI_DTYPE_PARAM, \ (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, \ + OCIAttrGet_log_stat(imp_sth, 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 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(impxxh,th,ht,ah,s1,a,eh,stat) do{\ stat=OCIAttrSet(th,ht,ah,s1,a,eh); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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 + oci_status_name(stat)),stat : stat; }while(0) -#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, \ + (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), \ @@ -327,182 +338,182 @@ 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(bp,ep,sd,si,sl,sr,stat) \ +#define OCIBindArrayOfStruct_log_stat(impsth,bp,ep,sd,si,sl,sr,stat) \ stat=OCIBindArrayOfStruct(bp,ep,sd,si,sl,sr); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(bh,eh,icx,cbi,ocx,cbo,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, \ + (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, \ + (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, \ + (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(envhp, p1, t) \ - if (DBD_OCI_TRACEON) PerlIO_printf(DBD_OCI_TRACEFP, \ +#define OCIDescriptorAlloc_ok(impxxh,envhp, p1, t) do{ \ + 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 %d) failed",t) + else croak("OCIDescriptorAlloc (type %d) failed",t); }while(0) -#define OCIDescriptorFree_log(d,t) \ - if (DBD_OCI_TRACEON) PerlIO_printf(DBD_OCI_TRACEFP, \ +#define OCIDescriptorFree_log(impxxh,d,t) do{\ + 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) + OCIDescriptorFree(d,t); }while(0) -#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, \ + (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, \ + ((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, \ + (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) \ +#define OCIHandleFree_log_stat(impxxh,hp,t,stat) do{ \ stat=OCIHandleFree( (hp), (t)); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + if(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 + oci_status_name(stat)); }while(0) -#define OCILobGetLength_log_stat(sh,eh,lh,l,stat) \ +#define OCILobGetLength_log_stat(impxxh,sh,eh,lh,l,stat) do{ \ stat=OCILobGetLength(sh,eh,lh,l); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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 + oci_status_name(stat)),stat : stat; }while(0) -#define OCILobGetChunkSize_log_stat(sh,eh,lh,cs,stat) \ +#define OCILobGetChunkSize_log_stat(impdbh,sh,eh,lh,cs,stat) \ stat=OCILobGetChunkSize(sh,eh,lh,cs); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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, \ + (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, \ + (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(sv,eh,lh,csi,csf,lt,ca,dur,stat) \ +#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) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(sv,eh,lh,stat) \ +#define OCILobFreeTemporary_log_stat(impxxh,sv,eh,lh,stat) \ stat=OCILobFreeTemporary(sv,eh,lh); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(ev,eh,lh,istemp,stat) \ +#define OCILobIsTemporary_log_stat(impsth,ev,eh,lh,istemp,stat) \ stat=OCILobIsTemporary(ev,eh,lh,istemp); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(sv,eh,src,dest,stat) \ +#define OCILobLocatorAssign_log_stat(impdbh,sv,eh,src,dest,stat) \ stat=OCILobLocatorAssign(sv,eh,src,dest); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \ +#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, \ + (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, \ + (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, \ + (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(sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf,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) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(hp,ht,eh,pp,ps,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, \ + (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 @@ -510,78 +521,78 @@ #define OCIServerAttach_log_stat(imp_dbh, dbname,md,stat) \ stat=OCIServerAttach( imp_dbh->srvhp, imp_dbh->errhp, \ (text*)dbname, (sb4)strlen(dbname), md); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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, \ + (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(sh,eh,nr,or,os,stat) \ - stat=OCIStmtFetch2(sh,eh,nr,or,os,OCI_DEFAULT); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ +#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(sh,eh,s1,sl,l,m,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, \ + (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, \ + (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, \ + (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, \ + (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, \ + (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, \ + (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(svchp,errhp,admhp,mode,flags,stat) \ +#define OCIDBStartup_log_stat(impdbh,svchp,errhp,admhp,mode,flags,stat) \ stat=OCIDBStartup(svchp,errhp,admhp,mode,flags); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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(svchp,errhp,admhp,mode,stat) \ +#define OCIDBShutdown_log_stat(impdbh,svchp,errhp,admhp,mode,stat) \ stat=OCIDBShutdown(svchp,errhp,admhp,mode); \ - (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + (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 diff --git a/oraperl.ph b/oraperl.ph deleted file mode 100644 index 99f62994..00000000 --- a/oraperl.ph +++ /dev/null @@ -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; diff --git a/t/00dbdoracletestlib.t b/t/00dbdoracletestlib.t new file mode 100644 index 00000000..4c690cb3 --- /dev/null +++ b/t/00dbdoracletestlib.t @@ -0,0 +1,43 @@ +#!perl + +use strict; +use warnings; + +use Test::More; +use Symbol qw( delete_package ); + +use lib 't/lib'; + +require_ok('DBDOracleTestLib') + or BAIL_OUT 'DBDOracleTestLib require problem... impossible to proceed'; + +my @functions = qw/ + db_handle extra_wide_rows long_test_cols + oracle_test_dsn show_test_data test_data + select_test_count select_rows + cmp_ok_byte_nice show_db_charsets + db_ochar_is_utf db_nchar_is_utf + client_ochar_is_utf8 client_nchar_is_utf8 + set_nls_nchar set_nls_lang_charset + insert_test_count nice_string + create_table table drop_table insert_rows dump_table + force_drop_table +/; + +can_ok('DBDOracleTestLib', @functions); + +sub is_exported_by { + my ($imports, $expect, $msg) = @_; + delete_package 'Clean'; + eval ' + package Clean; + DBDOracleTestLib->import(@$imports); + ::is_deeply([sort keys %Clean::], [sort @$expect], $msg); + ' or die "# $@"; +} + +is_exported_by([], [], 'nothing is exported by default'); + +done_testing; + +1; diff --git a/t/00versions.t b/t/00versions.t deleted file mode 100644 index 9307e49f..00000000 --- a/t/00versions.t +++ /dev/null @@ -1,45 +0,0 @@ -# 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; -} diff --git a/t/01base.t b/t/01base.t old mode 100755 new mode 100644 index b06c84b1..6cce01de --- a/t/01base.t +++ b/t/01base.t @@ -1,4 +1,7 @@ -#!perl -w +#!perl + +use strict; +use warnings; # Base DBD Driver Test use Test::More tests => 6; @@ -6,47 +9,26 @@ use Test::More tests => 6; require_ok('DBI'); eval { - import DBI; + DBI->import }; -ok(!$@, 'import DBI'); -$switch = DBI->internal; -is(ref $switch, 'DBI::dr', 'internal'); +is( $@ => '', 'successfully import DBI' ); -eval { +is( ref DBI->internal => 'DBI::dr', 'internal' ); + +my $drh = eval { # This is a special case. install_driver should not normally be used. - $drh = DBI->install_driver('Oracle'); + DBI->install_driver('Oracle'); }; -my $ev = $@; -ok(!$ev, 'install_driver'); -if ($ev) { - $ev =~ s/\n\n+/\n/g; - warn "Failed to load Oracle extension and/or shared libraries:\n$@"; - 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.txt file for help. ***\n"; - } - else { - warn "*** Please read the README and README.help.txt files for help. ***\n"; - } - warn "\n"; - sleep 5; -} +is( $@ => '', q|install_driver('Oracle') doesnt fail| ) + or diag "Failed to load Oracle extension and/or shared libraries"; SKIP: { - skip 'install_driver failed - skipping remaining', 2 if $ev; + skip 'install_driver failed - skipping remaining', 2 if $@; - is(ref $drh, 'DBI::dr', 'install_driver'); + is( ref $drh => 'DBI::dr', 'install_driver(Oracle) returns the correct object' ) + or diag '$drh wrong object type, found: ' . ref $drh; - ok($drh->{Version}, 'version'); + ok( do { $drh && $drh->{Version} }, 'version found in $drh object'); } - -# 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. diff --git a/t/02versions.t b/t/02versions.t new file mode 100644 index 00000000..a1687e0e --- /dev/null +++ b/t/02versions.t @@ -0,0 +1,46 @@ +#!perl +# reports on all interesting versions + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +use Test::More tests => 2; + +use DBD::Oracle qw/ ORA_OCI /; + +my $oci_version = ORA_OCI(); + +diag 'OCI client library version: ', $oci_version; + +ok $oci_version; + +SKIP: { + my $dbh = db_handle( { PrintError => 0 } ) + or note <<'END_NOTE' or skip q{Can't connect to Oracle 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; + + $sth->finish; + + diag 'Database version: ', $version; + + ok $version, 'Version exists'; +} diff --git a/t/05base.t b/t/05base.t new file mode 100644 index 00000000..a8ed9102 --- /dev/null +++ b/t/05base.t @@ -0,0 +1,35 @@ +#!perl + +use strict; +use warnings; + +# Base DBD Driver Test +use Test::More tests => 6; + +require_ok('DBI'); + +eval { DBI->import }; + +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( $@ => '', q|install_driver('Oracle') doesnt fail| ) + 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(Oracle) returns the correct object' + ) or diag '$drh wrong object type, found: ' . ref $drh; + + ok( do { $drh && $drh->{Version} }, 'version found in $drh object' ); +} diff --git a/t/10general.t b/t/10general.t index eefa5d88..9e95175c 100644 --- a/t/10general.t +++ b/t/10general.t @@ -1,114 +1,145 @@ +#!perl + use strict; use warnings; +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + use Test::More; use DBI; -use Oraperl; 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, - }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests => 30; -} else { - plan skip_all => "Unable to connect to Oracle"; + plan tests => 28; +} +else { + plan skip_all => 'Unable to connect to Oracle'; } -my($sth, $p1, $p2, $tmp); +my ( $sth, $p1, $p2, $tmp ); SKIP: { - skip "not unix-like", 2 unless $Config{d_semctl}; + 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; + 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 - is system("exit 1;"), 1<<8, 'system exit 1 should return 256'; - is system("exit 0;"), 0, 'system exit 0 should return 0'; + # 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 */ +$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'); + 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}; + 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'); +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'); +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]"); +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=''; +my $warn = ''; eval { - local $SIG{__WARN__} = sub { $warn = $_[0] }; - $dbh->{RaiseError} = 1; - $dbh->{PrintError} = 1; - $dbh->do("some invalid sql statement"); + 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:'"); +ok( + $@ =~ m/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'); -ok($ora_errno, 'ora_errno defined'); -is($ora_errno, $DBI::err, 'ora_errno and err equal'); +ok( + $warn =~ m/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'); +ok( $dbh->ping, 'ping - connected' ); -my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar +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'); +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' ); diff --git a/t/12impdata.t b/t/12impdata.t index d66dc414..6eaa6d82 100644 --- a/t/12impdata.t +++ b/t/12impdata.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl $| = 1; ## ---------------------------------------------------------------------------- @@ -7,49 +7,51 @@ $| = 1; ## ---------------------------------------------------------------------------- use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + 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."; + 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, - }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { plan tests => 7; -} else { - plan skip_all => "Unable to connect to Oracle"; +} +else { + plan skip_all => 'Unable to connect to Oracle'; } my $drh = $dbh->{Driver}; -my ($sess_1) = $dbh->selectrow_array("select userenv('sessionid') from dual"); +my ($sess_1) = $dbh->selectrow_array(q/select userenv('sessionid') from dual/); -is $drh->{Kids}, 1, "1 kid"; -is $drh->{ActiveKids}, 1, "1 active kid"; +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"; +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"; +$dbh = db_handle( { dbi_imp_data => $imp_data } ); +my ($sess_2) = $dbh->selectrow_array(q/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"; +is $drh->{Kids}, 1, '1 kid'; +is $drh->{ActiveKids}, 1, '1 active kid'; __END__ diff --git a/t/14threads.t b/t/14threads.t index 4f89ecbb..e68ab2da 100644 --- a/t/14threads.t +++ b/t/14threads.t @@ -1,12 +1,21 @@ -#!/usr/bin/perl +#!perl + +use strict; +use warnings; + $| = 1; ## ---------------------------------------------------------------------------- ## 14threads.t -## By Jeffrey Klein, +## By Jeffrey Klein, ## ---------------------------------------------------------------------------- -BEGIN { eval "use threads; use threads::shared;" } +# This needs to be the very very first thing +BEGIN { eval 'use threads; use threads::shared;' } + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + my $use_threads_err = $@; use DBI; use Config qw(%Config); @@ -15,31 +24,26 @@ 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."; - } + } + 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, - }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests => 19; $dbh->disconnect; -} else { - plan skip_all => "Unable to connect to Oracle"; +} +else { + plan skip_all => 'Unable to connect to Oracle'; } my $last_session : shared; @@ -50,6 +54,9 @@ our @pool : shared; # TESTS: 5 +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + for my $i ( 0 .. 4 ) { threads->create( sub { @@ -60,21 +67,21 @@ for my $i ( 0 .. 4 ) { if ( $i > 0 ) { is $session, $last_session, "session $i matches previous session"; - } else { - ok $session, "session $i created", + } + 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( @@ -108,15 +115,15 @@ my @sem; use Thread::Semaphore; # create locked semaphores -for my $i (0..2) { - push @sem, Thread::Semaphore->new(0); +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 ) { +for my $t ( 0 .. 2 ) { $thr[$t] = threads->create( sub { my $partner = ( $t + 1 ) % 3; @@ -129,9 +136,9 @@ for my $t ( 0..2 ) { if ( defined $last_session ) { is $session, $last_session, "thread $t, loop $i matches previous session"; - } else { - ok $session, - "thread $t, loop $i created session"; + } + else { + ok $session, "thread $t, loop $i created session"; } $last_session = $session; free_dbh_to_pool($dbh); @@ -153,6 +160,8 @@ empty_pool(); is scalar(@pool), 0, 'pool empty'; +done_testing; + exit; sub get_dbh_from_pool { @@ -174,14 +183,12 @@ sub empty_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 } ); + return db_handle( { dbi_imp_data => $imp_data } ); } sub session_id { my $dbh = shift; - my ($s) = $dbh->selectrow_array("select userenv('sessionid') from dual"); + my ($s) = $dbh->selectrow_array("select userenv('sid') from dual"); return $s; } __END__ diff --git a/t/15nls.t b/t/15nls.t index b9c23a16..c1990a66 100644 --- a/t/15nls.t +++ b/t/15nls.t @@ -1,48 +1,55 @@ #!perl + use strict; use warnings; +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + 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, - }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { plan tests => $testcount; -} else { - plan skip_all => "Unable to connect to Oracle"; +} +else { + plan skip_all => 'Unable to connect to Oracle'; } -my ($nls_parameters_before, $nls_parameters_after); +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'); +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'); +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( $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'); +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'); +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__ diff --git a/t/15threads.t b/t/15threads.t new file mode 100644 index 00000000..a0e39ec4 --- /dev/null +++ b/t/15threads.t @@ -0,0 +1,105 @@ +#!perl + +use strict; +use warnings; +# This needs to be the very very first thing +BEGIN { eval 'use threads; use threads::shared;' } +use Config qw(%Config); +use Test::More; +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; +use DBD::Oracle qw(ora_shared_release); + +$| = 1; +if ( !$Config{useithreads} || "$]" < 5.008 ) { + plan skip_all => "this $^O perl $] not configured to support iThreads"; + exit(0); +} +if ( $DBI::VERSION <= 1.601 ) { + plan skip_all => 'DBI version ' + . $DBI::VERSION + . ' does not support iThreads. Use version 1.602 or later.'; + exit(0); +} +my $dbh = db_handle( { PrintError => 0 } ); + +if ($dbh) { + $dbh->disconnect; +} +else { + plan skip_all => 'Unable to connect to Oracle'; +} +my $last_session : shared; +my $holder : shared; + +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + +for my $i ( 0 .. 4 ) { + threads->create( + sub { + my $dbh = db_handle( { ora_dbh_share => \$holder, PrintError => 0 } ); + if($dbh) + { + 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; + $dbh->disconnect(); + } + else + { + ok 0, "no connection " . $DBI::errstr; + } + } + )->join; +} +ora_shared_release($holder); + +# now the same, but let shared variable be destroyed +threads->create( + sub { + my $other : shared; + for my $i ( 0 .. 4 ) { + threads->create( + sub { + my $dbh = db_handle( { ora_dbh_share => \$other, PrintError => 0 } ); + if($dbh) + { + 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; + $dbh->disconnect(); + } + else + { + ok 0, "no connection " . $DBI::errstr; + } + } + )->join; + } + ora_shared_release($other); + } +)->join; +done_testing; + +sub session_id { + my $dbh = shift; + my ($s) = $dbh->selectrow_array("select userenv('sid') from dual"); + return $s; +} diff --git a/t/16cached.t b/t/16cached.t new file mode 100644 index 00000000..4e595796 --- /dev/null +++ b/t/16cached.t @@ -0,0 +1,34 @@ +#!perl +#written by Andrey A Voropaev (avorop@mail.ru) + +use strict; +use warnings; + +use Test::More; +use DBI; +use FindBin qw($Bin); +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle /; + +my $dbh; +$| = 1; + +SKIP: { + $dbh = db_handle(); + + # $dbh->{PrintError} = 1; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + + plan tests => 3; + + note 'Testing multiple cached connections...'; + + ok -d $Bin, "t/ directory exists"; + ok -f "$Bin/cache2.pl", "t/cache2.pl exists"; + + system("perl -MExtUtils::testlib $Bin/cache2.pl"); + ok($? == 0, "clean termination with multiple cached connections"); +} + +__END__ + diff --git a/t/16drcp.t b/t/16drcp.t new file mode 100644 index 00000000..7441063a --- /dev/null +++ b/t/16drcp.t @@ -0,0 +1,115 @@ +#!perl + +use strict; +use warnings; +# This needs to be the very very first thing +BEGIN { eval 'use threads; use threads::shared;' } + +$| = 1; + +## ---------------------------------------------------------------------------- +## 16drcp.t +## By Andrey A. Voropaev +## ---------------------------------------------------------------------------- +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; +use DBD::Oracle qw(OCI_SPOOL_ATTRVAL_NOWAIT); +use DBI; +use Test::More; + +{ + my $dbh = db_handle( { PrintError => 0 } ); + + if ($dbh) { + $dbh->disconnect; + } + else { + plan skip_all => 'Unable to connect to Oracle'; + } +} + +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + +{ + my $dbh = db_handle( { ora_drcp=>1, ora_drcp_max => 2, PrintError => 0 } ); + ok defined $dbh, 'first connection from pool'; + my $dbh1 = db_handle( { ora_drcp=>1, PrintError => 0 } ); + ok defined $dbh1, 'second connection from pool'; + is $dbh->{ora_drcp_used}, 2, 'count of used connections is 2'; + $dbh->{ora_drcp_mode} = OCI_SPOOL_ATTRVAL_NOWAIT; + my $dbh2 = db_handle( { ora_drcp=>1, PrintError => 0 } ); + ok !defined $dbh2, 'third connection from pool not allowed'; + + $dbh->do(q(alter session set NLS_DATE_FORMAT='yyyy.mm.dd')); + $dbh->{ora_drcp_tag} = 's1'; + $dbh1->do(q(alter session set NLS_DATE_FORMAT='dd.mm.yyyy')); + $dbh1->{ora_drcp_tag} = 's2'; + + $dbh->disconnect(); + $dbh1->disconnect(); +} +{ + my $dbh = db_handle( { ora_drcp=>1, ora_drcp_tag=> 's1', PrintError => 0 } ); + if ($dbh) { + my $found_tag = $dbh->{ora_drcp_tag}; + ok((defined $found_tag && $found_tag eq 's1'), 's1 session from pool'); + my $sth = $dbh->prepare('select sysdate from dual'); + $sth->execute(); + my $x = $sth->fetchall_arrayref(); + ok($x->[0][0] =~ /^\d{4}\.\d\d\.\d\d$/, "date in format yyyy.mm.dd"); + $dbh->disconnect(); + } + else { + ok 0, 'finding session s1'; + } +} +{ + my $dbh = db_handle( { ora_drcp=>1, ora_drcp_tag=> 's2', PrintError => 0 } ); + if ($dbh) { + my $found_tag = $dbh->{ora_drcp_tag}; + ok((defined $found_tag && $found_tag eq 's2'), 's2 session from pool'); + my $sth = $dbh->prepare('select sysdate from dual'); + $sth->execute(); + my $x = $sth->fetchall_arrayref(); + ok($x->[0][0] =~ /^\d\d\.\d\d\.\d{4}$/, "date in format dd.mm.yyyy"); + $dbh->disconnect(); + } + else { + ok 0, 'finding session s2'; + } +} + +eval{ + my @sts : shared;; + my $th1 = threads->create( + sub{ chk('s1', qr(\d{4}\.\d\d\.\d\d), $sts[0]) } + ); + my $th2 = threads->create( + sub {chk('s2', qr(\d\d\.\d\d\.\d{4}), $sts[1]) } + ); + $th1->join(); + $th2->join(); + ok($sts[0], 'first thread'); + ok($sts[1], 'second thread'); +}; + +done_testing; + +sub chk +{ + my $tag = shift; + my $p = shift; + my $dbh = db_handle( { ora_drcp=>1, ora_drcp_tag=> $tag, PrintError => 0 } ); + if ($dbh) { + my $found_tag = $dbh->{ora_drcp_tag}; + my $sth = $dbh->prepare('select sysdate from dual'); + $sth->execute(); + my $x = $sth->fetchall_arrayref(); + $_[0] = $found_tag eq $tag && $x->[0][0] =~ /^$p$/; + $dbh->disconnect(); + } + else { + $_[0] = 0; + } +} diff --git a/t/20select.t b/t/20select.t index c19d23d3..15f6652b 100644 --- a/t/20select.t +++ b/t/20select.t @@ -1,170 +1,183 @@ -#!perl -w +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn client_ochar_is_utf8 table drop_table +db_handle /; + 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 ], -); +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) +# 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 = 3; my $tests_per_set = 11; $tests += @test_sets * $tests_per_set; -my $t = 0; +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, - }); +my $table = table(); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests=>$tests; -} else { + 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; +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)) { +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); +my ( $sth, $p1, $p2, $tmp, @tmp ); -foreach (@test_sets) { - run_select_tests( @$_ ); +for (@test_sets) { + run_select_tests(@$_); } -my $ora_server_version = $dbh->func("ora_server_version"); +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! + 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"); - } + !, {}, '1 07:00:00' + ); + ok( ( defined $data and $data eq '+000000001 07:00:00.000000000' ), + 'ds_interval' ); +} +# FIXME - maybe remove this 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}); + 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, $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'); +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; + eval { drop_table($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 + my ( $type_name, $field_len ) = @_; -# end. + 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' ) + or diag '$sth->errstr: ' . $sth->errstr; + + 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 ( $fields, $drop ) = @_; my $sql = qq{create table $table ( - idx integer, - $fields, - dt date, - primary key (dt, idx) + idx integer, + $fields, + dt date, + primary key (dt, idx) )}; - $dbh->do(qq{ drop table $table }) if $drop; + $dbh->do(qq{ DROP TABLE $table PURGE }) 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); + if ( $dbh->err && $dbh->err == 955 ) { + $dbh->do(qq{ DROP TABLE $table PURGE }); + warn "Unexpectedly had to drop old test table '$table'\n" + unless $dbh->err; + $dbh->do($sql); } return 0 if $dbh->err; return 1; diff --git a/t/21nchar.t b/t/21nchar.t index 70faf494..36955b2c 100644 --- a/t/21nchar.t +++ b/t/21nchar.t @@ -1,66 +1,71 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; -use Test::More; +use warnings; -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle show_db_charsets set_nls_nchar test_data + insert_test_count select_test_count show_test_data + drop_table create_table insert_rows dump_table select_rows + force_drop_table +/; +use Test::More; 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 => + '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); + # $dbh->{PrintError} = 1; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; - plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" - if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; + 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 + $dbh->disconnect(); # we want to start over with the ncharset we select undef $dbh; if ( $ncharset =~ m/UTF/i ) { - $ncharset = 'WE8ISO8859P1' ; #WE8MSWIN1252 + $ncharset = 'WE8ISO8859P1'; #WE8MSWIN1252 } - set_nls_nchar( $ncharset ,1 ); + 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; - ; + 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 ); + plan tests => $testcount; + show_test_data( $tdata, 0 ); - drop_table($dbh); + force_drop_table($dbh); create_table( $dbh, $tdata ); - insert_rows( $dbh, $tdata ,SQLCS_NCHAR); - dump_table( $dbh ,'nch' ,'descr' ); + 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}; + + # 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'}; + drop_table($dbh) }; } diff --git a/t/22cset.t b/t/22cset.t new file mode 100644 index 00000000..5efee25a --- /dev/null +++ b/t/22cset.t @@ -0,0 +1,125 @@ +#!perl +#written by Andrey A Voropaev (avorop@mail.ru) + +use strict; +use warnings; + +use Test::More; +use DBI; +use DBD::Oracle qw(ORA_OCI); +use Encode; +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle drop_table table force_drop_table /; + +my $dbh1; +my $dbh2; +$| = 1; +SKIP: { + plan skip_all => + 'Unable to run multiple cset test, perl version is less than 5.6' + unless ( $] >= 5.006 ); + + $dbh1 = db_handle({ + RaiseError => 0, + PrintError => 0, + AutoCommit => 1, + ora_charset => 'WE8MSWIN1252', + }); + + plan skip_all => 'Unable to connect to Oracle' unless $dbh1; + + plan skip_all => 'Oracle charset tests unreliable for Oracle 8 client' + if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; + + my $h = $dbh1->ora_nls_parameters(); + my $chs = $h->{NLS_CHARACTERSET}; + if($chs ne 'WE8MSWIN1252' && $chs ne 'WE8ISO8859P1' && $chs !~ /^AL[13]/) + { + plan skip_all => 'Oracle uses incompatible charset'; + } + note("Testing multiple connections with different charsets...\n"); + + $dbh2 = db_handle({ + RaiseError => 0, + PrintError => 0, + AutoCommit => 1, + ora_charset => 'AL32UTF8', + }); + + my $testcount = 3; + + plan tests => $testcount; + + my $tname = table(); + force_drop_table($dbh1); + $dbh1->do( + qq{create table $tname (idx number, txt varchar2(50))} + ); + die "Failed to create test table\n" if($dbh1->err); + + my $sth = $dbh1->prepare( + qq{insert into $tname (idx, txt) values(?, ?)} + ); + my $utf8_txt = 'äöüÜÖÄ'; + my $x = $utf8_txt; + Encode::from_to($x, 'UTF-8', 'Latin1'); + $sth->execute(1, $x); + + $sth = $dbh1->prepare( + qq{select txt from $tname where idx=1} + ); + $sth->execute(); + my $r = $sth->fetchall_arrayref(); + ok(must_be_latin1($r, $utf8_txt), "Latin1 support"); + + $sth = $dbh2->prepare( + qq{insert into $tname (idx, txt) values(?, ?)} + ); + # insert bytes + $x = $utf8_txt; + $sth->execute(2, $x); + # insert characters + $x = $utf8_txt; + $sth->execute(3, Encode::decode('UTF-8', $x)); + + $sth = $dbh2->prepare( + qq{select txt from $tname where idx=?} + ); + $sth->execute(2); + $r = $sth->fetchall_arrayref(); + ok(must_be_utf8($r, $utf8_txt), "UTF-8 as bytes"); + $sth->execute(3); + $r = $sth->fetchall_arrayref(); + ok(must_be_utf8($r, $utf8_txt), "UTF-8 as characters"); +} + +sub must_be_latin1 +{ + my $r = shift; + return unless @$r == 1; + my $x = $r->[0][0]; + # it shouldn't be encoded + return if Encode::is_utf8($x); + Encode::from_to($x, 'Latin1', 'UTF-8'); + return $x eq $_[0]; +} + +sub must_be_utf8 +{ + my $r = shift; + return unless @$r == 1; + my $x = $r->[0][0]; + # it should be encoded + return unless Encode::is_utf8($x); + return Encode::encode('UTF-8', $x) eq $_[0]; +} + + +END { + eval { + drop_table($dbh1) + }; +} + +__END__ + diff --git a/t/22nchar_al32utf8.t b/t/22nchar_al32utf8.t index 8a28f317..a95cbac2 100644 --- a/t/22nchar_al32utf8.t +++ b/t/22nchar_al32utf8.t @@ -1,51 +1,54 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ set_nls_nchar db_handle db_nchar_is_utf + show_db_charsets test_data insert_test_count + select_test_count show_test_data drop_table + create_table insert_rows dump_table select_rows + force_drop_table +/; + 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}; + 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 ); + 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" ; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database NCHAR character set is not Unicode' + unless db_nchar_is_utf($dbh); + # diag "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; - ; + 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); + show_test_data( $tdata, 0 ); + force_drop_table($dbh); create_table( $dbh, $tdata ); - insert_rows( $dbh, $tdata ,SQLCS_NCHAR); - dump_table( $dbh ,'nch' ,'descr' ); + 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'}; - }; + eval { drop_table($dbh) }; } diff --git a/t/22nchar_utf8.t b/t/22nchar_utf8.t index 68e08040..1ebc9da0 100644 --- a/t/22nchar_utf8.t +++ b/t/22nchar_utf8.t @@ -1,58 +1,65 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ set_nls_nchar db_handle db_nchar_is_utf select_rows + show_db_charsets test_data extra_wide_rows + insert_test_count select_test_count dump_table + show_test_data drop_table create_table insert_rows + force_drop_table +/; + 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}; + 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 ); + 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) ; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database NCHAR character set is not Unicode' + unless db_nchar_is_utf($dbh); # testing utf8 with nchar columns - show_db_charsets( $dbh ); - my $tdata = test_data( 'wide_nchar' ); + show_db_charsets($dbh); + my $tdata = test_data('wide_nchar'); if ( $dbh->ora_can_unicode & 1 ) { - push( @{$tdata->{rows}} ,extra_wide_rows() ) ; + 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; - ; + 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); + show_test_data( $tdata, 0 ); + force_drop_table($dbh); create_table( $dbh, $tdata ); - insert_rows( $dbh, $tdata ,SQLCS_NCHAR); - dump_table( $dbh ,'nch' ,'descr' ); + 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'}; + drop_table($dbh) if ( $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'} ); }; } diff --git a/t/23wide_db.t b/t/23wide_db.t index 25541111..00682d88 100644 --- a/t/23wide_db.t +++ b/t/23wide_db.t @@ -1,54 +1,59 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ + set_nls_lang_charset db_handle db_ochar_is_utf test_data + insert_test_count select_test_count show_test_data + force_drop_table create_table insert_rows dump_table + select_rows + /; + 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}; + 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 ); -#! #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) ; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database character set is not Unicode' + unless 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; - ; + 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); + plan tests => $testcount; + show_test_data( $tdata, 0 ); + force_drop_table($dbh); create_table( $dbh, $tdata ); - insert_rows( $dbh, $tdata ,SQLCS_NCHAR); - dump_table( $dbh ,'ch' ,'descr' ); + insert_rows( $dbh, $tdata, SQLCS_NCHAR ); + dump_table( $dbh, 'ch', 'descr' ); select_rows( $dbh, $tdata ); -} + +} # SKIP END { - eval { - local $dbh->{PrintError} = 0; - drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; - }; + eval { drop_table($dbh); }; } diff --git a/t/23wide_db_8bit.t b/t/23wide_db_8bit.t index dcd1980e..83928c29 100644 --- a/t/23wide_db_8bit.t +++ b/t/23wide_db_8bit.t @@ -1,51 +1,54 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ + set_nls_lang_charset db_handle db_ochar_is_utf + force_drop_table create_table insert_rows + dump_table select_rows drop_table test_data + insert_test_count select_test_count + show_test_data +/; + 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}; + 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 ); + 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" ; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database character set is not Unicode' + unless 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; - ; + 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); + plan tests => $testcount; + show_test_data( $tdata, 0 ); + force_drop_table($dbh); create_table( $dbh, $tdata ); - insert_rows( $dbh, $tdata ,SQLCS_NCHAR); - dump_table( $dbh ,'ch' ,'descr' ); + 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'}; - }; + eval { drop_table($dbh) }; } diff --git a/t/23wide_db_al32utf8.t b/t/23wide_db_al32utf8.t index b0ba18a6..ba5ee218 100644 --- a/t/23wide_db_al32utf8.t +++ b/t/23wide_db_al32utf8.t @@ -1,30 +1,36 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; +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'; +use lib 't/lib'; +use DBDOracleTestLib qw/ + db_handle drop_table force_drop_table + test_data show_test_data select_rows + create_table insert_rows dump_table + set_nls_lang_charset db_ochar_is_utf + insert_test_count select_test_count +/; 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}; + 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) ; + plan skip_all => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database character set is not Unicode' unless db_ochar_is_utf($dbh) ; # testing utf8 with char columns (wide mode database) my $tdata = test_data( 'wide_char' ); @@ -35,17 +41,15 @@ SKIP: { plan tests => $testcount; show_test_data( $tdata ,0 ); - drop_table($dbh); + force_drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'ch' ,'descr' ); select_rows( $dbh, $tdata ); -} + +} # SKIP END { - eval { - local $dbh->{PrintError} = 0; - drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; - }; + drop_table($dbh) } diff --git a/t/24implicit_utf8.t b/t/24implicit_utf8.t index 518297b1..8a4be443 100644 --- a/t/24implicit_utf8.t +++ b/t/24implicit_utf8.t @@ -1,12 +1,18 @@ -#!perl -w +#!perl #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; -#use warnings; -use Test::More; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ + db_handle db_nchar_is_utf db_ochar_is_utf test_data + insert_test_count select_test_count show_test_data + set_nls_nchar show_db_charsets force_drop_table + create_table insert_rows dump_table select_rows +/; -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; +use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR ); @@ -14,51 +20,52 @@ 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}; + 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 - $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 => 'Unable to connect to Oracle' unless $dbh; + plan skip_all => 'Database NCHAR character set is not Unicode' + unless 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 $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); + my @nchar_cset = ( ORA_OCI >= 9.2 ) ? qw(UTF8 AL32UTF8) : qw(UTF8); plan tests => $testcount * @nchar_cset; - show_test_data( $tdata ,0 ); + show_test_data( $tdata, 0 ); - foreach my $nchar_cset (@nchar_cset) { + foreach my $nchar_cset (@nchar_cset) { $dbh->disconnect() if $dbh; - undef $dbh; + undef $dbh; + # testing with NLS_NCHAR=$nchar_cset - SKIP: { - set_nls_nchar( $nchar_cset ,1 ); + 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); + show_db_charsets($dbh); + skip "failed to connect to oracle with NLS_NCHAR=$nchar_cset", + $testcount + unless $dbh; + force_drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ); - dump_table( $dbh ,'nch' ,'descr' ); + 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'}; - }; + eval { drop_table($dbh); }; } __END__ diff --git a/t/25plsql.t b/t/25plsql.t index da18a8b1..9aa53056 100644 --- a/t/25plsql.t +++ b/t/25plsql.t @@ -1,338 +1,445 @@ -#!perl -w +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + 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 }); +my $dbh = db_handle( { 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'; + 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 tests => 86; +} +else { plan skip_all => "Unable to connect to Oracle \n"; } +my ( $csr, $p1, $p2, $tmp, @tmp ); -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'); +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'); - +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{ +ok( + $csr = $dbh->prepare( + q{ DECLARE FOO EXCEPTION; - begin raise FOO; end;}), 'prepare user defined expcetion'); + 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'); - +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{ +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'); + 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'); - +ok( !$csr->execute, 'execute 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{ +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); + err_num := :1; + err_msg := :2; + raise_application_error(-20000-err_num, 'msg is '||err_msg); end; -}), 'prepare raise application error with in params'); +} + ), + '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'); +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{ +ok( + $csr = $dbh->prepare( + q{ begin - :arg := :arg * :mult; - end;}), 'prepare named numeric in/out params'); + :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'); +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; }; + 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'); +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'); +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'); +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{ +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'); + :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'); +$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"; + for ( 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'); +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'); +ok( $csr->execute, 'execute binding a null' ); +is( $p1, 'null!', 'get a null string back' ); $csr->finish; - -ok($csr = $dbh->prepare(q{ +ok( + $csr = $dbh->prepare( + q{ begin - :out := nvl(upper(:in), 'null'); - end;}), 'prepare nvl'); + :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_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'); +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{ +ok( + $csr = $dbh->prepare( + q{ begin - select rpad('foo',200) into :arg from dual; - end;}), 'prepare test output buffer too small'); + 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'); +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) +# 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'); +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 +# 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"); +#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); +# 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'); +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'); +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 '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 = 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'); +@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 + 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 $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); + 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 = $dbh->selectall_arrayref( $cur_query, undef, 'V%' ); my @s1 = map { @$_ } @$s1; - is("@r", "@s1", "ref = sql"); + is( join( ' ', sort @r ), join( ' ', sort @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'); + 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'); + 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 = $dbh->selectall_arrayref( $cur_query, undef, 'U%' ); my @s2 = map { @$_ } @$s2; - is("@r", "@s2", "ref = sql"); + 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 +SKIP: { + # test bind_param_inout of param that's not assigned to in executed statement + # Github Issue #70 + # Also see http://www.mail-archive.com/dbi-users@perl.org/msg18835.html + + # Known bad OCI versions + ## Confirmed: still bad while using 23.7(client) 21.3(server)- 2025-05-17 + skip 'Client version is known to have issue', 4 + if DBD::Oracle::ORA_OCI() > 18.0; + + my $sth = $dbh->prepare( + q( + BEGIN -- :p1 := :p1 ; -- :p2 := :p2 ; IF :p2 != :p3 THEN :p1 := 'AAA' ; :p2 := 'Z' ; END IF ; -END ;)); + 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"); +} + +# test bind_paraminout the correct way (avoids the above issue if present) +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) ; + 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'); + ok( $sth->execute, 'test bind_param_inout for properly 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||'')); + 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( + q/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'); + 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"); + 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 - +# test NULLs at first bind +# NULLs later binds. +# returning NULLs +# multiple params, mixed types and in only vs inout exit 0; diff --git a/t/26exe_array.t b/t/26exe_array.t index 52107a96..b5fd12cd 100644 --- a/t/26exe_array.t +++ b/t/26exe_array.t @@ -1,468 +1,64 @@ -#!/usr/bin/perl -w -I./t +#!perl +# 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 -## ---------------------------------------------------------------------------- -## 26exe_array.t this is a completly new one -## By Martin J. Evans orgianlly called 70execute_array.t for the ODBC DBD driver -## and adatped into DBD::Oracle (in a very minor way) by John Scoles, The Pythian Group -## ---------------------------------------------------------------------------- -## loads of execute_array and execute_for_fetch tests -## tests both insert and update and row fetching -## with RaiseError on and off and AutoCommit on and off -## ---------------------------------------------------------------------------- +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; use Test::More; -use strict; use Data::Dumper; -require 'nchar_test_lib.pl'; +require Test::NoWarnings; # deliberately not calling import() $| = 1; - -my $table = 'PERL_DBD_execute_array'; -my $table2 = 'PERL_DBD_execute_array2'; -my @captured_error; # values captured in error handler - - -# create a database handle -my $dsn = oracle_test_dsn(); -my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; -$ENV{NLS_NCHAR} = "US7ASCII"; -$ENV{NLS_LANG} = "AMERICAN"; - -my $dbh; -my @p1 = (1,2,3,4,5); -my @p2 = qw(one two three four five); -my $fetch_row = 0; - use DBI qw(:sql_types); +use ExecuteArray; -eval { - $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0}); -}; - -if (!$dbh) { - plan skip_all => "Unable to connect to Oracle"; -} -#$dbh->{PrintError} = 1; -my $has_test_nowarnings = 1; -eval "require Test::NoWarnings"; -$has_test_nowarnings = undef if $@; -use_ok('Data::Dumper'); - -END { - if ($dbh) { - drop_table_local($dbh); - } - Test::NoWarnings::had_no_warnings() - if ($has_test_nowarnings); - done_testing(); -} - -sub error_handler -{ - @captured_error = @_; - note("***** error handler called *****"); - 0; # pass errors on -} - -sub create_table_local -{ - my $dbh = shift; - - eval { - $dbh->do(qq/create table $table (a int primary key, b char(20))/); - }; - if ($@) { - diag("Failed to create test table $table - $@"); - return 0; - } - eval { - $dbh->do(qq/create table $table2 (a int 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_local -{ - my $dbh = shift; - - 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]/); -} +$ENV{NLS_NCHAR} = 'US7ASCII'; +$ENV{NLS_LANG} = 'AMERICAN'; -# check $table contains the data in $c1, $c2 which are arrayrefs of values -sub check_data -{ - my ($dbh, $c1, $c2) = @_; +my $dbh = db_handle( { PrintError => 0 } ) + or plan skip_all => 'Unable to connect to Oracle'; - 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++; - } -} +my $ea = ExecuteArray->new( $dbh, 1 ); # set odbc_disable_array_operations +$dbh = $ea->dbh; -sub check_tuple_status -{ - my ($tsts, $expected) = @_; - - note(Data::Dumper->Dump([$tsts], [qw(ArrayTupleStatus)])); - my $row = 0; - foreach my $s (@$tsts) { - if (ref($expected->[$row])) { - is(ref($s), 'ARRAY', 'array in array tuple status'); - is(scalar(@$s), 3, '3 elements in array tuple status error'); - } else { - if ($s == -1) { - pass("row $row tuple status unknown"); - } else { - is($s, $expected->[$row], "row $row tuple status"); - } - } - $row++ - } -} +$ea->drop_table($dbh); +ok( $ea->create_table($dbh), 'create test table' ) or exit 1; -# insert might return 'mas' which means the caller said the test -# required Multiple Active Statements and the driver appeared to not -# support MAS. -sub insert -{ - my ($dbh, $sth, $ref) = @_; +$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 } ); - 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 = (); +$ea->row_wise( $dbh, { array_context => 1, raise => 1 } ); - if ($ref->{raise}) { - $sth->{RaiseError} = 1; - } else { - $sth->{RaiseError} = 0; - } +$ea->update( $dbh, { array_context => 1, raise => 1 } ); - my (@tuple_status, $sts, $total_affected); - $sts = 999999; # to ensure it is overwritten - $total_affected = 999998; - if ($ref->{array_context}) { - eval { - if ($ref->{params}) { - ($sts, $total_affected) = - $sth->execute_array({ArrayTupleStatus => \@tuple_status}, - @{$ref->{params}}); - } elsif ($ref->{fetch}) { - ($sts, $total_affected) = - $sth->execute_array( - {ArrayTupleStatus => \@tuple_status, - ArrayTupleFetch => $ref->{fetch}}); - } else { - ($sts, $total_affected) = - $sth->execute_array({ArrayTupleStatus => \@tuple_status}); - } - }; - } else { - eval { - if ($ref->{params}) { - $sts = - $sth->execute_array({ArrayTupleStatus => \@tuple_status}, - @{$ref->{params}}); - } else { - $sts = - $sth->execute_array({ArrayTupleStatus => \@tuple_status}); +for my $raise ( 0 .. 1 ) { + for my $context ( 0 .. 1 ) { + $ea->error( + $dbh, + { + array_context => $context, + raise => $raise, + notuplestatus => 1 } - }; - } - 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}) { - 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 ($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); - 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)]); - 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(?,?)/); - - 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(?,?)/); - - 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 ($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); - 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); - 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 ($dbh, $ref) = @_; - - note("row_size via execute_for_fetch"); - - $fetch_row = 0; - clear_table($dbh, $table); - my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); - insert($dbh, $sth, - {commit => 0, error => 0, sts => 5, affected => 5, - tuple => [1, 1, 1, 1, 1], %$ref, - fetch => \&fetch_sub}); - - # NOTE: I'd like to do the following test but it requires Multiple - # Active Statements and 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. - 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/); - ok($sth2->execute, 'execute on second table') or diag($sth2->errstr); - ok($sth2->{Executed}, 'second statement is in executed state'); - my $res = 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); - #my $res = $dbh->selectall_arrayref("select * from $table2"); - #print Dumper($res); } -# test updates -sub update -{ - my ($dbh, $ref) = @_; - - note("update test"); - - $fetch_row = 0; - clear_table($dbh, $table); - my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); - 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); - - $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); - 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)]); - - $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); - 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)]); - - $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%']); - 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)]); - - +if ( $dbh && $ea ) { + $ea->drop_table($dbh); } -$dbh->{RaiseError} = 1; -$dbh->{PrintError} = 0; -$dbh->{ChopBlanks} = 1; -$dbh->{HandleError} = \&error_handler; -$dbh->{AutoCommit} = 1; - -eval {drop_table_local($dbh)}; - -ok(create_table_local($dbh), "create test table") or exit 1; -simple($dbh, {array_context => 1, raise => 1}); -simple($dbh, {array_context => 0, raise => 1}); -error($dbh, {array_context => 1, raise => 1}); -error($dbh, {array_context => 0, raise => 1}); -error($dbh, {array_context => 1, raise => 0}); -error($dbh, {array_context => 0, raise => 0}); - -row_wise($dbh, {array_context => 1, raise => 1}); +Test::NoWarnings::had_no_warnings(); -update($dbh, {array_context => 1, raise => 1}); +done_testing; diff --git a/t/28array_bind.t b/t/28array_bind.t index d107bbc0..e8cbae62 100644 --- a/t/28array_bind.t +++ b/t/28array_bind.t @@ -1,20 +1,24 @@ -#!perl -w -use strict; +#!perl ## ---------------------------------------------------------------------------- ## 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 lib 't/lib'; +use DBDOracleTestLib qw/ + set_nls_lang_charset set_nls_nchar oracle_test_dsn db_handle +/; + use Encode; use Devel::Peek; @@ -23,278 +27,331 @@ 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; +$Data::Dumper::Useqq = 1; my $dbh; -my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8'; +my $utf8_charset = ( ORA_OCI >= 9.2 ) ? 'AL32UTF8' : 'UTF8'; my $eight_bit_charset = 'WE8ISO8859P1'; -sub db_connect($) { +sub db_connect { my $utf8 = shift; # Make sure we really are overriding the environment settings. - my ($charset, $ncharset); + my ( $charset, $ncharset ); if ($utf8) { set_nls_lang_charset($eight_bit_charset); set_nls_nchar($eight_bit_charset); - $charset = $utf8_charset; + $charset = $utf8_charset; $ncharset = $utf8_charset; } else { set_nls_lang_charset($utf8_charset); set_nls_nchar($utf8_charset); - $charset = $eight_bit_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, + AutoCommit => 1, + PrintError => 0, FetchHashKeyName => 'NAME_lc', - ora_envhp => 0, # force fresh environment (with current NLS env vars) + ora_envhp => 0, # force fresh environment (with current NLS env vars) }; - $p->{ora_charset} = $charset if $charset; + $p->{ora_charset} = $charset if $charset; $p->{ora_ncharset} = $ncharset if $ncharset; - my $dbh = DBI->connect($dsn, $dbuser, '', $p); + my $dbh = db_handle( $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_varchar2_table_3_tests($) { + my $dbh = shift; + my $statement = q| + 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( 'Prepare(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 ); + } + + 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_number_table_3_tests { + my $dbh = shift; + my $statement = q| + 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( 'Prepare(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_inout_array_tests { + my $dbh = shift; + + my $privs_sth = $dbh->prepare('SELECT PRIVILEGE from session_privs'); + $privs_sth->execute; + my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref }; + + SKIP: { + skip q{don't have permission to create table} => 9 + unless grep { $_ eq 'CREATE TABLE' } @privileges; + skip q{don't have permission to create sequence} => 9 + unless grep { $_ eq 'CREATE SEQUENCE' } @privileges; + skip q{don't have permission to create trigger} => 9 + unless grep { $_ eq 'CREATE TRIGGER' } @privileges; + + my $table = 'array_io_test__drop_me' . ( $ENV{DBD_ORACLE_SEQ} || '' ); + my $seq = 'seq_io_test__drop_me' . ( $ENV{DBD_ORACLE_SEQ} || '' ); + my $trigger = 'trg_io_test__drop_me' . ( $ENV{DBD_ORACLE_SEQ} || '' ); + $dbh->do( +"create table $table (id number(12,0), name varchar2(20), value varchar2(2000))" + ); + $dbh->do("create sequence $seq start with 1"); + $dbh->do( + qq/ + create or replace trigger $trigger + before insert + on $table + for each row + DECLARE + iCounter $table.id%TYPE; + BEGIN + if INSERTING THEN + Select $seq.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 $table (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 $table PURGE") or warn $dbh->errstr; + $dbh->do("drop sequence $seq") 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; - +sub test_number_SP { + my $dbh = shift; + + my $privs_sth = $dbh->prepare('SELECT PRIVILEGE from session_privs'); + $privs_sth->execute; + my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref }; + + SKIP: { + skip q{don't have permission to create procedure} => 4 + unless grep { $_ eq 'CREATE PROCEDURE' } @privileges; + + $dbh->do( + <<'EOF' + 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; +EOF + ); + + 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; + plan tests => 19; + } + 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); - -}; + test_number_SP($dbh); -END { - eval { - local $dbh->{PrintError} = 0; - }; } +END { + eval { local $dbh->{PrintError} = 0; }; +} -+1; +1; diff --git a/t/30long.t b/t/30long.t index 1ad52565..dfb0df4f 100644 --- a/t/30long.t +++ b/t/30long.t @@ -1,493 +1,567 @@ -#!perl -w -# vim:ts=8:sw=4 +#!perl -use DBI; -use DBD::Oracle qw(:ora_types SQLCS_NCHAR SQLCS_IMPLICIT ORA_OCI); use strict; -use Test::More; +use warnings; -*BAILOUT = sub { die "@_\n" } unless defined &BAILOUT; +use lib 't/lib'; +use DBDOracleTestLib qw/ table drop_table oracle_test_dsn db_handle + show_db_charsets long_test_cols create_table + cmp_ok_byte_nice db_ochar_is_utf client_ochar_is_utf8 + nice_string db_nchar_is_utf client_nchar_is_utf8 +/; -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; +use DBI; +use DBD::Oracle qw(:ora_types SQLCS_NCHAR SQLCS_IMPLICIT ORA_OCI); +use Test::More; -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 ] ; +*BAILOUT = sub { die "@_\n" } + unless defined &BAILOUT; -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 +my @test_sets = ( + [ 'LONG', 0, 0 ], + [ 'LONG RAW', ORA_LONGRAW, 0 ], + [ 'CLOB', ORA_CLOB, 0 ], + [ 'BLOB', ORA_BLOB, 0 ], +); +push @test_sets, [ 'NCLOB', ORA_CLOB, 0 ] + unless ORA_OCI() < 9.0 or $ENV{DBD_ALL_TESTS}; -$| = 1; -my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $table = table(); -my $use_utf8_data; # set per test_set below +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}; +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) +# 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(); +my ( $p1, $p2, $tmp, @tmp ); +my $dbh = db_handle( { PrintError => 0 } ) + or plan skip_all => 'Unable to connect to Oracle'; - $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; - my $dsn = oracle_test_dsn(); - my $dbh = DBI->connect($dsn, $dbuser, '',{ - PrintError => 0, - }); +my $tests_per_set = 97; -if ($dbh) { - plan tests => $tests; -} else { - plan skip_all => "Unable to connect to Oracle"; -} +my $ora_server_version = $dbh->func('ora_server_version'); -my $ora_server_version = $dbh->func("ora_server_version"); -note("ora_server_version: @$ora_server_version\n"); -show_db_charsets($dbh) if $dbh; +show_db_charsets($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; + my ( $type_name, $type_num, $test_no_type ) = @$_; + subtest $type_name => sub { + plan tests => $tests_per_set; + $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. +done_testing(); +### END OF TESTS, ONLY FUNCTIONS BELOW ### END { - drop_table( $dbh ) if not $ENV{DBD_SKIP_TABLE_DROP}; - $dbh->disconnect if $dbh; + eval{ drop_table($dbh) } } - -sub use_utf8_data -{ +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; + + return 0 + unless ( $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}++; } -sub run_long_tests -{ - my ($dbh, $type_name, $type_num) = @_; +sub run_long_tests { + my ( $dbh, $type_name, $type_num ) = @_; my ($sth); my $append_len; - SKIP: - { #it all + 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[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); + $long_data[0] .= $utf_z foreach ( 1 .. 2047 ); } - if ($type_name eq 'BLOB') { + if ( $type_name eq 'BLOB' ) { + # convert string from utf-8 to byte encoding XXX - $long_data[0] = pack "C*", (unpack "C*", $long_data[0]); + $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? + 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; + $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]); + my @len_data = map { length($_) } @long_data; # 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; + warn "long_data[0] is > 64KB: $len_data[0]\n" + if $len_data[0] > 65535; + warn "long_data[1] is < 64KB: $len_data[1]\n" + if $len_data[1] < 65535; + warn +"long_data[2] is not smaller than $long_data[1] ($len_data[2] > $len_data[1])\n" + if $len_data[2] >= $len_data[1]; my $tdata = { - cols => long_test_cols( $type_name ), + 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 ) ); - 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"); + # typically OCI 8 client talking to Oracle 7 database 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 $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; + # The explicit SQLCS_IMPLICIT is needed in some odd cases + $bind_attr->{ora_csform} = + ( $type_name =~ /^NCLOB/ ) ? SQLCS_NCHAR : SQLCS_IMPLICIT; - 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 + $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"); + 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"); + $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); + $out_len *= 2 if ( $type_name =~ /RAW/i ); $sqlstr = "select * from $table order by idx"; - ok($sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" ); + ok( $sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" ); $sth->trace(0); - ok($sth->execute, "execute: $sqlstr" ); - ok($tmp = $sth->fetchall_arrayref, "fetch_arrayref for $sqlstr" ); + 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:/) { + SKIP: { + if ( $DBI::err && $DBI::errstr =~ m/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 ; + 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 + cmp_ok( @$tmp, '==', 4, 'four rows' ); + + 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" ); + } + } + 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}; + note( +" --- fetch $type_name data back again -- truncated - LongTruncOk == 0\n" + ); + + $dbh->{LongReadLen} = + $len_data[1] - 10; # so $long_data[0] fits but long_data[1] doesn't + $dbh->{LongReadLen} /= 2 if $type_name =~ m/RAW/i; + $dbh->{LongTruncOk} = 0; - note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n"); + + 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]) ); + + 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).")"); + ok( + !defined $sth->fetchrow_arrayref, + 'truncation error not triggered ' + . "(LongReadLen $dbh->{LongReadLen}, data " + . length( $tmp->[1] || 0 ) . ")" + ); $tmp = $sth->err || 0; - ok( ($tmp == 1406 || $tmp == 24345) ,"tmp==1406 || tmp==24345 tmp actually=$tmp" ); + ok( + ( $tmp == 1406 || $tmp == 24345 ), + "tmp==1406 || tmp==24345 tmp actually=$tmp" + ); } - $sth->finish; + $sth->finish; - note(" --- fetch $type_name data back again -- complete - LongTruncOk == 0\n"); - $dbh->{LongReadLen} = $len_data1 +1000; + note( +" --- fetch $type_name data back again -- complete - LongTruncOk == 0\n" + ); + $dbh->{LongReadLen} = $len_data[1] + 1000; $dbh->{LongTruncOk} = 0; - note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n"); + 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; - + ok( $sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" ); + ok( $sth->execute, "execute $sqlstr" ); + + for my $i ( 0 .. 2 ) { + my $result = $sth->fetchrow_arrayref; + ok $result, "fetchrow_arrayref $sqlstr"; + is $result->[1] => $long_data[$i], + cdif( $result->[1], $long_data[$i], + "Len " . length( $result->[1] ) ); + } + $sth->finish; - SKIP: { - skip( "blob_read tests for LONGs - not currently supported", 15 ) - if ($type_name =~ /LONG/i) ; + 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; + $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 - + 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 ); + SKIP: { + skip( "ora_auto_lob tests for $type_name" . "s - not supported", + 49 ) + unless ( $type_name =~ /LOB/i ); - note(" --- testing ora_auto_lob to access $type_name LobLocator\n\n"); - my $data_fmt = "%03d foo!"; + 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" ); + my $ll_sth = $dbh->prepare( $sqlstr, { ora_auto_lob => 0 } ) + ; # 0: get lob locator instead of lob contents - ok($ll_sth->execute ,"execute $sqlstr" ); - while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) { - note("$idx: ".DBI::neat($lob_locator)."\n"); + 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' ) ; - + 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" ); + 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"); + 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); + 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 + 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' ); - } #skip it all (tests_per_set) + #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 ); - $sth->finish if $sth; - drop_table( $dbh ) + } #skip for LONG types -} # end of run_long_tests + } #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 + return 0; # FIXME 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"); + $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 ); +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() ) - { + while ( my ( $d, $i ) = $tsth->fetchrow_array() ) { last if not defined $d; diag("$i: $d\n"); } } -sub print_lengths -{ +sub print_lengths { my ($dbh) = @_; - my $tsql = "select length(lng),idx from $table order by idx" ; + my $tsql = "select length(lng),idx from $table order by idx"; diag("-- prepare: $tsql\n"); - my $tsth = $dbh->prepare( $tsql ); + my $tsth = $dbh->prepare($tsql); $tsth->execute(); - while ( my ( $l,$i ) = $tsth->fetchrow_array() ) - { + 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) = @_; + my ( $sth, $field_idx, $blob_ref, $lump ) = @_; - $lump ||= 4096; # use benchmarks to get best value for you + $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"; + 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; + $$blob_ref = join q||, @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 join q(), @str unless wantarray; return @str; } sub cdif { - my ($s1, $s2, $msg) = @_; - $msg = ($msg) ? ", $msg" : ""; - my ($l1, $l2) = (length($s1), length($s2)); + my ( $s1, $s2, $msg ) = @_; + $msg = ($msg) ? ", $msg" : q(); + 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; + 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; + 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; + $i, $c1, $c2; } return "(cdif error $l1/$l2/$i)"; } - __END__ diff --git a/t/31lob.t b/t/31lob.t index fcbe30f9..2e513edc 100644 --- a/t/31lob.t +++ b/t/31lob.t @@ -1,102 +1,81 @@ -#!/usr/bin/perl +#!perl use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn table drop_table db_handle force_drop_table /; + use Test::More; use DBD::Oracle qw(:ora_types ORA_OCI ); use DBI; -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; - -plan skip_all => "see RT#69350" - if ORA_OCI() =~ /^11\.2\./; - -my $dbh; -$| = 1; -SKIP: { - - my $dsn = oracle_test_dsn(); - my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; - - $dbh = DBI->connect($dsn, $dbuser, '',{ - PrintError => 0, - }); - if ($dbh) { - plan tests => 12; - } else { - plan skip_all => "Unable to connect to Oracle"; - } +my $dbh = db_handle( { PrintError => 0 } ); + +plan $dbh + ? ( tests => 12 ) + : ( skip_all => 'Unable to connect to Oracle' ); + +my $table = table(); +force_drop_table($dbh); + +$dbh->do("CREATE TABLE $table ( id INTEGER NOT NULL, data BLOB )"); - my $table = table(); - drop_table($dbh); - - $dbh->do(qq{ - CREATE TABLE $table ( - id INTEGER NOT NULL, - data BLOB - ) - }); - -my ($stmt, $sth, $id, $loc); +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 = $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"); +is( ref $loc, 'OCILobLocatorPtr', 'returned valid locator' ); +$sth->finish; ## 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' }); +$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'; + 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}); +( $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"); +is( ref $loc, 'OCILobLocatorPtr', 'returned valid locator' ); sub temp_lob_count { - my $dbh = shift; - my $stmt = " - 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') "; - my ($count) = $dbh->selectrow_array($stmt); - return $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'); - if ($dbh->err){ - return if ($dbh->err == 942); - } - return 1; + $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 @@ -113,26 +92,34 @@ sub have_v_session { $sth->execute; ($loc) = $sth->fetchrow; - is( ref $loc, "OCILobLocatorPtr", "returned valid locator" ); + is( ref $loc, 'OCILobLocatorPtr', 'returned valid locator' ); - is( $dbh->ora_lob_is_init($loc), 1, "returned initialized 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 ); - is( $dbh->ora_lob_length($loc), length($large_value), "returned length" ); + 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" ); + $large_value, 'returned written value' ); ## PL/SQL TESTS SKIP: { - ## test calling PL/SQL with LOB placeholder + ## test calling PL/SQL with LOB placeholder my $plsql_testcount = 4; - $stmt = "BEGIN ? := DBMS_LOB.GETLENGTH( ? ); END;"; - $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } ); + 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; @@ -143,20 +130,32 @@ sub have_v_session { # 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 + skip q|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 + '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 + skip 'Your Oracle PL/SQL is not properly installed', + $plsql_testcount if $dbh->err == 6553 || $dbh->err == 600; } - is( $len, length($large_value), "returned length via PL/SQL" ); + TODO: { + local $TODO = + 'problem reported w/ lobs and Oracle 11.2.*, see RT#69350' + if ORA_OCI() =~ m/^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; - - $stmt = " + 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) @@ -172,7 +171,7 @@ sub have_v_session { LOOP buffer := DBMS_LOB.SUBSTR(p_in, 1024, pos); - DBMS_LOB.WRITEAPPEND(p_out, UTL_RAW.LENGTH(buffer), + 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); @@ -182,35 +181,44 @@ sub have_v_session { END; BEGIN lower_lob(:in, :out, :inout); - END; "; + END; +END_SQL - my $out; - my $inout = lc $large_value; + $sth->bind_param( ':in', $large_value, { ora_type => ORA_BLOB } ); - local $dbh->{LongReadLen} = length($large_value) * 2; + $sth->bind_param_inout( ':out', \$out, 100, + { ora_type => ORA_BLOB } ); + $sth->bind_param_inout( ':inout', \$inout, 100, + { ora_type => ORA_BLOB } ); + $sth->execute; - $sth = $dbh->prepare( $stmt, { ora_auto_lob => 1 } ); - $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() =~ m/^11\.2\./; - skip "Your Oracle PL/SQL installation does not implement temporary LOBS", 3 + 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"); + 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"); + 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; +undef $sth; -} +END { eval { drop_table($dbh); } } 1; diff --git a/t/31lob_extended.t b/t/31lob_extended.t index 3c084065..578a68da 100644 --- a/t/31lob_extended.t +++ b/t/31lob_extended.t @@ -1,4 +1,4 @@ -#!perl -w +#!perl ## ---------------------------------------------------------------------------- ## 31lob_extended.t @@ -9,35 +9,40 @@ ## Basically this is testing the use of LOBs when returned via stored procedures with bind_param_inout ## ---------------------------------------------------------------------------- +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn drop_table create_table db_handle /; + 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, - }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests => 31; + plan tests => 30; $dbh->{LongReadLen} = 7000; -} else { - plan skip_all => "Unable to connect to Oracle"; +} +else { + plan skip_all => 'Unable to connect to Oracle'; diag('Test reported bugs'); } -my ($table, $data0, $data1) = setup_test($dbh); +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 @@ -45,29 +50,26 @@ my ($table, $data0, $data1) = setup_test($dbh); # we get a segfault. This was due to prefetching more than one row. # { - my $testname = "ora_auto_lobs prefetch"; + my $testname = 'ora_auto_lobs prefetch'; - my ($sth1, $ev); + my ( $sth1, $ev ); - eval {$sth1 = $dbh->prepare( - q/begin p_DBD_Oracle_drop_me(?); end;/, {ora_auto_lob => 0}); - }; - ok(!$@, "$testname - prepare call proc"); + 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"); + 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); + test_lob( $dbh, $lobl, $testname, 6000, $data0 ); ($lobl) = $sth2->fetchrow; - test_lob($dbh, $lobl, $testname, 6000, $data1); + test_lob( $dbh, $lobl, $testname, 6000, $data1 ); - - ok($sth2->finish, "$testname - finished returned sth"); - ok($sth1->finish, "$testname - finished sth"); + ok( $sth2->finish, "$testname - finished returned sth" ); + ok( $sth1->finish, "$testname - finished sth" ); } # @@ -76,98 +78,78 @@ my ($table, $data0, $data1) = setup_test($dbh); # were not automatically fetched. # { - my $testname = "ora_auto_lobs not fetching"; + my $testname = 'ora_auto_lobs not fetching'; - my ($sth1, $ev, $lob); + my ( $sth1, $ev, $lob ); - eval {$sth1 = $dbh->prepare( - # ora_auto_lobs is supposed to default to set - q/begin p_DBD_Oracle_drop_me(?); end;/); - }; - ok(!$@, "$testname prepare call proc"); + # 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"); + 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"); + 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( $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"); + ok( $sth2->finish, "$testname - finished returned sth" ); + ok( $sth1->finish, "$testname - finished sth" ); } -sub test_lob -{ - my ($h, $lobl, $testname, $size, $data) = @_; +sub test_lob { + my ( $h, $lobl, $testname, $size, $data ) = @_; - ok($lobl, "$testname - lob locator retrieved"); - is(ref($lobl), 'OCILobLocatorPtr', "$testname - is a lob locator"); + 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'; + skip 'did not receive a lob locator', 4 + unless ref($lobl) eq 'OCILobLocatorPtr'; - my ($lob_length, $lob, $ev); + my ( $lob_length, $lob, $ev ); - eval {$lob_length = $h->ora_lob_length($lobl);}; + 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);}; + 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"); + ok( !$ev, "$testname - read lob" ); - is($lob, $data, "$testname - lob returned matches lob inserted"); + is( $lob, $data, "$testname - lob returned matches lob inserted" ); } } -sub setup_test -{ +sub setup_test { my ($h) = @_; - my ($table, $sth, $ev); + my ( $table, $sth, $ev ); - eval {$table = create_table($h, {cols => [['x', 'clob']]}, 1)}; + eval { $table = create_table( $h, { cols => [ [ 'x', 'clob' ] ] }, 1 ) }; BAIL_OUT("test table not created- $@") if $@; - ok(!$ev, "created test table"); + ok( !$ev, 'created test table' ); - eval { - $sth = $h->prepare(qq/insert into $table (idx, x) values(?,?)/); - }; + 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); + $sth->execute( 1, $data0 ); + $sth->execute( 2, $data1 ); }; BAIL_OUT("Failed to insert test data into $table - $@") if $@; - ok(!$ev, "created test data"); - - my $createproc = << "EOT"; -CREATE OR REPLACE PROCEDURE p_DBD_Oracle_drop_me(pc OUT SYS_REFCURSOR) AS -l_cursor SYS_REFCURSOR; -BEGIN -OPEN l_cursor FOR - SELECT x from $table; -pc := l_cursor; -END; -EOT - - eval {$h->do($createproc);}; - BAIL_OUT("Failed to create test procedure - $@") if $@; - ok(!$ev, "created test procedure"); + ok( !$ev, 'created test data' ); - return ($table, $data0, $data1); + return ( $table, $data0, $data1 ); } END { @@ -176,16 +158,10 @@ END { local $dbh->{PrintError} = 0; local $dbh->{RaiseError} = 1; - eval {$dbh->do(q/drop procedure p_DBD_Oracle_drop_me/);}; - if ($@) { - diag("procedure p_DBD_Oracle_drop_me possibly not dropped" . - "- check - $@\n") if $dbh->err ne '4043'; - } - - eval {drop_table($dbh);}; + eval { drop_table($dbh); }; if ($@) { diag("table $table possibly not dropped - check - $@\n") - if $dbh->err ne '942'; + if $dbh->err ne '942'; } } diff --git a/t/32xmltype.t b/t/32xmltype.t index 98544b97..5ccf9e17 100644 --- a/t/32xmltype.t +++ b/t/32xmltype.t @@ -1,83 +1,88 @@ -#!/usr/bin/perl +#!perl use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn table drop_table db_handle force_drop_table /; + 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. +## 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 })}; +my $dbh = eval{ db_handle( { + 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"); - +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=""; -my $large_xml=""; -my $i=0; - -for ($i=0;$i<=10;$i++){ - $small_xml=$small_xml."the book ".$i." title"; +eval { force_drop_table($dbh, $table) }; + +$dbh->do( + qq{ CREATE TABLE $table ( id INTEGER NOT NULL, XML_DATA XMLTYPE ) } +); + +my ( $stmt, $sth ); +my $small_xml = ''; +my $large_xml = ''; +my $i = 0; + +for ( $i = 0 ; $i <= 10 ; $i++ ) { + $small_xml = + $small_xml + . "the book " + . $i + . " title"; } -$small_xml=$small_xml.""; +$small_xml = $small_xml . ''; -for ($i=0;$i<=10000;$i++){ - $large_xml=$large_xml."the book ".$i." title"; +for ( $i = 0 ; $i <= 10000 ; $i++ ) { + $large_xml = + $large_xml + . "the book " + . $i + . " title"; } -$large_xml=$large_xml.""; +$large_xml = $large_xml . ''; -$stmt = "INSERT INTO ".$table." VALUES (1,?)"; +$stmt = "INSERT INTO $table VALUES (1,?)"; -$sth =$dbh-> prepare($stmt); - -$sth-> bind_param(1, $small_xml, { ora_type => ORA_XMLTYPE }); +$sth = $dbh->prepare($stmt); -ok ($sth->execute(), '... execute for small XML return true'); +$sth->bind_param( 1, $small_xml, { ora_type => ORA_XMLTYPE } ); -$sth-> bind_param(1, $large_xml, { ora_type => ORA_XMLTYPE }); +ok( $sth->execute(), '... execute for small XML return true' ); -ok ($sth->execute(), '... execute for large 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; - diff --git a/t/34pres_lobs.t b/t/34pres_lobs.t index d0135e11..e56a3e3c 100644 --- a/t/34pres_lobs.t +++ b/t/34pres_lobs.t @@ -1,14 +1,17 @@ -#!perl -w +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn table drop_table db_handle force_drop_table /; use Test::More; use DBI; -use Oraperl; use Config; use DBD::Oracle qw(:ora_types); - - ## ---------------------------------------------------------------------------- ## 33pres_lobs.t ## By John Scoles, The Pythian Group @@ -18,108 +21,114 @@ use DBD::Oracle qw(:ora_types); ## 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})}; +my $dbh = eval{ db_handle( { + RaiseError => 1, + AutoCommit => 1, + PrintError => 0, + LongReadLen => 10000000 + })}; if ($dbh) { - plan tests => 29; -} else { - plan skip_all => "Unable to connect to Oracle"; + plan skip_all => 'Data Interface for Persistent LOBs new in Oracle 9' + if $dbh->func('ora_server_version')->[0] < 9; + plan tests => 28; } -# 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'); - -ok($dbh->commit(), 'commit'); - - -$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); +else { + plan skip_all => 'Unable to connect to Oracle'; } +# check that our db handle is good +my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar -$dbh->disconnect; +SKIP: { -1; + skip "OCI version less than 9.2\n Persistent LOBs Tests skiped.", 29 + unless $ora_oci >= 9.2; + + my $table = table(); + + eval { force_drop_table( $dbh, $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 ); # ID: 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(), + 'fetchrow 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' ); + cmp_ok( $log, 'eq', $in_clob, 'clob1 = in_clob' ); + cmp_ok( $log2, 'eq', $in_clob, 'clob2 = in_clob' ); + cmp_ok( $log3, 'eq', $in_blob, 'clob1 = in_clob' ); + cmp_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' ); + + cmp_ok( $log, 'eq', $in_clob, 'clob1 = in_clob' ); + cmp_ok( $log2, 'eq', $in_clob, 'clob2 = in_clob' ); + cmp_ok( $log3, 'eq', $in_blob, 'clob1 = in_clob' ); + cmp_ok( $log4, 'eq', $in_blob, 'clob2 = in_clob' ); + + #no need to look at the data is should be ok + + $sth->finish(); + drop_table($dbh); + +} # SKIP diff --git a/t/36lob_leak.t b/t/36lob_leak.t index 119662a5..55b52219 100644 --- a/t/36lob_leak.t +++ b/t/36lob_leak.t @@ -1,167 +1,169 @@ -#!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"); - } - } - } -} +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +##---------------------------------------------------------------------------- +## 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); + +$| = 1; + +my $dbh = db_handle( { 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' . ( $ENV{DBD_ORACLE_SEQ} || '' ); + + 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 and not $ENV{DBD_SKIP_TABLE_DROP}) { + local $dbh->{PrintError} = 0; + local $dbh->{RaiseError} = 1; + if ($function) { + eval { $dbh->do(qq/drop function $function/); }; + if ($@) { + diag( "function '$function' possibly not dropped" + . "- check - $@\n" ) + if $dbh->err ne '4043'; + } + else { + note("function '$function' dropped"); + } + } + } +} diff --git a/t/38taf.t b/t/38taf.t index 3cf8f3c1..3fd6e898 100644 --- a/t/38taf.t +++ b/t/38taf.t @@ -1,48 +1,44 @@ -#!perl -w - -use DBI; -use DBD::Oracle(qw(:ora_fail_over)); -use strict; -use Data::Dumper; - -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 {$dbh = DBI->connect($dsn, $dbuser, '',)}; -if ($dbh) { - if ($dbh->ora_can_taf()){ - plan tests => 1; - } - else { - plan tests =>1; - } -} else { - plan skip_all => "Unable to connect to Oracle"; -} - -$dbh->disconnect; - -if (!$dbh->ora_can_taf()){ - - eval {$dbh = DBI->connect($dsn, $dbuser, '',{ora_taf=>1,taf_sleep=>15,ora_taf_function=>'taf'})}; - ok($@ =~ /You are attempting to enable TAF/, "'$@' expected! "); - - -} -else { - ok($dbh = DBI->connect($dsn, $dbuser, '',{ora_taf=>1,taf_sleep=>15,ora_taf_function=>'taf'}),"Well this is all I can test!"); - -} - -$dbh->disconnect; -#not much I can do with taf as I cannot really shut down somones server pephaps later - -1; +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +use DBI; +use DBD::Oracle(qw(:ora_fail_over)); + +#use Devel::Peek qw(SvREFCNT Dump); + +use Test::More; +$| = 1; + +# create a database handle +my $dbh = db_handle() + or plan skip_all => 'Unable to connect to Oracle'; + +$dbh->disconnect; + +if ( !$dbh->ora_can_taf ) { + + $dbh = db_handle( { PrintError => 0, RaiseError => 0, ora_taf_function => 'taf' } ); + my $ev = $dbh->errstr; + like( $ev, qr/You are attempting to enable TAF/, "'$ev' (expected)" ); +} +else { + ok $dbh = db_handle( { 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)); +} + +done_testing(); diff --git a/t/39attr.t b/t/39attr.t new file mode 100644 index 00000000..973f5769 --- /dev/null +++ b/t/39attr.t @@ -0,0 +1,87 @@ +#!perl +# +# 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 strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +use DBI; +use DBD::Oracle(qw(ORA_OCI)); + +#use Devel::Peek qw(SvREFCNT Dump); + +use Test::More; + +$| = 1; + +#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 = db_handle() + or plan skip_all => 'Unable to connect to Oracle'; + + diag( "\n" . 'Oracle SERVER version: ' + . join( '.', @{ $dbh->func('ora_server_version') } ) ); + diag( 'Oracle 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" ); + } + } + } + + for 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(); diff --git a/t/40ph_type.t b/t/40ph_type.t index 38239b82..487b2355 100644 --- a/t/40ph_type.t +++ b/t/40ph_type.t @@ -1,131 +1,167 @@ -#!perl -w -use Test::More; +#!perl use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle drop_table force_drop_table table /; + +use Test::More; + use DBI qw(neat); use DBD::Oracle qw(ORA_OCI); use vars qw($tests); -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; - -$| = 1; +$| = 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 }, + + # 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; +$tests = 1; +$_->{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', -}); +my $dbh = db_handle( + { + AutoCommit => 0, + PrintError => 0, + FetchHashKeyName => 'NAME_lc', + } +); if ($dbh) { plan tests => $tests; -} else { - plan skip_all => - "Unable to connect to Oracle"; +} +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; + $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}||''); +my ( $sth, $tmp ); +my $table = table(); # drop table but don't warn if not there -eval { - local $dbh->{PrintError} = 0; - $dbh->do("DROP TABLE $table"); -}; +eval { force_drop_table($dbh, $table) }; -ok($dbh->do("CREATE TABLE $table (name VARCHAR2(2), vc VARCHAR2(20), c CHAR(20))"), 'create test 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"; +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}; - } + 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'); +$dbh && $dbh->disconnect; + +END { eval { drop_table($dbh,$table); } } __END__ diff --git a/t/50cursor.t b/t/50cursor.t index fa40a060..93e05dc8 100644 --- a/t/50cursor.t +++ b/t/50cursor.t @@ -1,89 +1,120 @@ -#!perl -w +#!perl # From: Jeffrey Horn + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + 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 ( $limit, $tests ); -my $dsn = oracle_test_dsn(); -my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; -my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); +my $dbh = db_handle( { 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'; + 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"); + 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; + $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"; +} +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' ); +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("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'); +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'); + 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' ); } -$dbh->disconnect; - -exit 0; - +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' ); diff --git a/t/51scroll.t b/t/51scroll.t index 1507cd81..eba4e2b1 100644 --- a/t/51scroll.t +++ b/t/51scroll.t @@ -1,13 +1,15 @@ -#!/usr/bin/perl +#!perl use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn table drop_table db_handle force_drop_table /; + 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 @@ -17,107 +19,123 @@ require 'nchar_test_lib.pl'; ## ---------------------------------------------------------------------------- # 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 })}; +my $dbh = eval { db_handle( { + RaiseError => 1, + AutoCommit => 1, + PrintError => 0 + })}; if ($dbh) { - plan tests => 32; -} else { - plan skip_all => "Unable to connect to Oracle"; + plan skip_all => 'Scrollable cursors new in Oracle 9' + if $dbh->func('ora_server_version')->[0] < 9; + plan tests => 37; } -ok ($dbh->{RowCacheSize} = 10); +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"); +isa_ok( $dbh, 'DBI::db' ); my $table = table(); +eval { force_drop_table( $dbh, $table ) }; +$dbh->do(qq{ CREATE TABLE $table ( id INTEGER ) }); -$dbh->do(qq{ - CREATE TABLE $table ( - id INTEGER ) - }); - +my ( $sql, $sth, $value ); +my $i = 0; +$sql = "INSERT INTO $table VALUES (?)"; -my ($sql, $sth,$value); -my $i=0; -$sql = "INSERT INTO ".$table." VALUES (?)"; +$sth = $dbh->prepare($sql); -$sth =$dbh-> prepare($sql); +$sth->execute($_) foreach ( 1 .. 10 ); -for ($i=1;$i<=10;$i++){ - $sth-> bind_param(1, $i); - $sth->execute(); -} - -$sql="select * from ".$table; -ok($sth=$dbh->prepare($sql,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>200})); -ok ($sth->execute()); +$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 -for($i=1;$i<=10;$i++){ - $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); - cmp_ok($value->[0], '==', $i, '... we should get the next record'); +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' ); - -$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'); +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'); +$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'); +$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); +$value = $sth->ora_fetch_scroll( OCI_FETCH_RELATIVE, -3 ); -cmp_ok($value->[0], '==', 4, '... we should get the 4th record'); +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); +$value = $sth->ora_fetch_scroll( OCI_FETCH_ABSOLUTE, 9 ); -cmp_ok($value->[0], '==', 9, '... we should get the 9th record'); +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); +$value = $sth->ora_fetch_scroll( OCI_FETCH_LAST, 0 ); -cmp_ok($value->[0], '==', 10, '... we should get the 10th record'); +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'); +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'); +$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'); +cmp_ok( $sth->ora_scroll_position(), + '==', 1, '... we should get the 1 for the ora_scroll_position' ); -$sth->finish(); -drop_table($dbh); +# 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 ); +cmp_ok( $value->[0], '==', 3, '... we should get the 3rd record rt76695' ); +($value) = $sth->fetchrow; +cmp_ok( $value, '==', 4, '... we should get the 4th record rt 76695' ); -$dbh->disconnect; - -1; +# rt 76410 - fetch after fetch absolute always returns the same row +$value = $sth->ora_fetch_scroll( OCI_FETCH_ABSOLUTE, 2 ); +cmp_ok( $value->[0], '==', 2, '... we should get the 2nd row rt76410_2' ); +($value) = $sth->fetchrow; +cmp_ok( $value, '==', 3, '... we should get the 3rd row rt76410_2' ); +$sth->finish(); +drop_table($dbh, $table); diff --git a/t/55nested.t b/t/55nested.t index a311d80c..276586f8 100644 --- a/t/55nested.t +++ b/t/55nested.t @@ -1,23 +1,25 @@ -#!perl -w +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + 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 }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests=> 29; -} else { - plan skip_all =>"Unable to connect to Oracle"; + plan tests => 29; +} +else { + plan skip_all => 'Unable to connect to Oracle'; } # ref cursors may be slow due to oracle bug 3735785 @@ -26,56 +28,60 @@ if ($dbh) { # 10.1.0.4 (Server Patch Set) # 10.2.0.1 (Base Release) -my $outer = $dbh->prepare(q{ +{ + +my $outer = $dbh->prepare( + q{ SELECT object_name, CURSOR(SELECT object_name FROM dual) - FROM all_objects WHERE rownum <= 5}); -ok($outer, 'prepare select'); + 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'); +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'); +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, +$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'); + 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'); - +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 @@ -84,15 +90,15 @@ is( $row1[0], $row2_1[0], 'rows equal'); $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; + 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."; + note "Fetched $row_count rows ($caption): $elapsed secs."; - return $elapsed; + return $elapsed; } ################################################## @@ -101,11 +107,11 @@ sub timed_fetch { my $sql1 = q{ SELECT object_name FROM (SELECT object_name FROM all_objects WHERE ROWNUM<=70), - (SELECT 1 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'); +my $dur_std = timed_fetch( $outer, 'select' ); ################################################## # nested cursor @@ -113,11 +119,10 @@ my $dur_std = timed_fetch($outer,'select'); $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'); +my $dur_ref = timed_fetch( $ref_csr, 'nested cursor' ); ######################################################################### # Fetch speed test: END ######################################################################### -exit 0; - +} diff --git a/t/56embbeded.t b/t/56embbeded.t index d495b663..970eef25 100644 --- a/t/56embbeded.t +++ b/t/56embbeded.t @@ -1,81 +1,80 @@ -#!perl -w +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle force_drop_table drop_table table /; 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. +## Just a few checks to see if I can select embedded objects 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 })}; +my $dbh = eval{ db_handle( { RaiseError => 1, AutoCommit => 1, PrintError => 0 } )}; + if ($dbh) { plan tests => 4; -} else { - plan skip_all => "Unable to connect to Oracle"; } - +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); -} +isa_ok( $dbh, 'DBI::db' ); + +# 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 }; + +SKIP: { + + skip q{don't have permission to create type} => 3 + unless grep { $_ eq 'CREATE TYPE' } @privileges; + skip q{don't have permission to create table} => 3 + unless grep { $_ eq 'CREATE TABLE' } @privileges; -cmp_ok(scalar($problems), '==',5, '... we should have 5 items'); + my $table = table('table_embed'); + my $type = $table . 'a_type'; + #do not warn if already there + eval { + local $dbh->{PrintError} = 0; + force_drop_table( $dbh, $table ); + $dbh->do(qq{DROP TYPE $type }); + }; + $dbh->do(qq{CREATE OR REPLACE TYPE $type AS varray(10) OF varchar(30) }); -$dbh->do("drop table $table"); + $dbh->do(qq{ CREATE TABLE $table ( aa_type $type) }); -$dbh->do("drop type $type"); + $dbh->do("insert into $table values ($type('1','2','3','4','5'))"); -$dbh->disconnect; + # simple execute + my $sth; + ok( $sth = $dbh->prepare("select * from $table"), + '... Prepare should return true' ); + my $problems; + ok( $sth->execute(), '... Select should return true' ); -1; + while ( my ($a) = $sth->fetchrow() ) { + $problems = scalar(@$a); + } + cmp_ok( scalar($problems), '==', 5, '... we should have 5 items' ); + + drop_table($dbh, $table); + + $dbh->do("drop type $type") unless $ENV{DBD_SKIP_TABLE_DROP}; + +} diff --git a/t/58object.t b/t/58object.t index 28be915e..0a05116b 100644 --- a/t/58object.t +++ b/t/58object.t @@ -1,262 +1,363 @@ -#!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 }; - - -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 } ); - -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')) }); - -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 = $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'); - -my @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'); - -my @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"); - -@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); - -# 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; -} - +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +use DBI; +use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR); + +use Test::More; + +$| = 1; + +if($^O eq 'cygwin') +{ + DBD::Oracle::ora_cygwin_set_env('NLS_DATE_FORMAT', 'YYYY-MM-DD"T"HH24:MI:SS'); +} +else +{ + $ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD"T"HH24:MI:SS'; +} + +# create a database handle +my $dbh = eval{ db_handle( { + RaiseError => 1, + AutoCommit => 1, + PrintError => 0, + ora_objects => 1 + })}; + +plan skip_all => 'Unable to connect to Oracle' unless $dbh; + +plan tests => 65; + +my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; +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( + q|select sys_context('userenv', 'current_schema') from dual|), + 'Fetch current schema name' +); + +my $obj_prefix = 'dbd_test_' . ( $ENV{DBD_ORACLE_SEQ} || '' ); +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 sql_do_ok { + my ( $dbh, $sql, $title ) = @_; + $title = $sql unless defined $title; + ok( $dbh->do($sql), $title ) or diag $dbh->errstr; +} + +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 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 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 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', + q|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 properties 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 unless $ENV{DBD_SKIP_TABLE_DROP}; diff --git a/t/60reauth.t b/t/60reauth.t index b62fa43a..d8c4b12c 100644 --- a/t/60reauth.t +++ b/t/60reauth.t @@ -1,37 +1,41 @@ -#!perl -w -use Test::More; +#!perl + +use strict; +use warnings; +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn /; + +use Test::More; use DBI; -unshift @INC ,'t'; -require 'nchar_test_lib.pl'; $| = 1; -my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; +my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbuser_2 = $ENV{ORACLE_USERID_2} || ''; -if ($dbuser_2 eq '') { +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) { +( 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, ''); +my $dbh = DBI->connect( $dsn, $dbuser, $ENV{ORACLE_PASSWD} || '' ); if ($dbh) { plan tests => 3; -} else { +} +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; +is( ( $dbh->selectrow_array('SELECT USER FROM DUAL') )[0], $uid1, 'uid1' ); +ok( $dbh->func( $dbuser_2, $ENV{ORACLE_PASSWD} || '', 'reauthenticate' ), 'reauthenticate' ); +is( ( $dbh->selectrow_array('SELECT USER FROM DUAL') )[0], $uid2, 'uid2' ); diff --git a/t/70meta.t b/t/70meta.t index d8e29938..5bc4977b 100644 --- a/t/70meta.t +++ b/t/70meta.t @@ -1,59 +1,96 @@ -#!perl -w -use Test::More; +#!perl use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle drop_table table force_drop_table /; + +use Test::More; 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 }); +my $dbh = db_handle( { PrintError => 0 } ); if ($dbh) { - plan tests=>13; -} else { - plan skip_all => "Unable to connect to Oracle"; + plan tests => 20; + $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 )); +cmp_ok( scalar @types, '>=', 8, 'more than 8 types' ); +note( Dumper(@types) ); note("tables():\n"); my @tables = $dbh->tables; -note(@tables." tables\n"); -ok(scalar @tables, 'tables'); +note( @tables . " tables\n" ); +ok( scalar @tables, 'some tables exist' ); my @table_info_params = ( - [ 'schema list', undef, '%', undef, undef ], - [ 'type list', undef, undef, undef, '%' ], - [ 'table list', undef, undef, undef, undef ], + [ 'schema list', undef, '%', undef, undef ], + [ 'type list', undef, undef, undef, '%' ], + [ 'table list', undef, undef, undef, undef ], ); -foreach my $table_info_params (@table_info_params) { + +for 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"); + 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'); + 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'); + ok( $data, 'table_info fetch' ); + ok( scalar @$data, 'table_info data returned' ); my $dur = time - $start; - note("$name: ".@$data." rows, $dur seconds\n"); + note( "$name: " . @$data . " rows, $dur seconds\n" ); } my $sql_dbms_version = $dbh->get_info(18); -ok($sql_dbms_version, 'dbms_version'); +ok( $sql_dbms_version, 'dbms_version' ); note "sql_dbms_version=$sql_dbms_version"; -like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched'); +like( $sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'version patterned matched' ); + +# test long DEFAULT from column_info +SKIP: { + my $table = table(); + + eval { force_drop_table( $dbh, $table ) }; # ok if its fails -$dbh->disconnect; + 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))))" + ); + }; -exit 0; + die "Could not create test table $table\n" unless $created; + cmp_ok( $dbh->{LongReadLen}, '==', 80, 'LongReadLen is at default' ); + + ok( ( my $sth = $dbh->column_info( undef, '%', uc($table), '%' ) ), + 'column_info sth' ); + + cmp_ok( $dbh->{LongReadLen}, '==', 80, 'LongReadLen still at default' ); + + ok( ( my $info = eval { $sth->fetchrow_hashref } ), + 'sth->fetchrow_hashref lived' ) + or diag $@; + + cmp_ok( + $info->{COLUMN_DEF}, + 'eq', +q|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 true' ); + + cmp_ok( $dbh->{LongReadLen}, 'eq', 80, 'LongReadLen still at default' ); + + drop_table( $dbh, $table ); +} diff --git a/t/80ora_charset.t b/t/80ora_charset.t index 22daf754..b1654381 100644 --- a/t/80ora_charset.t +++ b/t/80ora_charset.t @@ -1,5 +1,13 @@ -#!perl -w +#!perl + use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ + table insert_test_count set_nls_lang_charset set_nls_nchar oracle_test_dsn + drop_table force_drop_table db_handle show_test_data create_table insert_rows + /; use Encode; use Devel::Peek; @@ -9,125 +17,112 @@ 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)', ], + [ 'ch', 'varchar2(20)', ], + [ 'nch', 'nvarchar2(20)', ], [ 'descr', 'varchar2(50)', ], ], 'dump' => 'DUMP(%s)', - rows => [ - [ - "\xb0", - "\xb0", - 'DEGREE SIGN', - ], - ], + rows => [ [ "\xb0", "\xb0", 'DEGREE SIGN', ], ], }; my $table = table(); -my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8'; +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; + plan skip_all => 'Oracle 9.2 or newer required' unless ORA_OCI >= 9.2; + + if ( $ENV{ORA_CHARSET_FAIL} ) { - 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 ); + 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"; + $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 Oraclee"; + } + else { + plan skip_all => 'Unable to connect to Oracle'; } - show_test_data( $tdata ,0 ); + show_test_data( $tdata, 0 ); - drop_table($dbh); - create_table($dbh, $tdata); - insert_rows( $dbh, $tdata); + force_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); + my ( $ch, $nch ) = $dbh->selectrow_array("select ch, nch from $table"); + check( $ch, $nch, 0 ); - unless ($ENV{ORA_CHARSET_FAIL}) { + 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); -}; + ( $ch, $nch ) = $dbh_utf8->selectrow_array("select ch, nch from $table"); + check( $ch, $nch, 1 ); +} sub check { - my $ch = shift; - my $nch = shift; + my $ch = shift; + my $nch = shift; my $is_utf8 = shift; if ($is_utf8) { - ok(Encode::is_utf8($ch)); - ok(Encode::is_utf8($nch)); + ok( Encode::is_utf8($ch), '$ch should be utf8' ); + ok( Encode::is_utf8($nch), '$nch should be utf8' ); } else { - ok(!Encode::is_utf8($ch)); - ok(!Encode::is_utf8($nch)); + ok( !Encode::is_utf8($ch), '$ch should NOT be utf8' ); + ok( !Encode::is_utf8($nch), '$nch should NOT be utf8' ); } - is($ch, "\xb0", "match char"); - is($nch, "\xb0", "match char"); + is( $ch, "\xb0", 'match char' ); + is( $nch, "\xb0", 'match char' ); } -sub db_connect -{ +sub db_connect { my $utf8 = shift; # Make sure we really are overriding the environment settings. - my ($charset, $ncharset); + my ( $charset, $ncharset ); if ($utf8) { set_nls_lang_charset($eight_bit_charset); set_nls_nchar($eight_bit_charset); - $charset = $utf8_charset; + $charset = $utf8_charset; $ncharset = $utf8_charset; } else { set_nls_lang_charset($utf8_charset); set_nls_nchar($utf8_charset); - $charset = $eight_bit_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, + AutoCommit => 1, + PrintError => 0, FetchHashKeyName => 'NAME_lc', - ora_envhp => 0, # force fresh environment (with current NLS env vars) + ora_envhp => 0, # force fresh environment (with current NLS env vars) }; - $p->{ora_charset} = $charset if $charset; + $p->{ora_charset} = $charset if $charset; $p->{ora_ncharset} = $ncharset if $ncharset; - my $dbh = DBI->connect($dsn, $dbuser, '', $p); + my $dbh = db_handle( $p ); return $dbh; } END { - eval { - local $dbh->{PrintError} = 0; - drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; - }; + drop_table($dbh) } 1; diff --git a/t/90-segv-threads.t b/t/90-segv-threads.t new file mode 100644 index 00000000..b5d47ec8 --- /dev/null +++ b/t/90-segv-threads.t @@ -0,0 +1,511 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::More; +use Config; + +BEGIN { + # Check if Perl is compiled with thread support + if (!$Config{useithreads}) { + plan skip_all => "this $^O perl $] not configured to support iThreads"; + done_testing(); + exit 1 + } +} + +use threads; +use threads::shared 1.51; +use Time::HiRes qw| usleep |; +use Data::Dumper; + +local $Data::Dumper::Indent = 1; +local $Data::Dumper::Terse = 1; + +$ENV{DBD_ORACLE_DUMP} = 0; + +our $VERSION = 0.1; +our $VERBOSE = 0; +our $ORACLE_HOME = $ENV{ORACLE_HOME}; + +my $TEST_START = Time::HiRes::time(); + +sub section +{ + my $msg = shift; + note '+ --------------------------------------------- +'; + note " $msg"; + note '+ --------------------------------------------- +'; + return; +} + +sub abort +{ + my $msg = shift; + printf STDERR "\n"; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "# %s\n", $msg; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "\n"; + note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; + done_testing(); + exit 1; +} + +{ + DB::Queue->do_connect( { PrintError => 0 } ) or plan skip_all => "Unable to connect to oracle\n"; +} + +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + +PERL_NOTICE: +{ + note qx|perl -V| if $VERBOSE; +} + +THREADS_ALONE: +{ + last THREADS_ALONE if 1; + + section 'Threads stress testing'; + +# is threads->tid, 0, 'main-thread identified'; + + for ( 1 .. 2 ) + { + { + my $queue = DB::Queue->new; + + is ref $queue, 'DB::Queue', 'isa DB::Queue'; + + ok ! $queue->isEnabled, '! q->isEnabled'; + ok $queue->enable(5), ' q->enable(X)'; + ok $queue->isEnabled, ' q->isEnabled'; + ok $queue->disable, ' q->disable'; + } + + ok DB::Queue->new->isDisabled, ' q->isDisabled'; + } +} + +sub thread_worker { DB::Queue::_THREAD_WORKER(@_); } + +THREADS_SEGV: +{ +# last THREADS_SEGV if 1; + + section 'Threads + DB->ping stress testing'; + + my $onemore; ## to be the last but used only once + my $do_onemore = 1; + my $do_first = 0; ## 1 = OKAY; 0 = SEGV + + ## <= 2 OKAY; > 2 SEGV!!! unless one $do_onemore is enabled to control disconnect order + my $size = 3 - $do_onemore; + + sub finish_onemore + { + if ( $onemore && $onemore->{THRD} ) + { + # note 'SNEEK IN ANOTHER (BEGIN)'; + # my ( $in, $ou ) = ( Thread::Queue->new, Thread::Queue->new ); + # my $thr = threads->create( \&thread_worker, $in, $ou ); + # $in->enqueue( DB::Msg::Ping->new ); + # threads->yield; + # note 'SNEEK IN ANOTHER (END)'; + # usleep 200000; + + local $ENV{DBD_ORACLE_DUMP} = 1; + + note 'EXIT THE-ONE-MORE thread'; + # DBI->trace(6); + my ( $Qin, $thr ) = ( $onemore->{Q_IN}, $onemore->{THRD} ); + $Qin->enqueue( DB::Msg::Exit->new ); + sleep 1; + $thr->join; + note 'EXIT THE-ONE-MORE thread (joined)'; + } + + $onemore = undef; + + return + } + + for my $loop ( 1 .. 3 ) + { + note "START LOOP $loop" if $VERBOSE; + + { + my $queue = DB::Queue->new; + + is ref $queue, 'DB::Queue', 'isa DB::Queue'; + + ok ! $queue->isEnabled, '! q->isEnabled'; + ok $queue->enable($size), ' q->enable(X)'; + ok $queue->isEnabled, ' q->isEnabled'; + ok ! $queue->ping, ' q->ping'; + + while ( $queue->ping < $size ) { $queue->run; usleep 5000 } + + is $queue->ping, $size, ' ALL->connected'; + + if ( $do_onemore && ! $onemore ) + { + $onemore = {}; + + my ( $Qin, $Qou ) = ( Thread::Queue->new, Thread::Queue->new ); + my $thr = threads->create( \&thread_worker, $Qin, $Qou ); + + $onemore->{Q_IN} = $Qin; + $onemore->{Q_OU} = $Qou; + $onemore->{THRD} = $thr; + + $Qin->enqueue( DB::Msg::Ping->new ); + + note '+ ------------------------------------------ +'; + note ' Ping->one-more (NEW)'; + note '+ ------------------------------------------ +'; + # sleep 4; + } + # else + # { + # note '+ ------------------------------------------ +'; + # note ' Ping->one-more (PRE-EXISTS)'; + # note '+ ------------------------------------------ +'; + # # sleep 4; + # } + + note " END LOOP $loop" if $VERBOSE; + # sleep 4; + # note 'Manual Disable: ', $queue->disable; + finish_onemore if $do_first; + } + + ok( DB::Queue->new->isDisabled, ' q->isDisabled (auto-cleanup DESTROY)' ); + note qx/ps -o rss,size,pid,cmd -p $$/ if $VERBOSE; + } + + finish_onemore; +} + +note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; +done_testing(); + + +## QUEUE + +package DB::Queue; + +use strict; +use warnings; +use threads; +use threads::shared 1.51; +use Thread::Queue; +use Time::HiRes qw| usleep |; +use DBI; +use Test::More; +use Data::Dumper; + +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle /; + +our $VERSION; +our $VERBOSE; +our $ENABLED; +our $TCOUNT; +our $QUEUE_IN; +our $QUEUE_OU; +our $STATUS; +our $THREADS; + +our $ONETHR :shared; + +BEGIN { + $VERSION = 0.1; + $VERBOSE = $main::VERBOSE || 0; + $ONETHR = 1; + $ENABLED = 0; + $QUEUE_IN = []; + $QUEUE_OU = []; + $STATUS = {}; + $THREADS = []; + +# DBI->trace(9); +} + +sub CLONE { + $ENABLED = 0; + $STATUS = {}; + $THREADS = []; + $QUEUE_IN = []; + $QUEUE_OU = []; +} + +DESTROY { __PACKAGE__->disable; } +END { __PACKAGE__->disable; } + +sub new +{ + return bless {}, shift; +} + +sub isEnabled +{ + return $ENABLED && $ENABLED > 0 +} + +sub isDisabled { return ! isEnabled() } + +sub disable +{ + my $self = shift; + +# printf "# %s->disable\n", threads->tid; + + if ( threads->tid == 0 && scalar @ $THREADS ) + { + # printf "# DISABLE %s threads\n", scalar @ $THREADS; + + while ( scalar @ $THREADS ) + { + my ( $qI, $qO ) = ( shift( @ $QUEUE_IN ), shift( @ $QUEUE_OU )); + my $thr = shift @ $THREADS; + my $status = delete $STATUS->{ $thr->tid }; + + $qI && $qI->enqueue( DB::Msg::Exit->new ); + + if ( $thr ) + { + while ( ! $thr->is_joinable ) { usleep( 20000 ); } + note 'join ', $thr->tid if $VERBOSE; + $thr->join; + } + + threads->yield; + } + + $ENABLED = 0; + } + + return $self->isDisabled; +} + +sub enable +{ + my $self = shift; + my $threads = shift; + + if ( $threads && $self->isDisabled ) + { + for my $cnt ( 1 .. $threads ) + { + my ( $Qin, $Qou ) = ( Thread::Queue->new, Thread::Queue->new ); + push @ $QUEUE_IN, $Qin; + push @ $QUEUE_OU, $Qou; + + my $thr = threads->create( \&_THREAD_WORKER, $Qin, $Qou ); + push @ $THREADS, $thr; + $STATUS->{ $thr->tid } = 0; + + $ENABLED++; + } + } + + return $self->isEnabled; +} + +sub ping +{ + my $self = shift; + my $conn = 0; + + for my $queue ( @ $QUEUE_IN ) + { + $queue->enqueue( DB::Msg::Ping->new ); + } + + for my $state ( values % $STATUS ) { $state && $conn++ } + + return $conn; +} + +sub run +{ + my $self = shift; + my $msg; + + for my $queue ( @ $QUEUE_OU ) + { + while ( $msg = $queue->dequeue_nb ) + { + if ( $msg->isState ) + { + $STATUS->{ $msg->tid } = $msg->isConnected; + next; + } + + warn 'unexpected: ' . ref $msg; + } + } + + return; +} + +QUEUE_BACKEND: +{ + my $tid; + my $queue_in; + my $queue_ou; + my $dbh; + + sub _THREAD_WORKER + { + $tid = threads->tid; + $queue_in = shift; + $queue_ou = shift; + + # printf "# %2d IN: %s\n", $tid, ref $queue_in; + # printf "# %2d OU: %s\n", $tid, ref $queue_ou; + + BUSY: + while (1) + { + my $msg; + + while ( defined( $msg = $queue_in->dequeue_nb )) + { + ## CASE - PING + if ( $msg->isPing ) + { + # printf "# tid-%s PING\n", $tid; + _connect(); + # $queue_ou->enqueue( DB::Msg::Ping::ACK->new( $dbh && $dbh->ping )); + $queue_ou->enqueue( DB::Msg::Ping::ACK->new( $dbh ? 1 : 0 )); + next; + } + + ## CASE - EXIT + if ( $msg->isExit ) + { + _disconnect(); + # $queue_ou->enqueue( DB::Msg::Ping::ACK->new( 0 )); + last BUSY; + } + + printf STDERR "# Unexpected %s\n", ref $msg; + } + + usleep 50000; + } + + # printf "# tid-%s EXIT\n", $tid; + + return 1; + } + + sub do_connect + { + shift if $_[0] && ( ref($_[0]) eq __PACKAGE__ || $_[0] eq __PACKAGE__ ); + return db_handle(@_); + } + + sub _connect + { + if ( ! $dbh ) + { + lock $ONETHR; + printf "# CONNECT-ENTER %d\n", $tid if $VERBOSE; + $dbh = do_connect(); + printf "# CONNECT-EXIT %d\n", $tid if $VERBOSE; + # threads->yield; + # usleep 250000; + } + + # threads->yield; + + return; + } + + sub _disconnect + { + if ( $dbh ) + { + lock $ONETHR; + printf "# DISCONNECT-ENTER %d\n", $tid if $VERBOSE; + $dbh->disconnect; + $dbh = undef; + printf "# DISCONNECT-EXIT %d\n", $tid if $VERBOSE; + # threads->yield; + # usleep 250000; + } + + # threads->yield; + + return; + } +} + + +package DB::Msg; + +use strict; +use warnings; + +sub new { return bless {}, shift } +sub isExit { return 0 } +sub isPing { return 0 } +sub isState { return 0 } + +package DB::Msg::Exit; + +use strict; +use warnings; + +our @ISA; +BEGIN { push @ISA, 'DB::Msg' } + +sub new { return (shift)->SUPER::new } +sub isExit { return 1 } +sub isPing { return 0 } +sub isState { return 0 } + + +package DB::Msg::Ping; + +our @ISA; +BEGIN { push @ISA, 'DB::Msg' } + +use strict; +use warnings; + +sub new { return (shift)->SUPER::new } +sub isExit { return 0 } +sub isPing { return 1 } +sub isState { return 0 } + +package DB::Msg::Ping::ACK; + +use strict; +use warnings; + +our @ISA; +BEGIN { push @ISA, 'DB::Msg' } + +sub new +{ + my $self = (shift)->SUPER::new; + $self->{TID} = threads->tid; + $self->{CONNECTED} = shift; + return $self; +} + +sub isExit { return 0 } +sub isPing { return 0 } +sub isState { return 1 } + +sub tid { return $_[0]->{TID} } +sub isConnected { return $_[0]->{CONNECTED} } + +## vim: number expandtab tabstop=2 shiftwidth=2 +## END diff --git a/t/91-segv-fork.t b/t/91-segv-fork.t new file mode 100644 index 00000000..baca25d3 --- /dev/null +++ b/t/91-segv-fork.t @@ -0,0 +1,323 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Time::HiRes qw| usleep |; +use Test::More; +use Data::Dumper; + +local $Data::Dumper::Indent = 1; +local $Data::Dumper::Terse = 1; + +$ENV{DBD_ORACLE_DUMP} = 0; + +our $VERSION = 0.1; +our $VERBOSE = 0; +our $ORACLE_HOME = $ENV{ORACLE_HOME}; + +my $TEST_START = Time::HiRes::time(); + +sub section +{ + my $msg = shift; + note '+ --------------------------------------------- +'; + note " $msg"; + note '+ --------------------------------------------- +'; + return; +} + +sub abort +{ + my $msg = shift; + printf STDERR "\n"; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "# %s\n", $msg; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "\n"; + note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; + done_testing(); + exit 1; +} + +{ + DB::Fork->do_connect( { PrintError => 0 } ) or plan skip_all => "Unable to connect to oracle\n"; +} + +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + +PERL_NOTICE: +{ + note qx|perl -V| if $VERBOSE; +} + +FORK_BASICS: +{ +# last FORK_BASICS if 1; + + section 'FORK - BASICS'; + + ok $$, 'PARENT PID=' . $$; + + my $parent_dbh; + my $forker = DB::Fork->new; + my $children = 4; + my $passes = 5; + + $parent_dbh = DB::Fork->do_connect; + + is ref $forker, 'DB::Fork', ' f isa DB::Fork'; + ok $forker->isParent, ' f->isParent'; + + for my $pass ( 1 .. $passes ) + { + ok $pass, 'PASS: ' . $pass; + ok $forker->isDisabled, ' f->isDisabled'; + is $forker->enable($children), $children, ' f->enable(N)'; + ok $forker->isEnabled, ' f->isEnabled'; + + usleep 75000; + is $forker->ping, $children, ' f->ping'; + usleep 75000; + ok $forker->disable, ' f->disable'; + } +} + +FORK_SEGV: +{ + last FORK_SEGV if 1; + + section 'FORK + DB::Oracle DEGV'; + +} + +note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; +done_testing(); + + +## QUEUE + +package DB::Fork; + +use strict; +use warnings; +use Time::HiRes qw| usleep |; +use DBI; +use Test::More; +use Data::Dumper; + +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle /; + + +our $VERSION; +our $VERBOSE; +our $ENABLED; +our $CHILDREN; +our $PARENT; + +our $ONETHR :shared; + +BEGIN { + $VERSION = 0.1; + $VERBOSE = $main::VERBOSE || 0; + $CHILDREN = []; + $PARENT = $$; + +# DBI->trace(9); +} + +DESTROY { __PACKAGE__->disable; } +END { __PACKAGE__->disable; } + +sub new { return bless {}, shift; } + +sub isParent { return $PARENT && $PARENT == $$ } +sub isEnabled { return $ENABLED && $ENABLED > 0 } + +sub isDisabled { return ! isEnabled() } + +sub disable +{ + my $self = shift; + + if ( isEnabled ) + { + printf "# DISABLE %s children\n", scalar @ $CHILDREN; + + while ( @ $CHILDREN ) + { + my $child_pid = shift @ $CHILDREN; + + is kill( 'USR2', $child_pid ), 1, 'kill USR2 ' . $child_pid; + is waitpid( $child_pid, 0), $child_pid, 'wait ' . $child_pid . ' 0'; + } + + $ENABLED = 0; + } + + return $self->isDisabled; +} + +sub enable +{ + my $self = shift; + my $children = shift; + + if ( $children && $self->isDisabled ) + { + for my $cnt ( 1 .. $children ) + { + FORK: + { + my $pid = fork(); + + last FORK if ( ! defined $pid ); + + ## CHILD + if ( $pid == 0 ) + { + $ENABLED = 0; + $CHILDREN = []; + exit _FORK_WORKER(); + } + + ## I'm the parent! + push @ $CHILDREN, $pid; + $ENABLED++; + ok $pid, 'Forked child ' . $pid; + } + } + } + +# usleep 500000; + + return $ENABLED; +} + + +sub ping +{ + my $self = shift; + my $conn = 0; + my $child_pid; + my $olimit = 3 * scalar @ $CHILDREN; + my $signaled = {}; + + local $SIG{USR1} = sub + { + return unless $child_pid; + $signaled->{$child_pid} = $child_pid; + $conn++; + ok $child_pid, sprintf 'PING ACK by %s from %s', $$, $child_pid; + }; + + ok 1, sprintf 'SIGNAL %d children to PING', scalar @ $CHILDREN; + + while ( $conn < scalar @ $CHILDREN && $olimit ) + { + ## Signal Next + $child_pid = ( grep { ! exists $signaled->{$_} } @ $CHILDREN )[0]; + my $limit = 50; + + last unless $child_pid; + + ## USR1 == ping + usleep 100000; + ok kill( 'USR1', $child_pid ), 'kill USR1(ping) ' . $child_pid; + + while ( $limit-- && ! exists $signaled->{ $child_pid } ) + { + usleep 200000; + } + } + + return $conn; +} + + +QUEUE_BACKEND: +{ + my $dbh; + my $do_ping; + my $do_exit; + + sub _USER1 { printf "# USR1=PING on-child=%d received\n", $$; return ( $do_ping = 1 ); } + sub _USER2 { printf "# USR2=EXIT on-child=%d received\n", $$; return ( $do_exit = 1 ); } + + sub _FORK_WORKER + { + $do_ping = $do_exit = 0; + + printf "# PID=%d (START)\n", $$; + + local $SIG{USR1} = \&_USER1; + local $SIG{USR2} = \&_USER2; + + BUSY: + while (1) + { + ## CASE - PING + if ( $do_ping ) + { + printf "# pid=%s PING received (hold on, this is going to be a bumpy ride!)\n", $$; + _connect(); + printf "# PARENT=%s CHILD=%d %s=kill USR1\n", $PARENT, $$, kill( 'USR1', $PARENT ); + $do_ping = 0; + next; + } + + ## CASE - EXIT + if ( $do_exit ) + { + _disconnect(); + $do_exit = 0; + last BUSY; + } + + # sleep 2; + usleep 50000; + } + + printf "# pid-%s EXIT\n", $$; + + return 0; + } + + sub do_connect + { + shift if $_[0] && ( ref($_[0]) eq __PACKAGE__ || $_[0] eq __PACKAGE__ ); + return db_handle(@_); + } + + sub _connect + { + if ( ! $dbh ) + { + printf "# CONNECT-ENTER pid=%d\n", $$ if $VERBOSE; + $dbh = do_connect(); + printf "# PING=%d pid=%d\n", $dbh->ping, $$; + printf "# CONNECT-EXIT pid=%d\n", $$ if $VERBOSE; + } + + return; + } + + sub _disconnect + { + if ( $dbh ) + { + printf "# DISCONNECT-ENTER pid=%d\n", $$ if $VERBOSE; + $dbh->disconnect; + $dbh = undef; + printf "# DISCONNECT-EXIT pid=%d\n", $$ if $VERBOSE; + } + + return; + } +} + +1; + +## vim: number expandtab tabstop=2 shiftwidth=2 +## END diff --git a/t/92-segv-fork.pl b/t/92-segv-fork.pl new file mode 100755 index 00000000..8516416d --- /dev/null +++ b/t/92-segv-fork.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use lib 't/lib'; +use DBDOracleTestLib qw| db_handle |; +use Time::HiRes qw| usleep |; + +our $VERSION = 0.01; + +## GOAL: Test for segfaults in parent processes receieving SIGCHLD +## An application I maintain, dispatches childern to perform work +## that the parent process does not have time to perform. It has completed +## the work it needed, places the remaing task into a queeue, and the queue is used +## by the parent process for dispatching child proceses. +## The parent reaps the children and launches new children as needed +## until the queue is empty. The parent process is long running +## performing DB work it must itself perform. + +## We dont have any real work here so we'll emulate the work. +## This program is the child process. A test program that forks us +## will run to emulate the work being dispatched. +## +## 1. Connecting to DB +## 2. Read data. +## 3. Pretending to do work for a random period of time in the range of 2-5 seconds +## (which approxily matches the time the actual tool I maintain takes to do the task) +## 4. Disconnect from DB +## 5. Exit with a success exit code. +## The parent does not care if we succeeded or not, it just needs to know +## that we have completed the work and available for reaping. +## allowing for another task to be dispatched. + +local $Data::Dumper::Indent = 1; +local $Data::Dumper::Terse = 1; + +my $job = @ARGV ? shift : 'DEFAULT-JOB'; +my $dbh = db_handle({ AutoCommit => 0, RaiseError => 0, PrintError => 1 }); + +exit(1) unless $dbh; +exit(2) unless $dbh->ping; + +my $sth = $dbh->prepare("SELECT '${job}: The Quick Brown Fox Jumped Over The Lazy Dogs Back' FROM DUAL"); + +exit(3) unless $sth; +exit(4) unless $sth->execute; + +my $row = $sth->fetchrow_arrayref; + +exit(5) unless $sth->finish; +exit(6) unless scalar @ $row == 1; +# printf "# [ %s ]\n", $row->[]; + +my $usleep = int(rand(300000)) + 2000000; # 2-5 seconds +# printf "# %02.2f seconds\n", $usleep / 1000000; +usleep($usleep); + +exit(7) unless $dbh->disconnect; + +## Trigger OS into sending SIGCHLD to the parent process. +exit(0); + +## vim: set ts=2 sw=2 expandtab number: +## END diff --git a/t/92-segv-fork.t b/t/92-segv-fork.t new file mode 100644 index 00000000..4b9dac17 --- /dev/null +++ b/t/92-segv-fork.t @@ -0,0 +1,310 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Time::HiRes qw| usleep |; +use Test::More; +use Data::Dumper; + +local $Data::Dumper::Indent = 1; +local $Data::Dumper::Terse = 1; + +$ENV{DBD_ORACLE_DUMP} = 0; + +our $VERSION = 0.1; +our $VERBOSE = 0; +our $ORACLE_HOME = $ENV{ORACLE_HOME}; + +my $TEST_START = Time::HiRes::time(); + +sub section +{ + my $msg = shift; + note '+ --------------------------------------------- +'; + note " $msg"; + note '+ --------------------------------------------- +'; + return; +} + +sub abort +{ + my $msg = shift; + printf STDERR "\n"; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "# %s\n", $msg; + printf STDERR "# + --------------------------------------------- +\n"; + printf STDERR "\n"; + note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; + done_testing(); + exit 1; +} + +## Noise hides real issues (if there are any) +local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ m/^Subroutine/xi }; + +PERL_NOTICE: +{ + note qx|perl -V| if $VERBOSE; +} + +ORACLE_READY: +{ + Child::Queue->do_connect( { PrintError => 0 } ) or plan skip_all => "Unable to connect to oracle\n"; +} + +QUEUE_BASICS: +{ + section 'QUEUE - BASICS'; + + my $queue = Child::Queue->new( -DEPTH => 8 ); + + is $queue->depth, 8, 'Queue depth'; + is $queue->size, 0, 'Queue size'; + is $queue->running, 0, 'Queue running'; + ok $queue->isIdle, 'Queue is idle'; + ok !$queue->isBusy, 'Queue is not busy'; + ok $queue->hasSlots, 'Queue has slots'; + ok !$queue->isFull, 'Queue is not full'; + ok $queue->enqueue(1), 'Enqueue 1'; + is $queue->size, 1, 'Queue size'; + ok $queue->enqueue(2), 'Enqueue 2'; + is $queue->size, 2, 'Queue size'; + is $queue->running, 0, 'Queue running'; + is $queue->dequeue, 1, 'Dequeue 1'; + is $queue->size, 1, 'Queue size'; + is $queue->dequeue, 2, 'Dequeue 2'; + is $queue->size, 0, 'Queue size'; + ok $queue->isIdle, 'Queue is idle'; + ok !$queue->isBusy, 'Queue is not busy'; + ok $queue->hasSlots, 'Queue has slots'; +} + + +FORK_SEGV: +{ +# last FORK_SEGV if 1; + + section 'FORK - SEGV'; + + my $queue = Child::Queue->new( -DEPTH => 8 ); + my $jobs = 80; + + is $queue->depth, 8, 'Queue depth'; + is $queue->size, 0, 'Queue size'; + is $queue->running, 0, 'Queue running'; + ok $queue->isIdle, 'Queue is idle'; + ok !$queue->isBusy, 'Queue is not busy'; + ok $queue->hasSlots, 'Queue has slots'; + ok !$queue->isFull, 'Queue is not full'; + + + for my $i ( 1 .. $jobs ) + { + my $job = sprintf 'JOB-%03d', $i; + ok $queue->enqueue($job), 'Enqueue ' . $job; + } + + is $queue->size, $jobs, 'Queue size'; + is $queue->running, 0, 'Queue running - zero'; + + ok $queue->startone($queue->dequeue), 'Start one child ->> 1'; + is $queue->size, $jobs-1, 'Queue size verified'; + ok $queue->startone($queue->dequeue), 'Start one child ->> 2'; + is $queue->size, $jobs-2, 'Queue size verified'; + ok $queue->run, 'queue->run - start -DEPTH children'; + is $queue->running, 8, 'Queue running - 8 children started'; + ok $queue->isFull, 'Queue is full'; + + # note Dumper($Child::Queue::WORKSET); + + while ( $queue->isBusy ) + { + usleep(50000); + $queue->run if $queue->hasSlots && $queue->size; + usleep(15000); + } + + is $queue->size, 0, 'Queue size - all jobs done'; + is $queue->running, 0, 'Queue running - zero'; + ok $queue->isIdle, 'Queue is idle'; + ok !$queue->isBusy, 'Queue is not busy'; + ok $queue->hasSlots, 'Queue has slots'; + ok !$queue->isFull, 'Queue is not full'; +} + + +note sprintf 'Completed in %5.3fs', Time::HiRes::time() - $TEST_START; +done_testing(); + + +## Children QUEUE + +package Child::Queue; + +use strict; +use warnings; +use Data::Dumper; +use POSIX ":sys_wait_h"; + +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle /; + +our $VERSION; +our $VERBOSE; +our $QUEUE; +our $WORKSET; + +sub _SIG_CHLD +{ + my $pid = waitpid(-1, WNOHANG); + my $code = $? >> 8; + + return unless $pid > 0; + + if ( exists $WORKSET->{$pid} ) + { + my $child = delete $WORKSET->{$pid}; + my $results = $child->finish( $code ); + printf "# Child %d finished with code %d\n", $pid, $results->{CODE}; + print Dumper($results); + } + else + { + printf "# Child %d finished but not in workset", $pid; + } +} + +BEGIN { + $VERSION = 0.1; + $VERBOSE = $main::VERBOSE || 0; + $QUEUE = []; + $WORKSET = {}; # PID => Child::Runner + + $SIG{CHLD} = \&_SIG_CHLD; +} + +sub new +{ + my $self = shift; + my $args = ref $_[0] ? shift : { @_ }; + return bless $args, $self +} + +sub depth { return $_[0]->{-DEPTH} } +sub isBusy { return $_[0]->size > 0 || $_[0]->running > 0 } +sub isIdle { return ! $_[0]->isBusy } +sub enqueue { return push @ $QUEUE, pop } +sub dequeue { return shift @ $QUEUE } +sub size { return scalar @ $QUEUE } +sub running { return scalar keys % $WORKSET } +sub isFull { return $_[0]->running >= $_[0]->depth } +sub hasSlots { return ! $_[0]->isFull } + +sub do_connect +{ + shift if $_[0] && ( ref($_[0]) eq __PACKAGE__ || $_[0] eq __PACKAGE__ ); + return db_handle(@_); +} + +sub startone +{ + my $self = shift; + my $job = shift; + my $child = Child::Runner->new($job); + + ## Make sure it stays set???? + # $SIG{CHLD} = \&_SIG_CHLD; + + if ( ! defined $child->pid ) + { + warn "Unable to start child for job: $job"; + return; + } + + $WORKSET->{$child->pid} = $child; +} + +sub run +{ + my $self = shift; + + while ( $self->hasSlots && $self->size ) + { + $self->startone( $self->dequeue ); + + # my $job = shift @ $QUEUE; + # my $child = Child::Runner->new($job); + + # $WORKSET->{$child->pid} = $child; + } + + return $self->isFull; +} + + +package Child::Runner; + +use strict; +use warnings; +use IPC::Open3 (); +use Symbol 'gensym'; + +sub new +{ + my $self = bless {}, shift; + my $job = $self->job(shift); + my ( $in, $out, $err ) = (undef, undef, gensym); + my $pid = IPC::Open3::open3( $in, $out, $err, $^X, 't/92-segv-fork.pl', $job ); + + if ( ! defined $pid ) + { + warn "Unable to fork: $!"; + return; + } + + $in->close or warn $! if $in; + $self->pid($pid); + $self->out($out); + $self->err($err); + + return $self; +} + +sub finish +{ + my $self = shift; + my $code = shift; + my $job = $self->job; + my $pid = $self->pid; + my $out = $self->out; + my $err = $self->err; + my $results = { -JOB => $job, -PID => $pid, -OUT => [], -ERR => [] }; + + if ( $self->pid ) + { + my $O = $results->{-OUT}; + my $E = $results->{-ERR}; + + while ( my $l = <$out> ) { chomp $l; push @ $O, $l } + while ( my $l = <$err> ) { chomp $l; push @ $E, $l } + + close $out or warn "Unable to close out: $!"; + close $err or warn "Unable to close err: $!"; + + # waitpid( $pid, 0 ); + # $results->{ CODE } = $? >> 8; + $results->{ CODE } = $code; + } + + return $results; +} + +sub job { return defined $_[1] ? $_[0]->{_JOB______} = $_[1] : $_[0]->{_JOB______} } +sub pid { return defined $_[1] ? $_[0]->{_PID______} = $_[1] : $_[0]->{_PID______} } +sub out { return defined $_[1] ? $_[0]->{_OUT______} = $_[1] : $_[0]->{_OUT______} } +sub err { return defined $_[1] ? $_[0]->{_ERR______} = $_[1] : $_[0]->{_ERR______} } + +1; + +## vim: number expandtab tabstop=2 shiftwidth=2 +## END diff --git a/t/cache2.pl b/t/cache2.pl new file mode 100644 index 00000000..835a98d9 --- /dev/null +++ b/t/cache2.pl @@ -0,0 +1,64 @@ +#!perl +#written by Andrey A Voropaev (avorop@mail.ru) + +use strict; + +use DBI; + +tst1(); +tst2(); +tst1(); +tst2(); + +sub tst1 +{ + my $dbh = db_handle({ + RaiseError => 0, + PrintError => 0, + AutoCommit => 1, + ora_charset => 'WE8MSWIN1252', + }); + my $sth = $dbh->prepare( + q{ select 1 from dual } + ); + $sth->execute(); + my $r = $sth->fetchall_arrayref(); +} + +sub tst2 +{ + my $dbh = db_handle({ + RaiseError => 0, + PrintError => 0, + AutoCommit => 1, + ora_charset => 'AL32UTF8', + }); + my $sth = $dbh->prepare( + q{ select 2 from dual } + ); + $sth->execute(); + my $r = $sth->fetchall_arrayref(); +} + + +sub oracle_test_dsn { + my ( $default, $dsn ) = ( 'dbi:Oracle:', $ENV{ORACLE_DSN} ); + + $dsn ||= $ENV{DBI_DSN} + if $ENV{DBI_DSN} && ( $ENV{DBI_DSN} =~ m/^$default/io ); + $dsn ||= $default; + + return $dsn; +} + +sub db_handle { + + my $p = shift; + my $dsn = oracle_test_dsn(); + my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; + my $dbpass = $ENV{ORACLE_PASSWD} || ''; + my $dbh = DBI->connect_cached( $dsn, $dbuser, $dbpass, $p ); + return $dbh + +} + diff --git a/t/lib/DBDOracleTestLib.pm b/t/lib/DBDOracleTestLib.pm new file mode 100644 index 00000000..53528d90 --- /dev/null +++ b/t/lib/DBDOracleTestLib.pm @@ -0,0 +1,576 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +package DBDOracleTestLib; +use Test::More; + +use Exporter 'import'; + +use vars qw( @EXPORT_OK ); + +@EXPORT_OK = ( + qw/ db_handle extra_wide_rows long_test_cols + oracle_test_dsn show_test_data test_data + select_test_count select_rows + cmp_ok_byte_nice show_db_charsets + db_ochar_is_utf db_nchar_is_utf + client_ochar_is_utf8 client_nchar_is_utf8 + set_nls_nchar set_nls_lang_charset + insert_test_count nice_string force_drop_table + create_table table drop_table insert_rows dump_table +/, +); + +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 =~ m/^"/; # XXX ugly hack, sufficient here + return 0 if $v =~ m/^'/; # 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 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 + ); +} + +{ + +my $char_cols = + [ [ ch => 'varchar2(20)' ], [ descr => 'varchar2(50)' ], ]; + +my $nchar_cols = + [ [ nch => 'nvarchar2(20)' ], [ descr => 'varchar2(50)' ], ]; + +my $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 _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} =~ m/^$default/io ); + $dsn ||= $default; + + return $dsn; +} + +sub db_handle { + + my $p = shift; + + $p ||= { + AutoCommit => 1, + PrintError => 0, + ora_envhp => 0, # force fresh environment (with current NLS env vars) + }; + + my $dsn = oracle_test_dsn(); + my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; + my $dbpass = $ENV{ORACLE_PASSWD} || ''; + my $dbh = DBI->connect( $dsn, $dbuser, $dbpass, $p ); + 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 { + my $table = shift || 'dbd_ora__drop_me'; + $table .= ( $ENV{DBD_ORACLE_SEQ} || '' ); + die "Test table name '$table' is too long for Oracle < 12.1" + if length $table > 30; + # In Oracle 12.2 and above the maximum object name length is 128 bytes. + # In Oracle 12.1 and below the maximum object name length is 30 bytes. + return $table +} + +sub force_drop_table { + my $dbh = shift; + return unless $dbh; + my $tname = shift || table(); + local $dbh->{PrintError} = 0; + if ($dbh->{Active}) { + $dbh->do(qq{ DROP TABLE $tname PURGE }) + } +} + +sub drop_table { + my @args = @_; + return if $ENV{'DBD_SKIP_TABLE_DROP'}; + force_drop_table( @args ) +} + +sub _insert_handle { + my ( $dbh, $tcols ) = @_; + my $table = table(); + my $sql = "insert into $table ( idx, "; + my $cnt = 1; + for 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 }" : q||; + } + 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; + for 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 '; + for 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)' : q||; + 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 PURGE }) if $drop; + $dbh->do($sql); + if ( $dbh->err && $dbh->err == 955 ) { + $dbh->do(qq{ DROP TABLE $table PURGE }); + 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') || '', + ora_env_var('NLS_NCHAR') || ''; + 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') || q(); + $NLS_LANG =~ s/.*\.//; + return $NLS_LANG =~ m/utf8/i; +} + +sub client_nchar_is_utf8 { + my $NLS_LANG = ora_env_var('NLS_LANG') || q(); + $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" : q(); + + note sprintf( q|set $ENV{NLS_LANG}='%s'|, $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; + + for my $c (@chars) { + if ( $c =~ m/\\x\{08(..)}/ ) { + $c .= q|='| . chr( hex($1) ) . q('); + } + } + my $ret = join( q||, @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 my $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; diff --git a/t/lib/ExecuteArray.pm b/t/lib/ExecuteArray.pm new file mode 100644 index 00000000..1a347033 --- /dev/null +++ b/t/lib/ExecuteArray.pm @@ -0,0 +1,519 @@ +#!perl +# 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'.($ENV{DBD_ORACLE_SEQ}||''); +my $table2 = 'PERL_DBD_execute_array2'.($ENV{DBD_ORACLE_SEQ}||''); +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 PURGE/); + $dbh->do(qq/DROP TABLE $table2 PURGE/); + }; + 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-existent 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; diff --git a/t/nchar_test_lib.pl b/t/nchar_test_lib.pl deleted file mode 100644 index 1b249962..00000000 --- a/t/nchar_test_lib.pl +++ /dev/null @@ -1,523 +0,0 @@ -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") || "", ora_env_var("NLS_NCHAR") || ""; - 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; diff --git a/t/rt13865.t b/t/rt13865.t index 7edee833..2df27b17 100644 --- a/t/rt13865.t +++ b/t/rt13865.t @@ -1,69 +1,144 @@ +#!perl + use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ db_handle table drop_table force_drop_table /; 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 $dbh = db_handle() + or plan skip_all => q|Can't connect to database|; -my %priv = map { $_ => 1 } get_privs( $dbh ); +my %priv = map { $_ => 1 } get_privs($dbh); -unless ( ( $priv{'CREATE TABLE'} or $priv{'CREATE ANY TABLE'} ) - and ( $priv{'DROP TABLE'} or $priv{'DROP ANY TABLE'} ) ) { - plan skip_all => q{requires permissions 'CREATE TABLE' and 'DROP TABLE'}; +unless ( $priv{'CREATE TABLE'} ) { + plan skip_all => q{requires permissions 'CREATE TABLE'}; } -plan tests => 5; +my $table = table('rt13865__drop_me'); +force_drop_table($dbh, $table); -$dbh->do( 'DROP TABLE RT13865' ); - -$dbh->do( <<'END_SQL' ) or die $dbh->errstr; -CREATE TABLE RT13865( +my $create_sql = <<"END_SQL"; +CREATE TABLE $table( 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_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)"; +my @tests = ( + { + col => 'COL_INTEGER', + size => 38, + cmp => '==', + name => 'INTEGER is alias for NUMBER(38)' + }, + { + col => 'COL_NUMBER_37', + size => 37, + cmp => '==', + name => 'NUMBER(37)' + }, + { + col => 'COL_NUMBER', + size => 0, + cmp => '>', + name => 'NUMBER' + }, + { + col => 'COL_VC2', + size => 67, + cmp => '==', + name => 'VARCHAR2(67)' + }, + { + col => 'COL_VC2_69CHAR', + size => 69, + cmp => '==', + name => 'VARCHAR2(69)' + }, + { + col => 'COL_NVC2', + size => 69, + cmp => '==', + name => 'NVARCHAR2(69)' + }, + { + col => 'COL_NC', + size => 69, + cmp => '==', + name => 'NCHAR(69)' + }, + { + col => 'COL_CHAR', + size => 67, + cmp => '==', + name => 'CHAR(67)' + }, + { + col => 'COL_CHAR_69CHAR', + size => 69, + cmp => '==', + name => 'CHAR(69)' + }, +); # @tests + +ok( $dbh->do($create_sql), "Create database: $table" ) + or die $dbh->errstr; + +for my $test (@tests) { + + my $col_h = $dbh->column_info( undef, undef, uc($table), $test->{col} ); + + # if column_info() returns undef, then the driver doesnt support column_info. DBD::Oracle should support it. + ok( + $col_h, + sprintf( + 'column_info() returns something for test: %s', $test->{name} + ) + ) or next; + cmp_ok( ref $col_h, 'eq', 'DBI::st', + sprintf( 'returned object is correct for test: %s', $test->{name} ) ); + +# if there is no row, then the table/column couldnt be found... this should not happen either + my $row = $col_h->fetchrow_hashref; + cmp_ok( + ref $row, + 'eq', 'HASH', + sprintf( +'column/table now found - fetchrow_hashref returned a hash for test: %s', + $test->{name} ) + ) or next; + + # this is the actual test, everything above it sanity checking / pre-diagnosis + cmp_ok( $row->{COLUMN_SIZE}, $test->{cmp}, $test->{size}, $test->{name} ); +} -$dbh->do( 'DROP TABLE RT13865' ); +drop_table($dbh, $table); # utility functions -sub get_privs { +sub get_privs { my $dbh = shift; - my $sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' ); + my $sth = $dbh->prepare('SELECT PRIVILEGE from session_privs'); $sth->execute; return map { $_->[0] } @{ $sth->fetchall_arrayref }; } + +done_testing(); diff --git a/t/rt74753-utf8-encoded.t b/t/rt74753-utf8-encoded.t new file mode 100644 index 00000000..19b7490a --- /dev/null +++ b/t/rt74753-utf8-encoded.t @@ -0,0 +1,87 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_ochar_is_utf db_handle /; + +use Test::More; + +use DBI; +use Encode; + +$ENV{NLS_LANG} = 'AMERICAN_AMERICA.UTF8'; +$ENV{NLS_NCHAR} = 'UTF8'; + +my $dbh = db_handle( + { + 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; +$dbh && $dbh->rollback; + +is Encode::is_utf8($val) => 1, 'truncated, yet utf8 encoded'; diff --git a/t/rt85886.t b/t/rt85886.t new file mode 100644 index 00000000..3d43a202 --- /dev/null +++ b/t/rt85886.t @@ -0,0 +1,49 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use DBDOracleTestLib qw/ oracle_test_dsn db_handle /; + +use Test::More; + +use DBI qw(:sql_types); +use Devel::Peek; +use B qw( svref_2object SVf_IOK SVf_NOK SVf_POK ); + +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 $dbh = db_handle( + { + 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} ); diff --git a/test.pl b/test.pl deleted file mode 100755 index 94830576..00000000 --- a/test.pl +++ /dev/null @@ -1,319 +0,0 @@ -#!/usr/local/bin/perl -w - -use ExtUtils::testlib; - -die "Use 'perl -Mblib test.pl' or 'make test' to run test.pl\n" - unless "@INC" =~ /\bblib\b/; - -# Copyright (c) 1995-2004, 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 - -$| = 1; - -use Getopt::Long; -use Config; - -my $os = $Config{osname}; - -GetOptions( - 'm!' => \my $opt_m, # do mem leak test - 'n=i' => \my $opt_n, # num loops for some tests - 'c=i' => \my $opt_c, # RowCacheSize for some tests - 'f=i' => \my $opt_f, # fetch test - 'p!' => \my $opt_p, # perf test -) or die; -$opt_n ||= 10; - -# skip this old set of half-baked oddities if ORACLE_DSN env var is set -exit 0 if $ENV{ORACLE_DSN}; - -$dbname = $ARGV[0] || ''; # if '' it'll use TWO_TASK/ORACLE_SID -$dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; - -use Oraperl; - -exit test_extfetch_perf($opt_f) if $opt_f; - -exit test_leak(10 * $opt_n) if $opt_m; - -&ora_version; - -my @data_sources = DBI->data_sources('Oracle'); -print "Data sources:\n\t", join("\n\t",@data_sources),"\n"; - -print "Connecting\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"; - warn "\nTest aborted cannot connect.\n"; - exit 0; - } - 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"; - -} - -&test_intfetch_perf() if $opt_p; - -&test1(); - -print "\nRepetitive connect/open/close/disconnect:\n"; -#print "If this test hangs then read the README.help.txt file.\n"; -#print "Expect sequence of digits, no other messages:\n"; -# likely to fail with: ORA-12516: TNS:listener could not find available handler with matching protocol stack (DBD ERROR: OCIServerAttach) -# in default configurations if the number of iterations is high (>~20) -my $connect_loop_start = DBI::dbi_time(); -foreach(1..$opt_n) { print "$_ "; &test2(); } -my $dur = DBI::dbi_time() - $connect_loop_start; -printf "(~%.3f seconds each)\n", $dur / $opt_n; - -print "test.pl complete.\n\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: \t",join("\t", &ora_titles($csr)),"\n"; - print "Lengths: \t",DBI::neat_list([&ora_lengths($csr)],0,"\t"),"\n"; - print "OraTypes: \t",DBI::neat_list([&ora_types($csr)], 0,"\t"),"\n"; - print "SQLTypes: \t",DBI::neat_list($csr->{TYPE}, 0,"\t"),"\n"; - print "Scale: \t",DBI::neat_list($csr->{SCALE}, 0,"\t"),"\n"; - print "Precision: \t",DBI::neat_list($csr->{PRECISION}, 0,"\t"),"\n"; - print "Nullable: \t",DBI::neat_list($csr->{NULLABLE}, 0,"\t"),"\n"; - print "Est row width:\t$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"; - } - &ora_logoff($lda) || warn "ora_logoff($lda): $ora_errno: $ora_errstr\n"; -} - - -sub test2 { # also used by test_leak() - my $execute_sth = shift; - my $dbh = DBI->connect("dbi:Oracle:$dbname", $dbuser, '', { RaiseError=>1 }); - if ($execute_sth) { - my $sth = $dbh->prepare("select 42,'foo',sysdate from dual where ? >= 1"); - while ($execute_sth-- > 0) { - $sth->execute(1); - my @row = $sth->fetchrow_array; - $sth->finish; - } - } - $dbh->disconnect; -} - - -sub test_leak { - local($count) = @_; - local($ps) = (-d '/proc') ? "ps -lp " : "ps -l"; - local($i) = 0; - my $execute_sth = 100; - print "\nMemory leak test: (execute $execute_sth):\n"; - while(++$i <= $count) { - &test2($execute_sth); - system("echo $i; $ps$$") if (($i % 10) == 1); - } - system("echo $i; $ps$$"); - print "Done.\n\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.