├── hints ├── macos_lib.syms ├── macos_bundle.syms ├── dgux.pl ├── svr4.pl └── macos_syms.pl ├── typemap ├── .whitesource ├── xt ├── changes.t ├── pod.t └── manifest.t ├── .gitignore ├── MANIFEST.SKIP ├── err_docs └── err_trace.msg ├── lib └── DBD │ └── Oracle │ ├── Object.pm │ ├── Troubleshooting │ ├── Sun.pod │ ├── Cygwin.pod │ ├── Vms.pod │ └── Linux.pod │ └── Troubleshooting.pod ├── .mailmap ├── t ├── 01base.t ├── 60reauth.t ├── 00versions.t ├── 38taf.t ├── rt85886.t ├── 23wide_db_al32utf8.t ├── 23wide_db_8bit.t ├── 22nchar_al32utf8.t ├── 22nchar_utf8.t ├── 15nls.t ├── 12impdata.t ├── 23wide_db.t ├── 26exe_array.t ├── rt74753-utf8-encoded.t ├── 21nchar.t ├── 56embbeded.t ├── 24implicit_utf8.t ├── 39attr.t ├── 32xmltype.t ├── rt13865.t ├── 70meta.t ├── 50cursor.t ├── 80ora_charset.t ├── 34pres_lobs.t ├── 55nested.t ├── 10general.t ├── 51scroll.t ├── 40ph_type.t ├── 14threads.t ├── 36lob_leak.t └── 20select.t ├── dist.ini ├── examples ├── read_long_via_blob_read.pl ├── bind.pl ├── inserting_longs.pl ├── oradump.pl ├── ex.pl ├── japh ├── commit.pl ├── README ├── tabinfo.pl ├── mktable.pl ├── curref.pl └── proc.pl ├── err_unsorted ├── err_ora9ir2oci.msg ├── err_etherreal.msg ├── err_refcsr_rowcache.msg ├── err_ref_type.msg └── err_xml.msg ├── MANIFEST ├── err_bind ├── err_bindclobleak.msg ├── err_bindnullhash.msg └── err_bind_param_inout_overrun_bug.msg ├── dbivport.h ├── err_lob ├── err_csr_clob.msg ├── err_nulllobsegv.msg └── err_loblenwide.msg ├── mkta.pl ├── CONTRIBUTING.mkd ├── Todo ├── err_build ├── err_makefileundef.msg ├── err_memleak.msg ├── err_hpux_ld.msg └── err_testfailnotable.msg └── Oracle.h /hints/macos_lib.syms: -------------------------------------------------------------------------------- 1 | _dlsym 2 | _dlclose 3 | _poll 4 | 5 | -------------------------------------------------------------------------------- /typemap: -------------------------------------------------------------------------------- 1 | OCILobLocator * T_PTROBJ 2 | OCIXMLType * T_PTROBJ -------------------------------------------------------------------------------- /.whitesource: -------------------------------------------------------------------------------- 1 | { 2 | "generalSettings": { 3 | "shouldScanRepo": true 4 | }, 5 | "checkRunSettings": { 6 | "vulnerableCheckRunConclusionLevel": "failure" 7 | } 8 | } -------------------------------------------------------------------------------- /xt/changes.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | eval 'use Test::CPAN::Changes'; 7 | plan skip_all => 'Test::CPAN::Changes required for this test' if $@; 8 | changes_ok(); 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pm_to_blib 2 | MYMETA.yml 3 | Makefile 4 | Makefile.old 5 | Oracle.bs 6 | Oracle.c 7 | Oracle.o 8 | Oracle.xsi 9 | blib 10 | MYMETA.json 11 | dbdimp.o 12 | mk.pm 13 | oci8.o 14 | DBD-Oracle* 15 | project.vim 16 | -------------------------------------------------------------------------------- /xt/pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | eval "use Test::Pod"; 4 | 5 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 6 | 7 | pod_file_ok( 'Oracle.pm' ); 8 | pod_file_ok( 'lib/DBD/Oracle/Object.pm' ); 9 | pod_file_ok( 'lib/DBD/Oracle/GetInfo.pm' ); 10 | 11 | done_testing; 12 | -------------------------------------------------------------------------------- /hints/macos_bundle.syms: -------------------------------------------------------------------------------- 1 | _main 2 | _kpuach 3 | _kpuasav 4 | _kpucer 5 | _kpudbcx 6 | _kpudc 7 | _kpudcx 8 | _kpuddb 9 | _kpudex 10 | _kpudsc 11 | _kpuexes 12 | _kpugbccx 13 | _kpugbncx 14 | _kpugc 15 | _kpugdcx 16 | _kpugml 17 | _kpuic 18 | _kpuicx 19 | _kpulsc 20 | _kpumcf 21 | _kpusdl 22 | _kpusdt 23 | _kpusnchr 24 | _kpusvar 25 | -------------------------------------------------------------------------------- /hints/dgux.pl: -------------------------------------------------------------------------------- 1 | my $archname = $Config::Config{archname} || die; 2 | $att{LIBS} ||= []; 3 | $att{LIBS}->[0] ||= ''; 4 | 5 | push @libs, '-lc', '-lm'; 6 | 7 | warn "$^O LIBS attribute defaulted to '$att{LIBS}->[0]' for '$archname'"; 8 | $att{LIBS}->[0] .= " ".join(" ", @libs); # append libs 9 | warn "$^O LIBS attribute updated to '$att{LIBS}->[0]'"; 10 | 11 | 12 | __END__ 13 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^DBD-Oracle-.* 2 | \.svn\b 3 | \.orig$ 4 | \..*.swp$ 5 | ^.pure 6 | ^DIST/ 7 | ^MANIFEST\. 8 | ^Makefile$ 9 | ^blib/ 10 | ^csr/ 11 | ^err[/_] 12 | ^old/ 13 | ^info/ 14 | ^oci8/ 15 | ^oracle/ 16 | ^tags$ 17 | ~$ 18 | ^\.git 19 | ^xt 20 | dbdimp.o 21 | Makefile.old 22 | mk.pm 23 | MYMETA.json 24 | MYMETA.yml 25 | oci8.o 26 | Oracle.bs 27 | Oracle.c 28 | Oracle.o 29 | Oracle.xsi 30 | pm_to_blib 31 | 32 | dist.ini 33 | project.vim 34 | -------------------------------------------------------------------------------- /err_docs/err_trace.msg: -------------------------------------------------------------------------------- 1 | Add this to the DBD::Oracle docs as a handy note: 2 | 3 | $dbh->do(q{alter session set events '65285 trace name errorstack level 3'}); 4 | 5 | A trace file should then be generated. 6 | 7 | Trace files are generated in the 'user_dump_destination' specified in init.ora. 8 | 9 | Try $ORACLE_BASE/admin/$ORACLE_SID/udump. 10 | 11 | or the location returned by 12 | select value 13 | from v$parameter 14 | where name like '%user_dump%' 15 | -------------------------------------------------------------------------------- /xt/manifest.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use ExtUtils::Manifest qw/ fullcheck /; 5 | 6 | use Test::More tests => 1; 7 | 8 | my ( $missing, $extra ) = do { 9 | local *STDERR; 10 | 11 | # hush little baby, don't you cry 12 | open STDERR, '>', \my $stderr; 13 | 14 | fullcheck(); 15 | }; 16 | 17 | ok @$missing + @$extra == 0, 'manifest in sync' or do { 18 | diag "missing files:\n", map { " \t $_\n " } @$missing if @$missing; 19 | diag "extra files: \n", map { "\t$_\n" } @$extra if @$extra; 20 | }; 21 | 22 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Object.pm: -------------------------------------------------------------------------------- 1 | package DBD::Oracle::Object; 2 | # ABSTRACT: Wrapper for Oracle objects 3 | 4 | use strict; 5 | use warnings; 6 | 7 | sub type_name { shift->{type_name} } 8 | 9 | sub attributes { @{shift->{attributes}} } 10 | 11 | sub attr_hash { 12 | my $self = shift; 13 | return $self->{attr_hash} ||= { $self->attributes }; 14 | } 15 | 16 | sub attr { 17 | my $self = shift; 18 | if (@_) { 19 | my $key = shift; 20 | return $self->attr_hash->{$key}; 21 | } 22 | return $self->attr_hash; 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /.mailmap: -------------------------------------------------------------------------------- 1 | Yanick Champoux 2 | Yanick Champoux 3 | Yanick Champoux 4 | Tim Bunce 5 | Tim Bunce 6 | Martin J. Evans 7 | Martin J. Evans 8 | John Scoles 9 | Michael Portnoy 10 | -------------------------------------------------------------------------------- /t/01base.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | 3 | use strict; 4 | use warnings; 5 | 6 | # Base DBD Driver Test 7 | use Test::More tests => 6; 8 | 9 | require_ok('DBI'); 10 | 11 | eval { 12 | import DBI; 13 | }; 14 | 15 | is $@ => '', 'successfully import DBI'; 16 | 17 | is ref DBI->internal => 'DBI::dr', 'internal'; 18 | 19 | my $drh = eval { 20 | # This is a special case. install_driver should not normally be used. 21 | DBI->install_driver('Oracle'); 22 | }; 23 | 24 | is $@ => '', 'install_driver' 25 | or diag "Failed to load Oracle extension and/or shared libraries"; 26 | 27 | SKIP: { 28 | skip 'install_driver failed - skipping remaining', 2 if $@; 29 | 30 | is ref $drh => 'DBI::dr', 'install_driver'; 31 | 32 | ok $drh->{Version}, 'version'; 33 | } 34 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = DBD-Oracle 2 | author = Tim Bunce 3 | author = John Scoles 4 | author = Yanick Champoux 5 | author = Martin J. Evans 6 | license = Perl_5 7 | copyright_holder = Tim Bunce 8 | copyright_year = 1994 9 | 10 | version = 1.74 11 | 12 | [TemplateCJM] 13 | file = CONTRIBUTING.mkd 14 | 15 | [Authority] 16 | authority=cpan:PYTHIAN 17 | 18 | [MakeMaker::Custom] 19 | 20 | [@Filter] 21 | -bundle=@YANICK 22 | -remove=NextVersion::Semantic 23 | -remove=ChangeStats::Git 24 | -remove=ModuleBuild 25 | -remove=Authority 26 | -remove=Signature 27 | -remove=Twitter 28 | -remove=Test::Compile 29 | -remove=Covenant 30 | -remove=CoderwallEndorse 31 | 32 | [Prereqs / ConfigureRequires] 33 | DBI = 1.51 34 | 35 | [HelpWanted] 36 | positions = coder documentation tester 37 | 38 | -------------------------------------------------------------------------------- /examples/read_long_via_blob_read.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use DBI; 7 | 8 | my $dbh = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' ); 9 | 10 | $dbh->{RaiseError} = 1; 11 | $dbh->{LongTruncOk} = 1; # truncation on initial fetch is ok 12 | 13 | my $sth = $dbh->prepare("SELECT key, long_field FROM table_name"); 14 | $sth->execute; 15 | 16 | while ( my ($key) = $sth->fetchrow_array) { 17 | my $offset = 0; 18 | my $lump = 4096; # use benchmarks to get best value for you 19 | my @frags; 20 | while (1) { 21 | my $frag = $sth->blob_read(1, $offset, $lump); 22 | last unless defined $frag; 23 | my $len = length $frag; 24 | last unless $len; 25 | push @frags, $frag; 26 | $offset += $len; 27 | } 28 | my $blob = join "", @frags; 29 | print "$key: $blob\n"; 30 | } 31 | 32 | -------------------------------------------------------------------------------- /t/60reauth.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use Test::More; 3 | 4 | use DBI; 5 | unshift @INC ,'t'; 6 | require 'nchar_test_lib.pl'; 7 | 8 | $| = 1; 9 | 10 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 11 | my $dbuser_2 = $ENV{ORACLE_USERID_2} || ''; 12 | 13 | if ($dbuser_2 eq '') { 14 | plan skip_all => "ORACLE_USERID_2 not defined.\n"; 15 | } 16 | # strip off @ on userid_2, as the reauth presumes current server 17 | $dbuser_2 =~ s/@.*//; 18 | (my $uid1 = uc $dbuser) =~ s:/.*::; 19 | (my $uid2 = uc $dbuser_2) =~ s:/.*::; 20 | if ($uid1 eq $uid2) { 21 | plan skip_all => "ORACLE_USERID_2 not unique.\n"; 22 | } 23 | 24 | my $dsn = oracle_test_dsn(); 25 | my $dbh = DBI->connect($dsn, $dbuser, ''); 26 | 27 | if ($dbh) { 28 | plan tests => 3; 29 | } else { 30 | plan skip_all => "Unable to connect to Oracle\n"; 31 | } 32 | 33 | is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid1, 'uid1' ); 34 | ok($dbh->func($dbuser_2, '', 'reauthenticate'), 'reauthenticate'); 35 | is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid2, 'uid2' ); 36 | 37 | $dbh->disconnect; 38 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Troubleshooting/Sun.pod: -------------------------------------------------------------------------------- 1 | #PODNAME: DBD::Oracle::Troubleshooting::Sun 2 | #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Sun 3 | 4 | =head1 General Info 5 | 6 | If you get this on a Solaris 9 and 10 box 7 | 8 | "Outofmemory! 9 | Callback called exit. 10 | END failed--call queue aborted." 11 | 12 | The solution may be as simple as not having you "ORACLE_HOME" Defined in the 13 | environment. 14 | 15 | It seems that having it defined will prevent the error. 16 | 17 | =head1 Setting library load path for instant client libraries 18 | 19 | Usually you set LD_LIBRARY_PATH to point to the location of 20 | your Oracle Instant Client (you need to do this when building 21 | DBD::Oracle). However, afterwards it can be a pain to keep 22 | ensuring this is set and changing LD_LIBRARY_PATH in your Perl 23 | script does not work (needs to be done beforehand) as the dynamic 24 | linker caches its value. 25 | 26 | An alternative under newer versions of Solaris is: 27 | 28 | root> crle -u -l /youroracledir/lib/instantclient_11_2 29 | 30 | however, make sure you check the crle options as you may need to 31 | set the architecture etc as well. 32 | 33 | -------------------------------------------------------------------------------- /t/00versions.t: -------------------------------------------------------------------------------- 1 | # reports on all interesting versions 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't'; 7 | 8 | use Test::More tests => 2; 9 | 10 | use DBD::Oracle qw/ ORA_OCI /; 11 | require 'nchar_test_lib.pl'; 12 | 13 | my $oci_version = ORA_OCI(); 14 | 15 | diag "OCI client library version: ", $oci_version; 16 | 17 | ok $oci_version; 18 | 19 | SKIP: { 20 | my $dsn = oracle_test_dsn(); 21 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 22 | 23 | my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }) or 24 | note <<'END_NOTE' or skip q{can't connect to database} => 1; 25 | 26 | Can't connect to an Oracle instance. 27 | 28 | Without a database connection, most of DBD::Oracle's test suite will 29 | be skipped. To let the tests use a database, set up the 30 | environment variables ORACLE_USERID and ORACLE_DSN. E.g.: 31 | 32 | $ export ORACLE_USERID='scott/tiger' 33 | $ export ORACLE_DSN='dbi:Oracle:testdb' 34 | 35 | END_NOTE 36 | 37 | my $sth = $dbh->prepare( q{select * from v$version where banner like 'Oracle%'} ); 38 | $sth->execute; 39 | 40 | my $version = join ' ', $sth->fetchrow; 41 | 42 | diag 'database version: ', $version; 43 | 44 | ok $version; 45 | } 46 | -------------------------------------------------------------------------------- /examples/bind.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # bind.pl 4 | # 5 | # This shows how a placeholder may be used to implement a simple lookup. 6 | 7 | use DBI; 8 | 9 | use strict; 10 | 11 | # Set trace level if '-# trace_level' option is given 12 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 13 | 14 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 15 | my ( $inst, $user, $pass ) = @ARGV; 16 | 17 | # Connect to database 18 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 19 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 20 | or die $DBI::errstr; 21 | 22 | # Prepare the SELECT statement using a placeholder 23 | my $sth = $dbh->prepare( 'SELECT created FROM all_users WHERE username = ?' ); 24 | 25 | my ( $created ); 26 | $| = 1; 27 | print "Enter an empty line to finish\n"; 28 | print "Userid? "; 29 | while ( ) { 30 | chomp; 31 | last if ! $_; 32 | $sth->execute( uc( $_ ) ); 33 | 34 | # Note that the variable is in parenthesis to give an array context 35 | if ( ( $created ) = $sth->fetchrow_array ) { 36 | print "$created\n"; 37 | } 38 | else { 39 | print "unknown\n"; 40 | } 41 | print "Userid? "; 42 | } 43 | 44 | $sth->finish; 45 | $dbh->disconnect; 46 | -------------------------------------------------------------------------------- /t/38taf.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # $Id$ 3 | 4 | use DBI; 5 | use DBD::Oracle(qw(:ora_fail_over)); 6 | use strict; 7 | #use Devel::Peek qw(SvREFCNT Dump); 8 | 9 | use Test::More; 10 | unshift @INC ,'t'; 11 | require 'nchar_test_lib.pl'; 12 | 13 | $| = 1; 14 | 15 | # create a database handle 16 | my $dsn = oracle_test_dsn(); 17 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 18 | 19 | my $dbh = eval { DBI->connect($dsn, $dbuser, '',) } 20 | or plan skip_all => "Unable to connect to Oracle"; 21 | 22 | $dbh->disconnect; 23 | 24 | if ( !$dbh->ora_can_taf ){ 25 | 26 | eval { 27 | $dbh = DBI->connect( 28 | $dsn, $dbuser, '', 29 | {ora_taf_function => 'taf'}) 30 | }; 31 | my $ev = $@; 32 | like($ev, qr/You are attempting to enable TAF/, "'$ev' (expected)"); 33 | } 34 | else { 35 | ok $dbh = DBI->connect($dsn, $dbuser, '', 36 | {ora_taf_function=>'taf'}); 37 | 38 | is($dbh->{ora_taf_function}, 'taf', 'TAF callback'); 39 | 40 | my $x = sub {}; 41 | # diag(SvREFCNT($x)); 42 | # diag(Dump($x)); 43 | $dbh->{ora_taf_function} = $x; 44 | is(ref($dbh->{ora_taf_function}), 'CODE', 'TAF code ref'); 45 | 46 | # diag(SvREFCNT($x)); 47 | } 48 | 49 | $dbh->disconnect; 50 | 51 | done_testing(); 52 | -------------------------------------------------------------------------------- /t/rt85886.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use Devel::Peek; 10 | use B qw( svref_2object SVf_IOK SVf_NOK SVf_POK ); 11 | 12 | unshift @INC ,'t'; 13 | require 'nchar_test_lib.pl'; 14 | 15 | sub is_iv { 16 | my $sv = svref_2object(my $ref = \$_[0]); 17 | my $flags = $sv->FLAGS; 18 | 19 | # See http://www.perlmonks.org/?node_id=971411 20 | my $x = $sv->can('PV') ? $sv->PV : undef; 21 | 22 | if (wantarray) { 23 | return ($flags & SVf_IOK, $x); 24 | } else { 25 | return $flags & SVf_IOK; 26 | } 27 | } 28 | 29 | my $dsn = oracle_test_dsn(); 30 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 31 | 32 | my $dbh = DBI->connect( $dsn, $dbuser, '', { 33 | PrintError => 0, FetchHashKeyName =>'NAME_lc'}); 34 | 35 | plan skip_all => "unable to connect to Oracle database" if not $dbh; 36 | 37 | plan tests => 2; 38 | 39 | my $s = $dbh->prepare(q/select 1 as one from dual/); 40 | $s->execute; 41 | 42 | $s->bind_col (1, undef, {TYPE => SQL_INTEGER, DiscardString => 1}); 43 | 44 | my $list = $s->fetchall_arrayref({}); 45 | 46 | is($list->[0]{one}, 1, "correct value returned"); 47 | ok(is_iv($list->[0]{one}), "ivok") or Dump($list->[0]{one}); 48 | 49 | $dbh->disconnect; 50 | 51 | -------------------------------------------------------------------------------- /examples/inserting_longs.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use DBI; 7 | 8 | my $db = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' ); 9 | 10 | my $table = 'TABLE'; 11 | my %clauses; 12 | my %attrib; 13 | my @types; 14 | my $longrawtype; 15 | my @row; 16 | 17 | # Assuming the existence of @row and an associative array (%clauses) containing the 18 | # column names and placeholders, and an array @types containing column types ... 19 | 20 | my $ih = $db->prepare("INSERT INTO $table ($clauses{names}) 21 | VALUES ($clauses{places})") 22 | or die "prepare insert into $table: " . $db->errstr; 23 | 24 | $attrib{'ora_type'} = $longrawtype; # $longrawtype == 24 25 | 26 | ##-- bind the parameter for each of the columns 27 | for my $i ( 0..$#types ) { 28 | 29 | ##-- long raw values must have their type attribute explicitly specified 30 | if ($types[$i] == $longrawtype) { 31 | $ih->bind_param($i+1, $row[$i], \%attrib) 32 | || die "binding placeholder for LONG RAW " . $db->errstr; 33 | } 34 | ##-- other values work OK with the default attributes 35 | else { 36 | $ih->bind_param($i+1, $row[$i]) 37 | || die "binding placeholder" . $db->errstr; 38 | } 39 | } 40 | 41 | $ih->execute || die "execute INSERT into $table: " . $db->errstr; 42 | 43 | 44 | -------------------------------------------------------------------------------- /examples/oradump.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # Dump the contents of an Oracle table into a set of insert statements. 4 | # Quoting is controlled by the datatypes of each column. (new with DBI) 5 | # 6 | # Usage: oradump 7 | # 8 | # Author: Kevin Stock (original oraperl script) 9 | # Date: 28th February 1992 10 | # 11 | 12 | use DBI; 13 | 14 | use strict; 15 | 16 | # Set trace level if '-# trace_level' option is given 17 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 18 | 19 | die "syntax: $0 base user pass table\n" if 4 > @ARGV; 20 | my ( $base, $user, $pass, $table ) = @ARGV; 21 | 22 | # Connect to database 23 | my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass, 24 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 25 | or die $DBI::errstr; 26 | 27 | my $sth = $dbh->prepare( "SELECT * FROM $table"); 28 | $sth->execute; 29 | my @name = @{$sth->{NAME}}; 30 | my @type = @{$sth->{TYPE}}; 31 | my $lead = "INSERT INTO $table ( " . join( ', ', @name ) . " ) VALUES ( "; 32 | my ( @data, $i ); 33 | $sth->bind_columns( {}, \( @data[0 .. $#name] ) ); 34 | while ( $sth->fetch ) { 35 | $i = 0; 36 | print $lead . join( ", ", map { $dbh->quote( $_, $type[$i++] ) } @data ) . 37 | # print $lead . join( ", ", map { $dbh->quote( $_ ) } @data ) . # for old DBI 38 | " );\n"; 39 | } 40 | 41 | $sth->finish; 42 | $dbh->disconnect; 43 | -------------------------------------------------------------------------------- /err_unsorted/err_ora9ir2oci.msg: -------------------------------------------------------------------------------- 1 | http://otn.oracle.com/tech/oci/htdocs/oci9ir2_new_features 2 | 3 | OCI Session Pooling 4 | Session Pooling is a new feature in Oracle 9i Database Release 2. 5 | An application can now maintain a pool of sessions and use a session 6 | from the pool when it needs it. This saves the time consuming process 7 | of initiating a connection and authentication every time the process 8 | needs a new session. Session Pooling is useful, especially when a 9 | large number of stateless sessions are required for a very short 10 | time. In a web scenario, where many users are connected for a short 11 | time, and the primary operation is accessing data, it is a costly 12 | operation to start up a new session every time. In such a scenario, 13 | session pooling could boost up the performance. 14 | 15 | OCI Statement caching 16 | Client-side statement caching is also introduced in Oracle9i Database 17 | Release 2. This feature can be enabled at the time of session 18 | creation. It allows users to have a cache of statements per session. 19 | On the server, this means having cursors that ready to be used, 20 | without the need to parse the statements again, and thus improving 21 | performance significantly. With this feature enabled, applications 22 | do not have to keep a track of the statements themselves, as the 23 | OCI layer will do it for them. In addition, a tagging feature is 24 | provided, which users can use as a key to save and search for 25 | statements. 26 | 27 | 28 | -------------------------------------------------------------------------------- /examples/ex.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # Short example using bind_columns() to list a table's values 3 | 4 | use DBI; 5 | 6 | use strict; 7 | 8 | # Set trace level if '-# trace_level' option is given 9 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 10 | 11 | die "syntax: $0 [-# trace] base user pass [max]" if 3 > @ARGV; 12 | my ( $inst, $user, $pass, $max ) = @ARGV; 13 | $max = 20 if ! $max || 0 > $max; 14 | 15 | my ( $name, $id, $created ); 16 | format STDOUT_TOP = 17 | Name ID Created 18 | ============================== ========= ========= 19 | . 20 | 21 | format STDOUT = 22 | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @<<<<<<<< 23 | $name, $id, $created 24 | . 25 | 26 | # Connect to database 27 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 28 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 29 | or die $DBI::errstr; 30 | 31 | my $sth = $dbh->prepare( 32 | "SELECT username, user_id, created FROM all_users ORDER BY username" ); 33 | $sth->execute; 34 | 35 | my $nfields = $sth->{NUM_OF_FIELDS}; 36 | print "Query will return $nfields fields\n\n"; 37 | 38 | $sth->bind_columns( {}, \( $name, $id, $created ) ); 39 | while ( $sth->fetch ) { 40 | last if ! --$max; 41 | # mark any NULL fields found 42 | foreach ( $name, $id, $created ) { $_ = 'NULL' if ! defined; } 43 | write; 44 | } 45 | 46 | $sth->finish; 47 | $dbh->disconnect; 48 | -------------------------------------------------------------------------------- /examples/japh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # This is an example of how we could code a JAPH using DBI and DBD::Oracle. 3 | # 4 | # Original oraperl script by Kevin Stock 5 | # Date: 1st December 1992 6 | 7 | use DBI; 8 | 9 | use strict; 10 | 11 | # Set trace level if '-# trace_level' option is given 12 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 13 | 14 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 15 | my ( $inst, $user, $pass ) = @ARGV; 16 | 17 | # Connect to database 18 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 19 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 20 | or die $DBI::errstr; 21 | 22 | # Create the sample table 23 | $dbh->do( "CREATE TABLE japh ( word CHAR(7), posn NUMBER(1) )" ); 24 | 25 | # Loop to insert data into the table 26 | my $sth = $dbh->prepare( "INSERT INTO japh VALUES ( ?, ? )" ); 27 | while ( ) { 28 | chomp; 29 | $sth->execute( split ':', $_ ); 30 | } 31 | 32 | # Now retrieve the data, printing it word by word 33 | $sth = $dbh->prepare( "SELECT word FROM japh ORDER BY posn" ); 34 | $sth->execute; 35 | my $word; 36 | $sth->bind_columns( {}, \$word ); 37 | $sth->{ChopBlanks} = 1; # Wouldn't you rather use VARCHAR2 instead of CHAR? 38 | while ( $sth->fetch ) { 39 | print " $word"; 40 | } 41 | $sth->finish; 42 | print "\n"; 43 | 44 | # delete the table 45 | $dbh->do( 'DROP TABLE japh' ); 46 | $dbh->disconnect; 47 | 48 | __END__ 49 | DBI:3 50 | another:2 51 | hacker:4 52 | just:1 53 | -------------------------------------------------------------------------------- /t/23wide_db_al32utf8.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | 18 | plan skip_all => "Unable to run unicode test, perl version is less than 5.6" 19 | unless ( $] >= 5.006 ); 20 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 21 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 22 | 23 | set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); 24 | $dbh = db_handle(); 25 | 26 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 27 | plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; 28 | # testing utf8 with char columns (wide mode database) 29 | 30 | my $tdata = test_data( 'wide_char' ); 31 | my $testcount = 0 #create table 32 | + insert_test_count( $tdata ) 33 | + select_test_count( $tdata ) * 1; 34 | ; 35 | 36 | plan tests => $testcount; 37 | show_test_data( $tdata ,0 ); 38 | drop_table($dbh); 39 | create_table( $dbh, $tdata ); 40 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 41 | dump_table( $dbh ,'ch' ,'descr' ); 42 | select_rows( $dbh, $tdata ); 43 | } 44 | 45 | END { 46 | eval { 47 | local $dbh->{PrintError} = 0; 48 | drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 49 | }; 50 | } 51 | 52 | -------------------------------------------------------------------------------- /t/23wide_db_8bit.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | 18 | plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); 19 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 20 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 21 | 22 | set_nls_lang_charset( 'WE8MSWIN1252' ,1 ); 23 | $dbh = db_handle(); 24 | 25 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 26 | plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; 27 | print "testing utf8 with char columns (wide mode database)\n" ; 28 | 29 | my $tdata = test_data( 'narrow_char' ); 30 | my $testcount = 0 #create table 31 | + insert_test_count( $tdata ) 32 | + select_test_count( $tdata ) * 1; 33 | ; 34 | 35 | plan tests => $testcount; 36 | show_test_data( $tdata ,0 ); 37 | drop_table($dbh); 38 | create_table( $dbh, $tdata ); 39 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 40 | dump_table( $dbh ,'ch' ,'descr' ); 41 | select_rows( $dbh, $tdata ); 42 | } 43 | 44 | END { 45 | local($?, $!); 46 | eval { 47 | local $dbh->{PrintError} = 0 if $dbh; 48 | drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 49 | }; 50 | } 51 | 52 | -------------------------------------------------------------------------------- /t/22nchar_al32utf8.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | 18 | plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); 19 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 20 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 21 | 22 | set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); 23 | $dbh = db_handle(); 24 | 25 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 26 | plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; 27 | print "testing utf8 with nchar columns\n" ; 28 | 29 | show_db_charsets( $dbh ); 30 | my $tdata = test_data( 'wide_nchar' ); 31 | my $testcount = 0 #create table 32 | + insert_test_count( $tdata ) 33 | + select_test_count( $tdata ) * 1; 34 | ; 35 | 36 | plan tests => $testcount; 37 | show_test_data( $tdata ,0 ); 38 | drop_table($dbh); 39 | create_table( $dbh, $tdata ); 40 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 41 | dump_table( $dbh ,'nch' ,'descr' ); 42 | select_rows( $dbh, $tdata ); 43 | } 44 | 45 | END { 46 | eval { 47 | local $dbh->{PrintError} = 0; 48 | drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 49 | }; 50 | } 51 | 52 | -------------------------------------------------------------------------------- /examples/commit.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # commit.pl 4 | # 5 | # Simple example of using commit and rollback. 6 | 7 | use DBI; 8 | 9 | use strict; 10 | 11 | # Set trace level if '-# trace_level' option is given 12 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 13 | 14 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 15 | my ( $inst, $user, $pass ) = @ARGV; 16 | 17 | # Connect to database 18 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 19 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 20 | or die $DBI::errstr; 21 | 22 | # Create the table to hold prime numbers 23 | print "Creating table\n"; 24 | eval { $dbh->do( 'CREATE TABLE primes ( prime NUMBER )' ); }; 25 | warn $@ if $@; 26 | 27 | print "Loading table"; 28 | my $sth = $dbh->prepare( 'INSERT INTO primes VALUES ( ? )' ); 29 | while ( ) { 30 | chomp; 31 | print " $_"; 32 | $sth->execute( $_ ); 33 | print " commit (", $dbh->commit, ")" if 11 == $_; 34 | } 35 | print "\n"; 36 | 37 | my $prime; 38 | print "Reading table for the first time\n"; 39 | $sth = $dbh->prepare( 'SELECT prime FROM primes ORDER BY prime' ); 40 | $sth->execute; 41 | $sth->bind_columns( {}, \$prime ); 42 | while ( $sth->fetch ) { 43 | print " $prime"; 44 | } 45 | $sth->finish; 46 | print "\n"; 47 | 48 | print "rollback (", $dbh->rollback, ")\n"; 49 | 50 | print "Reading table for the second time.\n"; 51 | $sth->execute; 52 | $sth->bind_columns( {}, \$prime ); 53 | while ( $sth->fetch ) { 54 | print " $prime"; 55 | } 56 | $sth->finish; 57 | print "\n"; 58 | 59 | $dbh->do( 'DROP TABLE primes' ); 60 | print "Table Dropped\n"; 61 | $dbh->disconnect; 62 | __END__ 63 | 2 64 | 3 65 | 5 66 | 7 67 | 11 68 | 13 69 | 17 70 | 19 71 | 23 72 | 29 73 | -------------------------------------------------------------------------------- /t/22nchar_utf8.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | 18 | plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); 19 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 20 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 21 | 22 | set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8' ,1 ); 23 | $dbh = db_handle(); 24 | 25 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 26 | plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; 27 | 28 | # testing utf8 with nchar columns 29 | 30 | show_db_charsets( $dbh ); 31 | my $tdata = test_data( 'wide_nchar' ); 32 | 33 | if ( $dbh->ora_can_unicode & 1 ) { 34 | push( @{$tdata->{rows}} ,extra_wide_rows() ) ; 35 | # added 2 rows with extra wide chars to test data 36 | } 37 | 38 | my $testcount = 0 #create table 39 | + insert_test_count( $tdata ) 40 | + select_test_count( $tdata ) * 1; 41 | ; 42 | 43 | plan tests => $testcount; 44 | show_test_data( $tdata ,0 ); 45 | drop_table($dbh); 46 | create_table( $dbh, $tdata ); 47 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 48 | dump_table( $dbh ,'nch' ,'descr' ); 49 | select_rows( $dbh, $tdata ); 50 | } 51 | 52 | END { 53 | eval { 54 | local $dbh->{PrintError} = 0; 55 | drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 56 | }; 57 | } 58 | 59 | -------------------------------------------------------------------------------- /t/15nls.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use DBI; 6 | use Test::More; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | my $testcount = 9; 12 | 13 | $| = 1; 14 | 15 | my $dsn = oracle_test_dsn(); 16 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 17 | 18 | my $dbh = DBI->connect($dsn, $dbuser, '',{ 19 | PrintError => 0, 20 | }); 21 | if ($dbh) { 22 | plan tests => $testcount; 23 | } else { 24 | plan skip_all => "Unable to connect to Oracle"; 25 | } 26 | 27 | my ($nls_parameters_before, $nls_parameters_after); 28 | my $old_date_format = 'HH24:MI:SS DD/MM/YYYY'; 29 | my $new_date_format = 'YYYYMMDDHH24MISS'; 30 | 31 | ok($dbh->do("alter session set nls_date_format='$old_date_format'"), 'set date format'); 32 | 33 | like($dbh->ora_can_unicode, qr/^[0123]/, 'ora_can_unicode'); 34 | 35 | ok($nls_parameters_before = $dbh->ora_nls_parameters, 'fetch ora_nls_parameters'); 36 | is(ref($nls_parameters_before), 'HASH', 'check ora_nls_parameters returned hashref'); 37 | is($nls_parameters_before->{'NLS_DATE_FORMAT'}, $old_date_format, 'check returned nls_date_format'); 38 | 39 | ok($dbh->do("alter session set nls_date_format='$new_date_format'"), 'alter date format'); 40 | ok(eq_hash($nls_parameters_before, $dbh->ora_nls_parameters), 'check ora_nls_parameters caches old values'); 41 | 42 | $nls_parameters_before->{NLS_DATE_FORMAT} = 'foo'; 43 | isnt($nls_parameters_before->{NLS_DATE_FORMAT}, 44 | $dbh->ora_nls_parameters->{NLS_DATE_FORMAT}, 'check ora_nls_parameters returns a copy'); 45 | 46 | is($dbh->ora_nls_parameters(1)->{'NLS_DATE_FORMAT'}, $new_date_format, 'refetch and check new nls_date_format value'); 47 | 48 | __END__ 49 | -------------------------------------------------------------------------------- /t/12impdata.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | $| = 1; 3 | 4 | ## ---------------------------------------------------------------------------- 5 | ## 12imptdata.t 6 | ## By Jeffrey Klein, 7 | ## ---------------------------------------------------------------------------- 8 | 9 | use strict; 10 | use DBI; 11 | use Config qw(%Config); 12 | # must be done before Test::More - see Threads in Test::More pod 13 | BEGIN { eval "use threads; use threads::shared;" } 14 | my $use_threads_err = $@; 15 | use Test::More; 16 | 17 | BEGIN { 18 | if ($DBI::VERSION <= 1.601){ 19 | plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later."; 20 | } 21 | die $use_threads_err if $use_threads_err; # need threads 22 | } 23 | 24 | unshift @INC, 't'; 25 | require 'nchar_test_lib.pl'; 26 | 27 | my $dsn = oracle_test_dsn(); 28 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 29 | my $dbh = DBI->connect( $dsn, $dbuser, '', { 30 | PrintError => 0, 31 | }); 32 | 33 | if ($dbh) { 34 | plan tests => 7; 35 | } else { 36 | plan skip_all => "Unable to connect to Oracle"; 37 | } 38 | my $drh = $dbh->{Driver}; 39 | my ($sess_1) = $dbh->selectrow_array("select userenv('sessionid') from dual"); 40 | 41 | is $drh->{Kids}, 1, "1 kid"; 42 | is $drh->{ActiveKids}, 1, "1 active kid"; 43 | 44 | my $imp_data = $dbh->take_imp_data; 45 | is $drh->{Kids}, 0, "no kids"; 46 | is $drh->{ActiveKids}, 0, "no active kids"; 47 | 48 | $dbh = DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } ); 49 | my ($sess_2) = $dbh->selectrow_array("select userenv('sessionid') from dual"); 50 | is $sess_1, $sess_2, "got same session"; 51 | 52 | is $drh->{Kids}, 1, "1 kid"; 53 | is $drh->{ActiveKids}, 1, "1 active kid"; 54 | 55 | __END__ 56 | -------------------------------------------------------------------------------- /t/23wide_db.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | use DBI qw(:sql_types); 9 | use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | 18 | plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); 19 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 20 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 21 | 22 | #! #force Ncharset to NON UTF8! we are testing a wide database where someone 23 | #! #perversely sets nchar to non utf8, and nls_lang to utf8.... 24 | set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); 25 | #! #set_nls_nchar( 'WE8ISO8859P1' ,1 ); #it breaks and it is stupid to do this... doc it XXX 26 | $dbh = db_handle(); 27 | 28 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 29 | plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; 30 | 31 | # testing utf8 with char columns (wide mode database) 32 | 33 | my $tdata = test_data( 'wide_char' ); 34 | my $testcount = 0 #create table 35 | + insert_test_count( $tdata ) 36 | + select_test_count( $tdata ) * 1; 37 | ; 38 | 39 | plan tests => $testcount; 40 | show_test_data( $tdata ,0 ); 41 | drop_table($dbh); 42 | create_table( $dbh, $tdata ); 43 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 44 | dump_table( $dbh ,'ch' ,'descr' ); 45 | select_rows( $dbh, $tdata ); 46 | } 47 | 48 | END { 49 | eval { 50 | local $dbh->{PrintError} = 0; 51 | drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 52 | }; 53 | } 54 | 55 | -------------------------------------------------------------------------------- /t/26exe_array.t: -------------------------------------------------------------------------------- 1 | # $Id$ 2 | # Completely new test for DBD::Oracle which came from DBD::ODBC 3 | # Author: Martin J. Evans 4 | # 5 | # loads of execute_array and execute_for_fetch tests using DBI's methods 6 | # 7 | use Test::More; 8 | use strict; 9 | use Data::Dumper; 10 | require 'nchar_test_lib.pl'; 11 | 12 | use lib 't/lib', 't'; 13 | 14 | $| = 1; 15 | 16 | my $has_test_nowarnings = eval "require Test::NoWarnings; 1"; 17 | 18 | use DBI qw(:sql_types); 19 | use ExecuteArray; 20 | 21 | 22 | my $dsn = oracle_test_dsn(); 23 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 24 | $ENV{NLS_NCHAR} = "US7ASCII"; 25 | $ENV{NLS_LANG} = "AMERICAN"; 26 | 27 | my $dbh = eval { 28 | DBI->connect($dsn, $dbuser, '', {PrintError => 0}) 29 | } or plan skip_all => "Unable to connect to Oracle"; 30 | 31 | my $ea = ExecuteArray->new($dbh, 1); # set odbc_disable_array_operations 32 | $dbh = $ea->dbh; 33 | 34 | $ea->drop_table($dbh); 35 | ok($ea->create_table($dbh), "create test table") or exit 1; 36 | 37 | $ea->simple($dbh, {array_context => 1, raise => 1}); 38 | $ea->simple($dbh, {array_context => 0, raise => 1}); 39 | $ea->error($dbh, {array_context => 1, raise => 1}); 40 | $ea->error($dbh, {array_context => 0, raise => 1}); 41 | $ea->error($dbh, {array_context => 1, raise => 0}); 42 | $ea->error($dbh, {array_context => 0, raise => 0}); 43 | 44 | $ea->row_wise($dbh, {array_context => 1, raise => 1}); 45 | 46 | $ea->update($dbh, {array_context => 1, raise => 1}); 47 | 48 | for my $raise ( 0..1 ) { 49 | for my $context ( 0..1 ) { 50 | $ea->error($dbh, { 51 | array_context => $context, 52 | raise => $raise, 53 | notuplestatus => 1 54 | }); 55 | } 56 | } 57 | 58 | if ($dbh && $ea) { 59 | $ea->drop_table($dbh); 60 | $dbh->disconnect(); 61 | } 62 | 63 | Test::NoWarnings::had_no_warnings() if $has_test_nowarnings; 64 | 65 | done_testing; 66 | -------------------------------------------------------------------------------- /examples/README: -------------------------------------------------------------------------------- 1 | This directory contains a few sample DBI/DBD::Oracle scripts. Some are 2 | genuinely useful while others are just demonstrations of different things. 3 | They are adapted from the Oraperl example scripts in ../Oraperl.ex/ to 4 | show how to do the same things in Perl 5 and DBI. 5 | 6 | $dbh->{RaiseError} is set to 1 in all scripts for automatic error checking. 7 | 8 | bind.pl Demonstrates how execute() and fetchrow_array() may be 9 | combined to make a simple table lookup program with placeholders. 10 | 11 | commit.pl Demonstrates the use of commit() and rollback(). 12 | 13 | curref.pl Demonstrates how to use a cursor bind variable. 14 | 15 | ex.pl Reads data from a table and prints it using a format. 16 | Also illustrates how to recognise NULL fields and bind_columns 17 | with known column names. 18 | 19 | japh Just another Perl hacker, written for DBI. 20 | This is no one-liner, but it demonstrates a few things. 21 | 22 | mktable.pl Creates a table, puts some data into it, drops it. 23 | Demonstrates do(), placeholders, inserting and reading NULL values, 24 | and bind_columns() with known columns. 25 | 26 | oradump.pl Dumps an Oracle table as a set of INSERT statements. 27 | Demonstrates the use of $sth->{TYPE}, $dbh->quote(), 28 | and bind_columns() with unknown column names. 29 | 30 | proc.pl Demonstrates how to get values into and out of stored procedures 31 | and how to receive result sets. 32 | 33 | sql Demonstrates the use of $sth->{NUM_OF_FIELDS}, $sth->{NAME}, 34 | $sth->{PRECISION}, and bind_columns() with unknown column names. 35 | 36 | tabinfo.pl Displays the structure of the specified table. 37 | Demonstrates the use of $sth->{NAME}, $sth->{PRECISION}, 38 | $sth->{TYPE}, and type_info_all(). 39 | -------------------------------------------------------------------------------- /t/rt74753-utf8-encoded.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use DBI; 9 | use Encode; 10 | 11 | unshift @INC ,'t'; 12 | require 'nchar_test_lib.pl'; 13 | 14 | my $dsn = oracle_test_dsn(); 15 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 16 | 17 | $ENV{NLS_LANG} = 'AMERICAN_AMERICA.UTF8'; 18 | $ENV{NLS_NCHAR} = 'UTF8'; 19 | 20 | my $dbh = DBI->connect( $dsn, $dbuser, '', { 21 | PrintError => 0, AutoCommit => 0 22 | }); 23 | 24 | plan skip_all => "unable to connect to Oracle database" if not $dbh; 25 | plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh); 26 | 27 | plan tests => 3; 28 | 29 | $dbh->do(q(alter session set nls_territory = 'GERMANY')); 30 | 31 | my $sth = $dbh->prepare(<<"END_SQL"); 32 | SELECT ltrim(rtrim(to_char(0, 'L'))) FROM dual 33 | END_SQL 34 | 35 | $sth->execute; 36 | 37 | my ($val); 38 | $sth->bind_columns( \($val) ); 39 | 40 | $sth->fetch; 41 | 42 | is Encode::is_utf8($val) => 1, "utf8 encoded"; 43 | 44 | $sth->finish; 45 | 46 | $val = undef; 47 | 48 | $sth = $dbh->prepare(<<'END_SQL'); 49 | declare 50 | l_ret varchar2(10); 51 | begin 52 | select ltrim(rtrim(to_char(0, 'L'))) 53 | into l_ret 54 | from dual; 55 | -- 56 | :ret := l_ret; 57 | end; 58 | END_SQL 59 | 60 | $sth->bind_param_inout(':ret', \$val, 100); 61 | $sth->execute; 62 | 63 | is Encode::is_utf8($val) => 1, "utf8 encoded"; 64 | 65 | $sth = $dbh->prepare(<<'END_SQL'); 66 | declare 67 | l_ret varchar2(10); 68 | begin 69 | select ltrim(rtrim(to_char(0, 'L'))) 70 | || ltrim(rtrim(to_char(0, 'L'))) 71 | || ltrim(rtrim(to_char(0, 'L'))) 72 | into l_ret 73 | from dual; 74 | -- 75 | :ret := l_ret; 76 | end; 77 | END_SQL 78 | 79 | $val = undef; 80 | 81 | # WARNING: does *not* truncate. DBD::Oracle doesn't heed the 3rd parameter 82 | $sth->bind_param_inout(':ret', \$val, 1); 83 | $sth->execute; 84 | 85 | is Encode::is_utf8($val) => 1, "truncated, yet utf8 encoded"; 86 | 87 | $dbh->disconnect; 88 | 89 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | CONTRIBUTING.mkd 2 | CONTRIBUTORS 3 | Changes 4 | INSTALL 5 | LICENSE 6 | MANIFEST 7 | META.json 8 | META.yml 9 | Makefile.PL 10 | Oracle.h 11 | Oracle.xs 12 | README 13 | README.help.txt 14 | README.mkdn 15 | Todo 16 | dbdimp.c 17 | dbdimp.h 18 | dbivport.h 19 | examples/README 20 | examples/bind.pl 21 | examples/commit.pl 22 | examples/curref.pl 23 | examples/ex.pl 24 | examples/inserting_longs.pl 25 | examples/japh 26 | examples/mktable.pl 27 | examples/ora_explain.pl 28 | examples/oradump.pl 29 | examples/proc.pl 30 | examples/read_long_via_blob_read.pl 31 | examples/sql 32 | examples/tabinfo.pl 33 | hints/dgux.pl 34 | hints/macos_bundle.syms 35 | hints/macos_lib.syms 36 | hints/macos_syms.pl 37 | hints/svr4.pl 38 | lib/DBD/Oracle.pm 39 | lib/DBD/Oracle/GetInfo.pm 40 | lib/DBD/Oracle/Object.pm 41 | lib/DBD/Oracle/Troubleshooting.pod 42 | lib/DBD/Oracle/Troubleshooting/Aix.pod 43 | lib/DBD/Oracle/Troubleshooting/Cygwin.pod 44 | lib/DBD/Oracle/Troubleshooting/Hpux.pod 45 | lib/DBD/Oracle/Troubleshooting/Linux.pod 46 | lib/DBD/Oracle/Troubleshooting/Macos.pod 47 | lib/DBD/Oracle/Troubleshooting/Sun.pod 48 | lib/DBD/Oracle/Troubleshooting/Vms.pod 49 | lib/DBD/Oracle/Troubleshooting/Win32.pod 50 | lib/DBD/Oracle/Troubleshooting/Win64.pod 51 | mkta.pl 52 | oci.def 53 | oci8.c 54 | ocitrace.h 55 | t/000-report-versions-tiny.t 56 | t/00versions.t 57 | t/01base.t 58 | t/10general.t 59 | t/12impdata.t 60 | t/14threads.t 61 | t/15nls.t 62 | t/20select.t 63 | t/21nchar.t 64 | t/22nchar_al32utf8.t 65 | t/22nchar_utf8.t 66 | t/23wide_db.t 67 | t/23wide_db_8bit.t 68 | t/23wide_db_al32utf8.t 69 | t/24implicit_utf8.t 70 | t/25plsql.t 71 | t/26exe_array.t 72 | t/28array_bind.t 73 | t/30long.t 74 | t/31lob.t 75 | t/31lob_extended.t 76 | t/32xmltype.t 77 | t/34pres_lobs.t 78 | t/36lob_leak.t 79 | t/38taf.t 80 | t/39attr.t 81 | t/40ph_type.t 82 | t/50cursor.t 83 | t/51scroll.t 84 | t/55nested.t 85 | t/56embbeded.t 86 | t/58object.t 87 | t/60reauth.t 88 | t/70meta.t 89 | t/80ora_charset.t 90 | t/lib/ExecuteArray.pm 91 | t/nchar_test_lib.pl 92 | t/rt13865.t 93 | t/rt74753-utf8-encoded.t 94 | t/rt85886.t 95 | typemap 96 | -------------------------------------------------------------------------------- /err_bind/err_bindclobleak.msg: -------------------------------------------------------------------------------- 1 | From PGWeiss@arity.com Thu Mar 9 09:51:45 2000 2 | Return-Path: 3 | Received: from oink by toad.ig.co.uk (SMI-8.6/SMI-SVR4) 4 | id JAA14948; Thu, 9 Mar 2000 09:51:43 GMT 5 | Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) 6 | id <27566-0@oink>; Mon, 9 Mar 1970 10:51:10 +0100 7 | Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk 8 | id 952595299:20:10439:68; Thu, 09 Mar 2000 09:48:19 GMT 9 | Received: from image.arity.com ([140.239.104.130]) by punt-2.mail.demon.net 10 | id aa2010598; 9 Mar 2000 9:47 GMT 11 | Received: by image.arity.com with Internet Mail Service (5.5.2650.21) 12 | id ; Thu, 9 Mar 2000 04:51:44 -0500 13 | Message-ID: 14 | From: "Paul G. Weiss" 15 | To: Perl-Win32-Database Mailing List , 16 | "'Tim Bunce'" 17 | Subject: Another CLOB related DBD::Oracle bug 18 | Date: Thu, 9 Mar 2000 04:51:41 -0500 19 | MIME-Version: 1.0 20 | X-Mailer: Internet Mail Service (5.5.2650.21) 21 | Content-Type: text/plain; charset="iso-8859-1" 22 | Status: RO 23 | Content-Length: 689 24 | Lines: 32 25 | 26 | Binding a parameter to type ORA_CLOB causes a leak. 27 | Consider: 28 | 29 | for (1..10000) 30 | { 31 | for (1..100) 32 | { 33 | my $sth = $db->prepare('update item set descr = ? where id = ?'); 34 | if ($leak) 35 | { 36 | $sth->bind_param(1, $descr, {ora_type => ORA_CLOB, 37 | ora_field=>'DESCR'}); 38 | $sth->bind_param(2, 12); 39 | $sth->execute; 40 | } 41 | else 42 | { 43 | $sth->execute($descr,12); 44 | } 45 | } 46 | sleep 1; 47 | } 48 | 49 | 50 | With $leak set to 1, i.e. binding the parameters explicitly the 51 | program leaks. With $leak set to 0 it does not (but then I can't 52 | set descr to anything greater than 4K nor can I set it to the 53 | empty string). 54 | 55 | Is there a patch? 56 | 57 | -P 58 | 59 | -------------------------------------------------------------------------------- /examples/tabinfo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # tabinfo 4 | # 5 | # Usage: tabinfo base user password table 6 | # 7 | # Displays the structure of the specified table. 8 | # Note that the field names are restricted to the length of the field. 9 | # This is mainly to show the use of &ora_lengths, &ora_titles and &ora_types. 10 | # 11 | use DBI; 12 | 13 | use strict; 14 | 15 | # Set trace level if '-# trace_level' option is given 16 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 17 | 18 | # read the compulsory arguments 19 | die "syntax: $0 base user password table ...\n" if 4 > @ARGV; 20 | my ( $base, $user, $pass, @table ) = @ARGV; 21 | 22 | my ( $table, @name, @length, @type, %type_name, $i ); 23 | format STDOUT_TOP = 24 | Structure of @<<<<<<<<<<<<<<<<<<<<<<< 25 | $table 26 | 27 | Field name | Length | Type | Type Name 28 | ----------------------------------------------+--------+------+----------------- 29 | . 30 | 31 | format STDOUT = 32 | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>>>> | @>>> | @<<<<<<<<<<<<<<< 33 | $name[$i], $length[$i], $type[$i], $type_name{$type[$i]} 34 | . 35 | 36 | # Connect to database 37 | my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass, 38 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 39 | or die $DBI::errstr; 40 | 41 | # Associate type names to types 42 | { 43 | my $type_info_all = $dbh->type_info_all; 44 | my $iname = $type_info_all->[0]{TYPE_NAME}; 45 | my $itype = $type_info_all->[0]{DATA_TYPE}; 46 | my $rtype; 47 | shift @$type_info_all; 48 | foreach $rtype ( @$type_info_all ) { 49 | $type_name{$$rtype[$itype]} = $$rtype[$iname] 50 | if ! exists $type_name{$$rtype[$itype]}; 51 | } 52 | } 53 | 54 | my $sth; 55 | foreach $table ( @table ) { 56 | $sth = $dbh->prepare( "SELECT * FROM $table WHERE 1 = 2"); 57 | @name = @{$sth->{NAME}}; 58 | @length = @{$sth->{PRECISION}}; 59 | @type = @{$sth->{TYPE}}; 60 | 61 | foreach $i ( 0 .. $#name ) { 62 | write; 63 | } 64 | $- = 0; 65 | $sth->finish; 66 | } 67 | 68 | $dbh->disconnect; 69 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Troubleshooting/Cygwin.pod: -------------------------------------------------------------------------------- 1 | #PODNAME: DBD::Oracle::Troubleshooting::Cygwin 2 | #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Cygwin 3 | 4 | =head1 General Info 5 | 6 | Makefile.PL should find and make use of OCI include 7 | files, but you have to build an import library for 8 | OCI.DLL and put it somewhere in library search path. 9 | one of the possible ways to do this is issuing command 10 | 11 | dlltool --input-def oci.def --output-lib liboci.a 12 | 13 | in the directory where you unpacked DBD::Oracle distribution 14 | archive. this will create import library for Oracle 8.0.4. 15 | 16 | Note: make clean removes '*.a' files, so put a copy in a safe place. 17 | 18 | =head1 Compiling DBD::Oracle using the Oracle Instant Client, Cygwin Perl and gcc 19 | 20 | =over 21 | 22 | =item 1 23 | 24 | Download these two packages from Oracle's Instant Client for 25 | Windows site 26 | (http://www.oracle.com/technology/software/tech/oci/instantclient/htdocs/winsoft.html): 27 | 28 | Instant Client Package - Basic: All files required to run OCI, 29 | OCCI, and JDBC-OCI applications 30 | 31 | Instant Client Package - SDK: Additional header files and an 32 | example makefile for developing Oracle applications with Instant Client 33 | 34 | (I usually just use the latest version of the client) 35 | 36 | =item 2 37 | 38 | Unpack both into C:\oracle\instantclient_11_1 39 | 40 | =item 3 41 | 42 | Download and unpack DBD::Oracle from CPAN to some place with no 43 | spaces in the path (I used /tmp/DBD-Oracle) and cd to it. 44 | 45 | =item 4 46 | 47 | Set up some environment variables (it didn't work until I got the 48 | DSN right): 49 | 50 | ORACLE_DSN=DBI:Oracle:host=oraclehost;sid=oracledb1 51 | ORACLE_USERID=username/password 52 | 53 | =item 5 54 | 55 | perl Makefile.PL 56 | make 57 | make test 58 | make install 59 | 60 | =back 61 | 62 | Note, the TNS Names stuff doesn't always seem to work with the instant 63 | client so Perl scripts need to explicitly use host/sid in the DSN, like 64 | this: 65 | 66 | my $dbh = DBI->connect('dbi:Oracle:host=oraclehost;sid=oracledb1', 67 | 'username', 'password'); 68 | 69 | -------------------------------------------------------------------------------- /dbivport.h: -------------------------------------------------------------------------------- 1 | /* dbivport.h 2 | 3 | Provides macros that enable greater portability between DBI versions. 4 | 5 | This file should be *copied* and included in driver distributions 6 | and #included into the source, after #include DBIXS.h 7 | 8 | New driver releases should include an updated copy of dbivport.h 9 | from the most recent DBI release. 10 | */ 11 | 12 | #ifndef DBI_VPORT_H 13 | #define DBI_VPORT_H 14 | 15 | #ifndef DBIh_SET_ERR_CHAR 16 | /* Emulate DBIh_SET_ERR_CHAR 17 | Only uses the err_i, errstr and state parameters. 18 | */ 19 | #define DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method) \ 20 | sv_setiv(DBIc_ERR(imp_xxh), err_i); \ 21 | (state) ? (void)sv_setpv(DBIc_STATE(imp_xxh), state) : (void)SvOK_off(DBIc_STATE(imp_xxh)); \ 22 | sv_setpv(DBIc_ERRSTR(imp_xxh), errstr) 23 | #endif 24 | 25 | #ifndef DBIcf_Executed 26 | #define DBIcf_Executed 0x080000 27 | #endif 28 | 29 | #ifndef DBIc_TRACE_LEVEL_MASK 30 | #define DBIc_TRACE_LEVEL_MASK 0x0000000F 31 | #define DBIc_TRACE_FLAGS_MASK 0xFFFFFF00 32 | #define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug) 33 | #define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK) 34 | #define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK) 35 | /* DBIc_TRACE_MATCHES - true if s1 'matches' s2 (c.f. trace_msg()) 36 | DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp)) 37 | */ 38 | #define DBIc_TRACE_MATCHES(s1, s2) \ 39 | ( ((s1 & DBIc_TRACE_LEVEL_MASK) >= (s2 & DBIc_TRACE_LEVEL_MASK)) \ 40 | || ((s1 & DBIc_TRACE_FLAGS_MASK) & (s2 & DBIc_TRACE_FLAGS_MASK)) ) 41 | /* DBIc_TRACE - true if flags match & DBI level>=flaglevel, or if DBI level>level 42 | DBIc_TRACE(imp, 0, 0, 4) = if level >= 4 43 | DBIc_TRACE(imp, DBDtf_FOO, 2, 4) = if tracing DBDtf_FOO & level>=2 or level>=4 44 | DBIc_TRACE(imp, DBDtf_FOO, 2, 0) = as above but never trace just due to level 45 | */ 46 | #define DBIc_TRACE(imp, flags, flaglevel, level) \ 47 | ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \ 48 | || (level && DBIc_TRACE_LEVEL(imp) >= level) ) 49 | #endif 50 | 51 | 52 | #endif /* !DBI_VPORT_H */ 53 | -------------------------------------------------------------------------------- /t/21nchar.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | use DBI qw(:sql_types); 12 | use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR ); 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 ); 18 | 19 | $dbh = db_handle(); 20 | # $dbh->{PrintError} = 1; 21 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 22 | 23 | note("testing control and 8 bit chars:\n") ; 24 | note(" Database and client versions and character sets:\n"); 25 | show_db_charsets( $dbh); 26 | 27 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 28 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 29 | 30 | # get the database NCHARSET before we begin... if it is not UTF, then 31 | # use it as the client side ncharset, otherwise, use WE8ISO8859P1 32 | my $ncharset = $dbh->ora_nls_parameters()->{'NLS_NCHAR_CHARACTERSET'}; 33 | $dbh->disconnect(); # we want to start over with the ncharset we select 34 | undef $dbh; 35 | 36 | if ( $ncharset =~ m/UTF/i ) { 37 | $ncharset = 'WE8ISO8859P1' ; #WE8MSWIN1252 38 | } 39 | set_nls_nchar( $ncharset ,1 ); 40 | $dbh = db_handle(); 41 | 42 | my $tdata = test_data( 'narrow_nchar' ); 43 | my $testcount = 0 #create table 44 | + insert_test_count( $tdata ) 45 | + select_test_count( $tdata ) * 1; 46 | ; 47 | 48 | plan tests => $testcount ; 49 | show_test_data( $tdata ,0 ); 50 | 51 | drop_table($dbh); 52 | create_table( $dbh, $tdata ); 53 | insert_rows( $dbh, $tdata ,SQLCS_NCHAR); 54 | dump_table( $dbh ,'nch' ,'descr' ); 55 | select_rows( $dbh, $tdata ); 56 | # view_with_sqlplus(1,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW}; 57 | # view_with_sqlplus(0,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW}; 58 | } 59 | 60 | END { 61 | eval { 62 | local $dbh->{PrintError} = 0; 63 | drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 64 | }; 65 | } 66 | 67 | __END__ 68 | 69 | -------------------------------------------------------------------------------- /t/56embbeded.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | 3 | use DBI; 4 | use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR); 5 | use strict; 6 | 7 | use Test::More; 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | $| = 1; 12 | 13 | ## ---------------------------------------------------------------------------- 14 | ## 56embbeded.t 15 | ## By John Scoles, The Pythian Group 16 | ## ---------------------------------------------------------------------------- 17 | ## Just a few checks to see if I can select embedded objectes with Oracle::DBD 18 | ## Nothing fancy. 19 | ## ---------------------------------------------------------------------------- 20 | 21 | # create a database handle 22 | my $dsn = oracle_test_dsn(); 23 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 24 | my $dbh; 25 | eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, 26 | AutoCommit=>1, 27 | PrintError => 0 })}; 28 | if ($dbh) { 29 | plan tests => 4; 30 | } else { 31 | plan skip_all => "Unable to connect to Oracle"; 32 | } 33 | 34 | 35 | # check that our db handle is good 36 | isa_ok($dbh, "DBI::db"); 37 | 38 | my $table = "table_embed"; 39 | my $type = $table.'a_type'; 40 | 41 | #do not warn if already there 42 | eval { 43 | local $dbh->{PrintError} = 0; 44 | $dbh->do(qq{drop TABLE $table }); 45 | }; 46 | eval { 47 | local $dbh->{PrintError} = 0; 48 | $dbh->do(qq{drop TYPE $type }); 49 | }; 50 | $dbh->do(qq{CREATE or replace TYPE $type as varray(10) of varchar(30) }); 51 | 52 | $dbh->do(qq{ 53 | CREATE TABLE $table 54 | ( aa_type $type) 55 | }); 56 | 57 | $dbh->do("insert into $table values ($type('1','2','3','4','5'))"); 58 | 59 | 60 | 61 | # simple execute 62 | my $sth; 63 | ok ($sth = $dbh->prepare("select * from $table"), '... Prepare should return true'); 64 | my $problems; 65 | ok ($sth->execute(), '... Select should return true'); 66 | 67 | while (my ($a)=$sth->fetchrow()){ 68 | $problems= scalar(@$a); 69 | } 70 | 71 | cmp_ok(scalar($problems), '==',5, '... we should have 5 items'); 72 | 73 | 74 | $dbh->do("drop table $table"); 75 | 76 | $dbh->do("drop type $type"); 77 | 78 | $dbh->disconnect; 79 | 80 | 1; 81 | 82 | -------------------------------------------------------------------------------- /t/24implicit_utf8.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | #written by Lincoln A Baxter (lab@lincolnbaxter.com) 3 | 4 | use strict; 5 | #use warnings; 6 | use Test::More; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | use DBI qw(:sql_types); 12 | use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR ); 13 | 14 | my $dbh; 15 | $| = 1; 16 | SKIP: { 17 | plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 ); 18 | plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" 19 | if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; 20 | $dbh = db_handle(); # just to check connection and db NCHAR character set 21 | 22 | plan skip_all => "Unable to connect to Oracle" if not $dbh; 23 | plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; 24 | plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh); 25 | $dbh->disconnect(); 26 | 27 | # testing implicit csform (dbhimp.c sets csform implicitly) 28 | my $tdata = test_data( 'wide_nchar' ); 29 | my $testcount = 0 30 | + insert_test_count( $tdata ) 31 | + select_test_count( $tdata ) * 1; 32 | ; 33 | 34 | my @nchar_cset = (ORA_OCI >= 9.2) ? qw(UTF8 AL32UTF8) : qw(UTF8); 35 | plan tests => $testcount * @nchar_cset; 36 | show_test_data( $tdata ,0 ); 37 | 38 | foreach my $nchar_cset (@nchar_cset) { 39 | $dbh->disconnect() if $dbh; 40 | undef $dbh; 41 | # testing with NLS_NCHAR=$nchar_cset 42 | SKIP: { 43 | set_nls_nchar( $nchar_cset ,1 ); 44 | $dbh = db_handle(); 45 | show_db_charsets($dbh); 46 | skip "failed to connect to oracle with NLS_NCHAR=$nchar_cset" ,$testcount if not $dbh; 47 | drop_table($dbh); 48 | create_table( $dbh, $tdata ); 49 | insert_rows( $dbh, $tdata ); 50 | dump_table( $dbh ,'nch' ,'descr' ); 51 | select_rows( $dbh, $tdata ); 52 | } 53 | } 54 | } 55 | 56 | END { 57 | eval { 58 | local $dbh->{PrintError} = 0; 59 | drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 60 | }; 61 | } 62 | 63 | __END__ 64 | 65 | -------------------------------------------------------------------------------- /t/39attr.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # $Id$ 3 | # 4 | # Test you can set and retrieve some attributes after connect 5 | # MJE wrote this after discovering the code to set these attributes 6 | # was duplicated in connect/login6 and STORE and it did not need to be 7 | # because DBI passes attributes to STORE for you. 8 | # 9 | use DBI; 10 | use DBD::Oracle(qw(ORA_OCI)); 11 | use strict; 12 | #use Devel::Peek qw(SvREFCNT Dump); 13 | 14 | use Test::More; 15 | unshift @INC ,'t'; 16 | require 'nchar_test_lib.pl'; 17 | 18 | $| = 1; 19 | 20 | my $dsn = oracle_test_dsn(); 21 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 22 | #use Devel::Leak; 23 | #use Test::LeakTrace; 24 | 25 | #no_leaks_ok { 26 | do_it(); 27 | #} -verbose; 28 | 29 | sub do_it { 30 | #my $handle; 31 | #my $count = Devel::Leak::NoteSV($handle); 32 | 33 | my $dbh = eval { DBI->connect($dsn, $dbuser, '',) } 34 | or plan skip_all => "Unable to connect to Oracle"; 35 | 36 | diag("Oracle version: " . join(".", @{$dbh->func('ora_server_version')})); 37 | diag("client version: " . ORA_OCI()); 38 | 39 | SKIP: { 40 | my @attrs = (qw(ora_module_name 41 | ora_client_info 42 | ora_client_identifier 43 | ora_action)); 44 | my @attrs112 = (qw(ora_driver_name)); 45 | 46 | skip('Oracle OCI too old', 1 + @attrs + @attrs112) if ORA_OCI() < 11; 47 | 48 | foreach my $attr (@attrs) { 49 | $dbh->{$attr} = 'fred'; 50 | is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved"); 51 | } 52 | 53 | SKIP: { 54 | skip 'Oracle OCI too old', 1 + @attrs112 if ORA_OCI() < 11.2; 55 | 56 | like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name'); 57 | 58 | foreach my $attr (@attrs) { 59 | $dbh->{$attr} = 'fred'; 60 | is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved"); 61 | } 62 | } 63 | }; 64 | 65 | foreach my $attr (qw(ora_oci_success_warn 66 | ora_objects)) { 67 | $dbh->{$attr} = 1; 68 | is($dbh->{$attr}, 1, "attribute $attr set and retrieved"); 69 | } 70 | 71 | $dbh->disconnect; 72 | #Devel::Leak::CheckSV($handle); 73 | } 74 | 75 | done_testing(); 76 | -------------------------------------------------------------------------------- /t/32xmltype.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use Test::More; 5 | use DBD::Oracle qw(:ora_types); 6 | use DBI; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | ## ---------------------------------------------------------------------------- 12 | ## 03xmlype.t 13 | ## By John Scoles, The Pythian Group 14 | ## ---------------------------------------------------------------------------- 15 | ## Just a few checks to see if one can insert small and large xml files 16 | ## Nothing fancy. 17 | ## ---------------------------------------------------------------------------- 18 | 19 | # create a database handle 20 | my $dsn = oracle_test_dsn(); 21 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 22 | my $dbh; 23 | 24 | eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, 25 | AutoCommit=>1, 26 | PrintError => 0 })}; 27 | 28 | if ($dbh) { 29 | plan skip_all => "XMLTYPE new in Oracle 9" 30 | if $dbh->func('ora_server_version')->[0] < 9; 31 | plan tests => 3; 32 | } else { 33 | plan skip_all => "Unable to connect to Oracle" 34 | } 35 | # check that our db handle is good 36 | isa_ok($dbh, "DBI::db"); 37 | 38 | 39 | 40 | my $table = table(); 41 | eval { $dbh->do("DROP TABLE $table") }; 42 | 43 | $dbh->do(qq{ 44 | CREATE TABLE $table ( 45 | id INTEGER NOT NULL, 46 | XML_DATA XMLTYPE 47 | ) 48 | }); 49 | 50 | my ($stmt, $sth); 51 | my $small_xml=""; 52 | my $large_xml=""; 53 | my $i=0; 54 | 55 | for ($i=0;$i<=10;$i++){ 56 | $small_xml=$small_xml."the book ".$i." title"; 57 | } 58 | 59 | $small_xml=$small_xml.""; 60 | 61 | for ($i=0;$i<=10000;$i++){ 62 | $large_xml=$large_xml."the book ".$i." title"; 63 | } 64 | 65 | $large_xml=$large_xml.""; 66 | 67 | $stmt = "INSERT INTO ".$table." VALUES (1,?)"; 68 | 69 | $sth =$dbh-> prepare($stmt); 70 | 71 | $sth-> bind_param(1, $small_xml, { ora_type => ORA_XMLTYPE }); 72 | 73 | ok ($sth->execute(), '... execute for small XML return true'); 74 | 75 | $sth-> bind_param(1, $large_xml, { ora_type => ORA_XMLTYPE }); 76 | 77 | ok ($sth->execute(), '... execute for large XML return true'); 78 | 79 | 80 | drop_table($dbh); 81 | 82 | $dbh->disconnect; 83 | 84 | 1; 85 | 86 | -------------------------------------------------------------------------------- /t/rt13865.t: -------------------------------------------------------------------------------- 1 | # $Id$ 2 | use strict; 3 | 4 | use DBI; 5 | use DBD::Oracle; 6 | 7 | use Test::More; 8 | 9 | use lib 't'; 10 | require 'nchar_test_lib.pl'; 11 | 12 | my $dbh = db_handle() or plan skip_all => "can't connect to database"; 13 | 14 | my %priv = map { $_ => 1 } get_privs( $dbh ); 15 | 16 | unless ( $priv{'CREATE TABLE'} ) { 17 | plan skip_all => q{requires permissions 'CREATE TABLE'}; 18 | } 19 | 20 | plan tests => 9; 21 | 22 | $dbh->do( 'DROP TABLE RT13865' ); 23 | 24 | $dbh->do( <<'END_SQL' ) or die $dbh->errstr; 25 | CREATE TABLE RT13865( 26 | COL_INTEGER INTEGER, 27 | COL_NUMBER NUMBER, 28 | COL_NUMBER_37 NUMBER(37), 29 | COL_DECIMAL NUMBER(9,2), 30 | COL_FLOAT FLOAT(126), 31 | COL_VC2 VARCHAR2(67), 32 | COL_VC2_69CHAR VARCHAR2(69 CHAR), 33 | COL_NVC2 NVARCHAR2(69), 34 | COL_NC NCHAR(69), 35 | COL_CHAR CHAR(67), 36 | COL_CHAR_69CHAR CHAR(69 CHAR) 37 | ) 38 | END_SQL 39 | 40 | my $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_INTEGER' ); 41 | 42 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 38, 43 | "INTEGER is alias for NUMBER(38)"; 44 | 45 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER_37' ); 46 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 37, 47 | "NUMBER(37)"; 48 | 49 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER' ); 50 | cmp_ok $col_h->fetchrow_hashref->{COLUMN_SIZE}, '>', 0, 51 | "NUMBER"; 52 | 53 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2' ); 54 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67, 55 | "VARCHAR(67)"; 56 | 57 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2_69CHAR' ); 58 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, 59 | "VARCHAR(69)"; 60 | 61 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NVC2' ); 62 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, 63 | "NVARCHAR2(69)"; 64 | 65 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NC' ); 66 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, 67 | "NCHAR(69)"; 68 | 69 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR' ); 70 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67, 71 | "CHAR(67)"; 72 | 73 | $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR_69CHAR' ); 74 | is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, 75 | "CHAR(69)"; 76 | 77 | $dbh->do( 'DROP TABLE RT13865' ); 78 | 79 | # utility functions 80 | 81 | sub get_privs { 82 | my $dbh = shift; 83 | 84 | my $sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' ); 85 | $sth->execute; 86 | 87 | return map { $_->[0] } @{ $sth->fetchall_arrayref }; 88 | } 89 | -------------------------------------------------------------------------------- /t/70meta.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use Test::More; 3 | 4 | use strict; 5 | use DBI qw(:sql_types); 6 | use Data::Dumper; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | $| = 1; 12 | 13 | my $dsn = oracle_test_dsn(); 14 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 15 | my $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0 }); 16 | 17 | if ($dbh) { 18 | plan tests=>21; 19 | $dbh->{RaiseError} = 1; 20 | } else { 21 | plan skip_all => "Unable to connect to Oracle"; 22 | } 23 | 24 | note("type_info_all\n"); 25 | my @types = $dbh->type_info(SQL_ALL_TYPES); 26 | ok(@types >= 8, 'more than 8 types'); 27 | note(Dumper( @types )); 28 | 29 | note("tables():\n"); 30 | my @tables = $dbh->tables; 31 | note(@tables." tables\n"); 32 | ok(scalar @tables, 'tables'); 33 | 34 | my @table_info_params = ( 35 | [ 'schema list', undef, '%', undef, undef ], 36 | [ 'type list', undef, undef, undef, '%' ], 37 | [ 'table list', undef, undef, undef, undef ], 38 | ); 39 | foreach my $table_info_params (@table_info_params) { 40 | my ($name) = shift @$table_info_params; 41 | my $start = time; 42 | note("$name: table_info(".DBI::neat_list($table_info_params).")\n"); 43 | my $table_info_sth = $dbh->table_info(@$table_info_params); 44 | ok($table_info_sth, 'table_info'); 45 | my $data = $table_info_sth->fetchall_arrayref; 46 | ok($data, 'table_info fetch'); 47 | ok(scalar @$data, 'table_info data returned'); 48 | my $dur = time - $start; 49 | note("$name: ".@$data." rows, $dur seconds\n"); 50 | } 51 | 52 | my $sql_dbms_version = $dbh->get_info(18); 53 | ok($sql_dbms_version, 'dbms_version'); 54 | note "sql_dbms_version=$sql_dbms_version"; 55 | like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched'); 56 | 57 | # test long DEFAULT from column_info 58 | SKIP: { 59 | my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); 60 | 61 | eval { $dbh->do("DROP TABLE $table") }; 62 | 63 | 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))))") }; 64 | 65 | skip 'could not create test table', 8 unless $created; 66 | 67 | is $dbh->{LongReadLen}, 80, 'LongReadLen is at default'; 68 | 69 | ok((my $sth = $dbh->column_info(undef, '%', uc($table), '%')), 'column_info sth'); 70 | 71 | is $dbh->{LongReadLen}, 80, 'LongReadLen still at default'; 72 | 73 | ok((my $info = eval { $sth->fetchrow_hashref }), 'sth->fetchrow_hashref lived') 74 | or diag $@; 75 | 76 | is $info->{COLUMN_DEF}, "to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10)))", 'long DEFAULT matched'; 77 | 78 | ok($sth->finish, 'sth->finish'); 79 | 80 | is $dbh->{LongReadLen}, 80, 'LongReadLen still at default'; 81 | 82 | ok($dbh->do("DROP TABLE $table"), 'drop table'); 83 | } 84 | 85 | $dbh->disconnect; 86 | 87 | exit 0; 88 | 89 | -------------------------------------------------------------------------------- /examples/mktable.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # Sample DBI program to create a new table and load data into it. 3 | # 4 | # Author: Kevin Stock (original oraperl script) 5 | # Date: 5th August 1991 6 | # Date: 25th September 1992 7 | 8 | use DBI; 9 | 10 | use strict; 11 | 12 | # Set trace level if '-# trace_level' option is given 13 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 14 | 15 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 16 | my ( $inst, $user, $pass ) = @ARGV; 17 | 18 | # Connect to database 19 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 20 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 21 | or die $DBI::errstr; 22 | 23 | # set these as strings to make the code more readable 24 | my $CREATE = "CREATE TABLE tryit ( name VARCHAR2(10), ext NUMBER(3) )"; 25 | my $INSERT = "INSERT INTO tryit VALUES ( ?, ? )"; 26 | my $LIST = "SELECT * FROM tryit ORDER BY name"; 27 | my $DELETE = "DELETE FROM tryit WHERE name = ?"; 28 | my $DELETE_NULL = "DELETE FROM tryit WHERE name IS NULL"; 29 | my $DROP = "DROP TABLE tryit"; 30 | 31 | # Can use dynamic variables in write as long as they are visible at format time 32 | my ( $msg, $name, $ext ); 33 | 34 | # Prepare formats for output 35 | format STDOUT_TOP = 36 | 37 | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 38 | $msg 39 | 40 | Name Ext 41 | ==== === 42 | . 43 | 44 | format STDOUT = 45 | @<<<<<<<<< @>> 46 | $name, $ext 47 | . 48 | 49 | # function to list the table 50 | sub list { 51 | $msg = join "\n", @_; 52 | $- = 0; 53 | my $sth = $dbh->prepare( $LIST ); 54 | $sth->execute; 55 | $sth->bind_columns( {}, \( $name, $ext ) ); 56 | while ( $sth->fetch ) { 57 | $name = '' unless defined $name; 58 | $ext = '' unless defined $ext; 59 | write; 60 | } 61 | $sth->finish; 62 | } 63 | 64 | # create the database 65 | $dbh->do( $CREATE ); 66 | 67 | # put some data into it 68 | my $sth = $dbh->prepare( $INSERT ); 69 | while ( ) { 70 | chomp; 71 | $sth->execute( map { 'NULL' eq $_ ? undef : $_ } split /:/, $_, 2 ); 72 | } 73 | $dbh->commit; 74 | list( 'Initial Data' ); 75 | 76 | # remove a few rows 77 | $sth = $dbh->prepare( $DELETE ); 78 | foreach $name ( 'catherine', 'angela', 'arnold', 'julia' ) { 79 | $sth->execute( $name ); 80 | } 81 | $dbh->commit; 82 | list( 'After removing selected people' ); 83 | 84 | # Remove some rows with NULLs 85 | $dbh->do( $DELETE_NULL ); 86 | list( 'After removing NULL names' ); 87 | 88 | # remove the table and disconnect 89 | $dbh->do( $DROP ); 90 | $dbh->disconnect; 91 | 92 | # This is the data which will go into the table 93 | __END__ 94 | julia:292 95 | angela:208 96 | NULL:999 97 | larry:424 98 | catherine:201 99 | nonumber:NULL 100 | randal:306 101 | arnold:305 102 | NULL:NULL 103 | -------------------------------------------------------------------------------- /examples/curref.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # curref.pl - by Geoffrey Young 4 | # 5 | # for this example, we create a package that contains 6 | # two procedures: 7 | # emp_cursor - returns a specific cursor reference 8 | # ref_cursor_close - closes any cursor reference 9 | # 10 | # to actually run this example as is, you will need the 11 | # oracle demo tables. otherwise, it's just sample code... 12 | 13 | use DBI; 14 | use DBD::Oracle qw(:ora_types); 15 | 16 | use strict; 17 | 18 | # Set trace level if '-# trace_level' option is given 19 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 20 | 21 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 22 | my ( $inst, $user, $pass ) = @ARGV; 23 | 24 | # Connect to database 25 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 26 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 27 | or die $DBI::errstr; 28 | 29 | my $sql = qq( 30 | CREATE OR REPLACE PACKAGE curref_test 31 | IS 32 | TYPE cursor_ref IS REF CURSOR; 33 | PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref); 34 | PROCEDURE ref_cursor_close (curref IN cursor_ref); 35 | END; 36 | ); 37 | my $rv = $dbh->do($sql); 38 | print "The package has been created...\n"; 39 | 40 | $sql = qq( 41 | CREATE OR REPLACE PACKAGE BODY curref_test 42 | IS 43 | PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref) 44 | IS 45 | BEGIN 46 | OPEN curref FOR select ename, job from emp where job = job_in; 47 | END; 48 | 49 | PROCEDURE ref_cursor_close (curref IN cursor_ref) 50 | IS 51 | BEGIN 52 | close curref; 53 | END; 54 | END; 55 | ); 56 | $rv = $dbh->do($sql); 57 | print "The package body has been created...\n"; 58 | 59 | print "These are the results from the ref cursor:\n"; 60 | $sql = qq( 61 | BEGIN 62 | curref_test.emp_cursor(:job_in, :curref); 63 | END; 64 | ); 65 | my $curref; 66 | my $sth = $dbh->prepare($sql); 67 | $sth->bind_param(":job_in", "CLERK"); 68 | $sth->bind_param_inout(":curref", \$curref, 0, {ora_type => ORA_RSET}); 69 | $sth->execute; 70 | $curref->dump_results; 71 | open_cursors(); 72 | 73 | $sql = qq( 74 | BEGIN 75 | curref_test.ref_cursor_close(:curref); 76 | END; 77 | ); 78 | $sth = $dbh->prepare($sql); 79 | $sth->bind_param(":curref", $curref, {ora_type => ORA_RSET}); 80 | $sth->execute; 81 | 82 | print "The cursor is now closed\n"; 83 | print "just to prove it...\n"; 84 | open_cursors(); 85 | 86 | $sql = "DROP PACKAGE curref_test"; # Also drops PACKAGE BODY 87 | $rv = $dbh->do($sql); 88 | print "The package has been dropped...\n"; 89 | 90 | $dbh->disconnect; 91 | 92 | sub open_cursors { 93 | eval { 94 | $sth = $dbh->prepare( 95 | 'SELECT user, sql_text FROM sys.v_$open_cursor ORDER BY user, sql_text'); 96 | $sth->execute; 97 | print "Here are the open cursors:\n"; 98 | $sth->dump_results; 99 | }; 100 | if ( $@ ) { 101 | print "Unable to SELECT from SYS.V_\$OPEN_CURSOR:\n"; 102 | if ( 942 == $DBI::err ) { 103 | print " User $user needs SELECT permission.\n"; 104 | } 105 | else { print "$@\n"; } 106 | } 107 | } 108 | -------------------------------------------------------------------------------- /err_lob/err_csr_clob.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-bounce@isc.org Thu Sep 21 20:27:21 2000 2 | Return-Path: 3 | Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) 4 | id UAA18945; Thu, 21 Sep 2000 20:27:20 +0100 (BST) 5 | Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) 6 | id <02709-1@oink>; Mon, 21 Sep 1970 20:26:40 +0100 7 | Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk 8 | id 969564156:20:26825:1; Thu, 21 Sep 2000 19:22:36 GMT 9 | Received: from pub3.rc.vix.com ([204.152.186.34]) by punt-2.mail.demon.net 10 | id aa2026778; 21 Sep 2000 19:22 GMT 11 | Received: from pub3.rc.vix.com (pub3.rc.vix.com [204.152.186.34]) 12 | by pub3.rc.vix.com (Postfix) with ESMTP id 28A613E5D; 13 | Thu, 21 Sep 2000 12:22:17 -0700 (PDT) 14 | Received: with LISTAR (v1.0.0; list dbi-users); 15 | Thu, 21 Sep 2000 12:17:37 -0700 (PDT) 16 | Received: from isrv3.isc.org (isrv3.isc.org [204.152.184.87]) 17 | by pub3.rc.vix.com (Postfix) with ESMTP id A59853E42 18 | for ; 19 | Thu, 21 Sep 2000 12:17:32 -0700 (PDT) 20 | Received: from wheel.cs.wisc.edu (wheel.cs.wisc.edu [128.105.121.12]) 21 | by isrv3.isc.org (8.9.1/8.9.1) via ESMTP id MAA00855 22 | for ; 23 | Thu, 21 Sep 2000 12:17:32 -0700 (PDT) env-from (horn@wheel.cs.wisc.edu) 24 | Received: (from horn@localhost) by wheel.cs.wisc.edu (8.9.2/8.9.2) id OAA16413 25 | for dbi-users@isc.org; Thu, 21 Sep 2000 14:17:28 -0500 (CDT) 26 | Date: Thu, 21 Sep 2000 14:17:28 -0500 (CDT) 27 | From: Jeffrey Horn 28 | Message-Id: <200009211917.OAA16413@wheel.cs.wisc.edu> 29 | To: dbi-users@isc.org 30 | Subject: Setting ORA_TYPE after the fact... 31 | Sender: horn@wheel.cs.wisc.edu 32 | Sender: dbi-users-bounce@isc.org 33 | Errors-To: dbi-users-bounce@isc.org 34 | X-original-sender: horn@cs.wisc.edu 35 | Precedence: bulk 36 | List-unsubscribe: 37 | X-List-ID: 38 | List-owner: 39 | List-post: 40 | Status: RO 41 | X-Status: A 42 | Content-Length: 969 43 | Lines: 20 44 | 45 | I have a situation where I would like to return a cursor that contains a 46 | CLOB as one of it's attributes from a PL/SQL procedure. What I get back is 47 | a LOB locator and DBD doesn't actually read the CLOB but instead returns an 48 | error. 49 | 50 | If I go through a bind/prepare/execute/fetch on a similar SQL statement all 51 | is well. Is there any way that I can tell DBD that a given attribute of 52 | a cursor is a CLOB once the cursor is already opened so that DBD will do the 53 | right thing? 54 | 55 | -- Jeff Horn 56 | 57 | 58 | ------------------------------------------------------------------------------ 59 | DBI HOME PAGE AND ARCHIVES: http://www.symbolstone.org/technology/perl/DBI/ 60 | To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html 61 | If you are without web access, or if you are having trouble with the web page, 62 | please send mail to dbi-users-request@isc.org with the subject line of: 63 | 'unsubscribe'. 64 | ------------------------------------------------------------------------------ 65 | 66 | -------------------------------------------------------------------------------- /mkta.pl: -------------------------------------------------------------------------------- 1 | #!/bin/env perl -w 2 | 3 | # mkta - make-test-all 4 | # 5 | # quick hack to run test suite against multiple dbs 6 | # for each db runn alternate charset tests in parallel 7 | # keep log files from failures 8 | 9 | use strict; 10 | use Symbol; 11 | 12 | local $| = 1; 13 | 14 | use DBI; 15 | use DBD::Oracle qw(ORA_OCI); 16 | my @sid = DBI->data_sources('Oracle'); 17 | s/^dbi:Oracle://i for @sid; 18 | 19 | # set TEST_FILES env var to override which tests are run 20 | my $opt_full = 1; 21 | my $opt_dir = "mkta"; 22 | my $opt_tf = $ENV{TEST_FILES}; 23 | my $opt_j = 6; 24 | 25 | my $seq = 0; 26 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 27 | my (@queue, @run, %running, %skipped, @fail, $tested); 28 | 29 | my @cs_utf8 = (ORA_OCI() < 9.2) ? ("UTF8") : ("AL32UTF8", ($opt_full) ? ("UTF8") : ()); 30 | my @cs_8bit = ($opt_full) ? ("WE8ISO8859P1", "WE8MSWIN1252") : ("WE8MSWIN1252"); 31 | my @charsets = ("", @cs_utf8, @cs_8bit); 32 | 33 | # need to add in: 34 | # multiple perl versions/achitectures 35 | # multiple oracle versions 36 | 37 | for my $sid (@sid) { 38 | mkta_sid_cs($sid, \@charsets); 39 | } 40 | 41 | sub mkta_sid_cs { 42 | my ($sid, $charsets) = @_; 43 | my $start_time = time; 44 | 45 | local $ENV{ORACLE_SID} = $sid; 46 | my $dbh = DBI->connect("dbi:Oracle:", $dbuser, undef, { PrintError=>0 }); 47 | unless ($dbh) { 48 | (my $errstr = $DBI::errstr) =~ s/\n.*//s; 49 | push @{ $skipped{$errstr} }, $sid; 50 | return; 51 | } 52 | mkdir $opt_dir, 0771 unless -d $opt_dir; 53 | print "$sid: testing with @$charsets ...\n"; 54 | 55 | system("make") == 0 56 | or die "$0 aborted - make failed\n"; 57 | system("rm -f $opt_dir/$sid-*-*.log"); 58 | 59 | for my $ochar (@$charsets) { 60 | for my $nchar (@$charsets) { 61 | # because empty NLS_NCHAR is same as NLS_LANG charset 62 | next if $nchar eq '' && $ochar ne ''; 63 | push @queue, [ $sid, $ochar, $nchar ]; 64 | } 65 | } 66 | while (@queue) { 67 | while (@queue && keys %running < $opt_j) { 68 | my ($tag, $fh) = start_test(@{ shift @queue }); 69 | $running{$tag} = $fh; 70 | push @run, $tag; 71 | ++$tested; 72 | } 73 | wait_for_tests(); 74 | } 75 | wait_for_tests(); 76 | printf "$sid: completed in %.1f minutes\n", (time-$start_time)/60; 77 | print "\n"; 78 | } 79 | 80 | sub start_test { 81 | my ($sid, $ochar, $nchar) = @_; 82 | local $ENV{NLS_LANG} = ($ochar) ? ".$ochar" : ""; 83 | local $ENV{NLS_NCHAR} = ($nchar) ? $nchar : ""; 84 | local $ENV{DBD_ORACLE_SEQ} = ++$seq; # unique id for parallel runs 85 | my $tag = join "-", map { $_ || "unset" } ($sid, $ochar, $nchar); 86 | my $fh = gensym(); 87 | my @make_opts; 88 | push @make_opts, "TEST_FILES='$opt_tf'" if $opt_tf; 89 | open $fh, "make test @make_opts > $opt_dir/$tag.log 2>&1 && rm $opt_dir/$tag.log |"; 90 | print "$tag: started\n"; 91 | return ($tag, $fh); 92 | } 93 | 94 | sub wait_for_tests { 95 | while(%running) { 96 | my @running = grep { $running{$_} } @run; 97 | my $tag = $running[0] or die; 98 | close $running{ $tag }; 99 | printf "$tag: %s\n", ($?) ? "FAILED" : "pass"; 100 | push @fail, $tag if $?; 101 | delete $running{$tag}; 102 | } 103 | } 104 | 105 | print "Skipped due to $_: @{ $skipped{$_} }\n" for keys %skipped; 106 | 107 | printf "Failed %d out of %d: @fail\n", scalar @fail, $tested; 108 | print "done.\n" 109 | -------------------------------------------------------------------------------- /err_bind/err_bindnullhash.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-12580-Tim.Bunce=pobox.com@perl.org Thu Jul 11 17:49:35 2002 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g6BGnYH11008 4 | for ; Thu, 11 Jul 2002 17:49:34 +0100 (BST) 5 | (envelope-from dbi-users-return-12580-Tim.Bunce=pobox.com@perl.org) 6 | Received: from pop3.mail.demon.net [194.217.242.59] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Thu, 11 Jul 2002 17:49:34 +0100 (BST) 9 | Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com 10 | id 1026401921:10:09249:41; Thu, 11 Jul 2002 15:38:41 GMT 11 | Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net 12 | id aa1124337; 11 Jul 2002 15:38 GMT 13 | Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) 14 | by dolly1.pobox.com (Postfix) with ESMTP id B567C2BF65 15 | for ; Thu, 11 Jul 2002 11:38:05 -0400 (EDT) 16 | Delivered-To: tim.bunce@pobox.com 17 | Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) 18 | by dolly1.pobox.com (Postfix) with SMTP id 347792BF62 19 | for ; Thu, 11 Jul 2002 11:38:05 -0400 (EDT) 20 | Received: (qmail 95914 invoked by uid 1005); 11 Jul 2002 15:38:04 -0000 21 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 22 | Precedence: bulk 23 | List-Post: 24 | List-Help: 25 | List-Unsubscribe: 26 | List-Subscribe: 27 | Delivered-To: mailing list dbi-users@perl.org 28 | Received: (qmail 95896 invoked by uid 76); 11 Jul 2002 15:38:04 -0000 29 | Received: from ironmail1.cc.lehigh.edu (HELO ironmail1.cc.lehigh.edu) (128.180.39.26) 30 | by onion.perl.org (qpsmtpd/0.07b) with SMTP; Thu Jul 11 15:38:04 2002 -0000 31 | Received: from ([128.180.39.20]) 32 | by ironmail1.cc.lehigh.edu with ESMTP with TLS; 33 | Thu, 11 Jul 2002 11:35:06 -0400 (EDT) 34 | Received: from lawrencework (pc-lfn0.dept.Lehigh.EDU [128.180.52.51]) 35 | by rain.CC.Lehigh.EDU (8.12.4/8.12.4) with SMTP id g6BFZ6rr022463 36 | for ; Thu, 11 Jul 2002 11:35:06 -0400 37 | Message-ID: <0a0401c228f0$93feda10$3334b480@lawrencework> 38 | From: "Phil R Lawrence" 39 | To: 40 | References: <083b01c22824$70357340$3334b480@lawrencework> <20020711140937.A568@dansat.data-plan.com> 41 | Subject: Re: error msg suggestion 42 | Date: Thu, 11 Jul 2002 11:35:20 -0400 43 | MIME-Version: 1.0 44 | Content-Type: text/plain; 45 | charset="iso-8859-1" 46 | Content-Transfer-Encoding: 7bit 47 | X-Priority: 3 48 | X-MSMail-Priority: Normal 49 | X-Mailer: Microsoft Outlook Express 6.00.2600.0000 50 | X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2600.0000 51 | Status: RO 52 | X-Status: A 53 | Content-Length: 636 54 | Lines: 21 55 | 56 | Tim Bunce wrote: 57 | > Binding an undef should work and be treated as a NULL. 58 | > 59 | > Probably a bug in your code or the driver. But you didn't 60 | > say which driver. 61 | 62 | Hmmm. quite right, undefs do bind as NULL. However, in this case I am 63 | binding $hash{non-existent-key}, which autoinstantiates to an undef, and looks 64 | like this in the trace: 65 | undef (magic-sg:y) 66 | 67 | Of course it was my dumb fault for having the wrong key for lookup, but 68 | nonetheless, perhaps this should work the same as a normal undef. 69 | 70 | # $DBI::VERSION = "1.14"; 71 | # $DBD::ODBC::VERSION = '0.28'; 72 | $DSN = 'driver=Microsoft Access Driver (*.mdb);dbq=StudyManager.mdb'; 73 | 74 | Thanks, 75 | Phil 76 | 77 | 78 | -------------------------------------------------------------------------------- /t/50cursor.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # From: Jeffrey Horn 3 | use Test::More; 4 | use DBI; 5 | use DBD::Oracle qw(ORA_RSET); 6 | use strict; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | $| = 1; 12 | 13 | my ($limit, $tests); 14 | 15 | my $dsn = oracle_test_dsn(); 16 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 17 | my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); 18 | 19 | if ($dbh) { 20 | # ORA-00900: invalid SQL statement 21 | # ORA-06553: PLS-213: package STANDARD not accessible 22 | my $tst = $dbh->prepare( 23 | q{declare foo char(50); begin RAISE INVALID_NUMBER; end;}); 24 | if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) { 25 | warn "Your Oracle server doesn't support PL/SQL" if $dbh->err== 900; 26 | warn "Your Oracle PL/SQL is not properly installed" 27 | if $dbh->err==6553||$dbh->err==600; 28 | plan skip_all => 'server does not support pl/sql or not installed'; 29 | } 30 | 31 | $limit = $dbh->selectrow_array( 32 | q{SELECT value-2 FROM v$parameter WHERE name = 'open_cursors'}); 33 | # allow for our open and close cursor 'cursors' 34 | $limit -= 2 if $limit && $limit >= 2; 35 | unless (defined $limit) { # v$parameter open_cursors could be 0 :) 36 | warn("Can't determine open_cursors from v\$parameter, so using default\n"); 37 | $limit = 1; 38 | } 39 | $limit = 100 if $limit > 100; # lets not be greedy or upset DBA's 40 | $tests = 2 + 10 * $limit + 6; 41 | 42 | plan tests => $tests; 43 | 44 | note "Max cursors: $limit"; 45 | 46 | } else { 47 | plan skip_all => "Unable to connect to Oracle"; 48 | } 49 | 50 | my @cursors; 51 | my @row; 52 | 53 | note("opening cursors\n"); 54 | my $open_cursor = $dbh->prepare( qq{ 55 | BEGIN OPEN :kursor FOR 56 | SELECT * FROM all_objects WHERE rownum < 5; 57 | END; 58 | } ); 59 | ok($open_cursor, 'open cursor' ); 60 | 61 | foreach ( 1 .. $limit ) { 62 | note("opening cursor $_\n"); 63 | ok( $open_cursor->bind_param_inout( ":kursor", \my $cursor, 0, { ora_type => ORA_RSET } ), 'open cursor bind param inout' ); 64 | ok( $open_cursor->execute, 'open cursor execute' ); 65 | ok(!$open_cursor->{Active}, 'open cursor Active'); 66 | 67 | ok($cursor->{Active}, 'cursor Active' ); 68 | ok($cursor->fetchrow_arrayref, 'cursor fetcharray'); 69 | ok($cursor->fetchrow_arrayref, 'cursor fetcharray'); 70 | ok($cursor->finish, 'cursor finish' ); # finish early 71 | ok(!$cursor->{Active}, 'cursor not Active'); 72 | 73 | push @cursors, $cursor; 74 | } 75 | 76 | note("closing cursors\n"); 77 | my $close_cursor = $dbh->prepare( qq{ BEGIN CLOSE :kursor; END; } ); 78 | ok($close_cursor, 'close cursor'); 79 | foreach ( 1 .. @cursors ) { 80 | print "closing cursor $_\n"; 81 | my $cursor = $cursors[$_-1]; 82 | ok($close_cursor->bind_param( ":kursor", $cursor, { ora_type => ORA_RSET }), 'close cursor bind param'); 83 | ok($close_cursor->execute, 'close cursor execute'); 84 | } 85 | 86 | my $PLSQL = <<"PLSQL"; 87 | DECLARE 88 | TYPE t IS REF CURSOR; 89 | c t; 90 | BEGIN 91 | ? := c; 92 | END; 93 | PLSQL 94 | 95 | ok(my $sth1 = $dbh->prepare($PLSQL), 96 | 'prepare exec of proc for null cursor'); 97 | ok($sth1->bind_param_inout(1, \my $cursor, 100, {ora_type => ORA_RSET}), 98 | 'binding cursor for null cursor'); 99 | ok($sth1->execute, 'execute for null cursor'); 100 | is($cursor, undef, 'undef returned for null cursor'); 101 | ok($sth1->execute, 'execute 2 for null cursor'); 102 | is($cursor, undef, 'undef 2 returned for null cursor'); 103 | 104 | $dbh->disconnect; 105 | 106 | exit 0; 107 | 108 | -------------------------------------------------------------------------------- /CONTRIBUTING.mkd: -------------------------------------------------------------------------------- 1 | # CONTRIBUTING 2 | 3 | Thank you for considering contributing to {{ $dist }}. 4 | This file contains instructions that will help you work with 5 | the source code. 6 | 7 | ## Repository branches structure 8 | 9 | The two main branches of this repository are: 10 | 11 | * **master** 12 | 13 | The main development branch. This branch has to 14 | be processed by Dist::Zilla to generate the 15 | code as it will appear in the CPAN distribution. See the 16 | next section for more details. 17 | 18 | * **releases** 19 | 20 | Contains the code as it appears on CPAN. Each official 21 | release is also tagged with its version. 22 | 23 | ## Working on the master branch 24 | 25 | The distribution is managed with [Dist::Zilla][distzilla]. 26 | This means than many of the usual files you might expect 27 | are not in the repository, but are generated at release time. 28 | 29 | However, you can run tests directly using the 'prove' tool: 30 | 31 | ``` bash 32 | $ prove -l 33 | $ prove -lv t/some_test_file.t 34 | $ prove -lvr t/ 35 | ``` 36 | 37 | In most cases, 'prove' is entirely sufficent for you to test any 38 | patches you have. 39 | 40 | You may need to satisfy some dependencies. The easiest way to satisfy 41 | dependencies is to install the last release -- this is available at 42 | https://metacpan.org/release/{{ $dist }}. 43 | 44 | If you use cpanminus, you can do it without downloading the tarball first: 45 | 46 | ``` bash 47 | $ cpanm --reinstall --installdeps --with-recommends {{ $dist =~ s/-/::/gr }} 48 | ``` 49 | 50 | Dist::Zilla is a very powerful authoring tool, but requires a number of 51 | author-specific plugins. If you would like to use it for contributing, 52 | install it from CPAN, then run one of the following commands, depending on 53 | your CPAN client: 54 | 55 | ``` bash 56 | $ cpan `dzil authordeps --missing` 57 | $ dzil authordeps --missing | cpanm 58 | ``` 59 | 60 | You should then also install any additional requirements not needed by the 61 | dzil build but may be needed by tests or other development: 62 | 63 | ``` bash 64 | # cpan `dzil listdeps --author --missing` 65 | $ dzil listdeps --author --missing | cpanm 66 | ``` 67 | 68 | You can also do this via cpanm directly: 69 | 70 | ``` bash 71 | $ cpanm --reinstall --installdeps --with-develop --with-recommends {{ $dist =~ s/-/::/gr }} 72 | ``` 73 | 74 | Once installed, here are some dzil commands you might try: 75 | 76 | ``` bash 77 | $ dzil build 78 | $ dzil test 79 | $ dzil test --release 80 | $ dzil xtest 81 | $ dzil listdeps --json 82 | $ dzil build --notgz 83 | ``` 84 | 85 | 86 | ## This Is Complicated. Is There an Easier Way? 87 | 88 | Actually, yes there is. You can also work directly on the `releases` branch, 89 | which corresponds to the code is generated by Dist::Zilla and 90 | correspond to what is uploaded to CPAN. 91 | 92 | It won't contain any of the changes brought to the codebase since the last 93 | CPAN release, but for a small patch that shouldn't be a problem. 94 | 95 | ## Sending Patches 96 | 97 | The code for this distribution is hosted on [GitHub][repository]. 98 | 99 | You can submit bug reports via the [repository's issue track][bugtracker]. 100 | 101 | You can also submit code changes by forking the repository, pushing your code 102 | changes to your clone, and then submitting a pull request. Detailed 103 | instructions for doing that is available here: 104 | 105 | * https://help.github.com/ 106 | * https://help.github.com/articles/creating-a-pull-request 107 | 108 | [distzilla]: http://dzil.org/. 109 | [repository]: https://github.com/pythian/DBD-Oracle/ 110 | [bugtracker]: https://github.com/pythian/DBD-Oracle/issues 111 | 112 | -------------------------------------------------------------------------------- /t/80ora_charset.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | 4 | use Encode; 5 | use Devel::Peek; 6 | 7 | use DBI; 8 | use DBD::Oracle qw(ORA_OCI); 9 | 10 | use Test::More; 11 | 12 | unshift @INC ,'t'; 13 | require 'nchar_test_lib.pl'; 14 | 15 | my $tdata = { 16 | cols => [ 17 | [ 'ch', 'varchar2(20)', ], 18 | [ 'nch', 'nvarchar2(20)', ], 19 | [ 'descr', 'varchar2(50)', ], 20 | ], 21 | 'dump' => 'DUMP(%s)', 22 | rows => [ 23 | [ 24 | "\xb0", 25 | "\xb0", 26 | 'DEGREE SIGN', 27 | ], 28 | ], 29 | }; 30 | 31 | my $table = table(); 32 | 33 | my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8'; 34 | my $eight_bit_charset = 'WE8ISO8859P1'; 35 | 36 | my $dbh_utf8; 37 | my $dbh; 38 | SKIP: { 39 | plan skip_all => "Oracle 9.2 or newer required" unless ORA_OCI >= 9.2; 40 | 41 | if ($ENV{ORA_CHARSET_FAIL}) { 42 | # Connecting up here breaks because of the charset and ncharset 43 | # global variables defined in dbdimp.c 44 | $dbh_utf8 = db_connect(1); 45 | } 46 | my $testcount = 8 + insert_test_count( $tdata ); 47 | 48 | $dbh = db_connect(0); 49 | if ($dbh) { 50 | $dbh->ora_nls_parameters ()->{NLS_CHARACTERSET} =~ m/US7ASCII/ and plan skip_all => "Database is set up as US7ASCII"; 51 | 52 | plan tests => $testcount; 53 | } else { 54 | plan skip_all => "Unable to connect to Oracle"; 55 | } 56 | 57 | show_test_data( $tdata ,0 ); 58 | 59 | drop_table($dbh); 60 | create_table($dbh, $tdata); 61 | insert_rows( $dbh, $tdata); 62 | 63 | my ($ch, $nch) = $dbh->selectrow_array("select ch, nch from $table"); 64 | check($ch, $nch, 0); 65 | 66 | unless ($ENV{ORA_CHARSET_FAIL}) { 67 | $dbh_utf8 = db_connect(1); 68 | } 69 | ($ch, $nch) = $dbh_utf8->selectrow_array("select ch, nch from $table"); 70 | check($ch, $nch, 1); 71 | }; 72 | 73 | sub check { 74 | my $ch = shift; 75 | my $nch = shift; 76 | my $is_utf8 = shift; 77 | 78 | if ($is_utf8) { 79 | ok(Encode::is_utf8($ch)); 80 | ok(Encode::is_utf8($nch)); 81 | } 82 | else { 83 | ok(!Encode::is_utf8($ch)); 84 | ok(!Encode::is_utf8($nch)); 85 | } 86 | 87 | is($ch, "\xb0", "match char"); 88 | is($nch, "\xb0", "match char"); 89 | } 90 | 91 | sub db_connect 92 | { 93 | my $utf8 = shift; 94 | 95 | # Make sure we really are overriding the environment settings. 96 | my ($charset, $ncharset); 97 | if ($utf8) { 98 | set_nls_lang_charset($eight_bit_charset); 99 | set_nls_nchar($eight_bit_charset); 100 | $charset = $utf8_charset; 101 | $ncharset = $utf8_charset; 102 | } 103 | else { 104 | set_nls_lang_charset($utf8_charset); 105 | set_nls_nchar($utf8_charset); 106 | $charset = $eight_bit_charset; 107 | $ncharset = $eight_bit_charset; 108 | } 109 | 110 | my $dsn = oracle_test_dsn(); 111 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 112 | 113 | my $p = { 114 | AutoCommit => 1, 115 | PrintError => 0, 116 | FetchHashKeyName => 'NAME_lc', 117 | ora_envhp => 0, # force fresh environment (with current NLS env vars) 118 | }; 119 | $p->{ora_charset} = $charset if $charset; 120 | $p->{ora_ncharset} = $ncharset if $ncharset; 121 | 122 | my $dbh = DBI->connect($dsn, $dbuser, '', $p); 123 | return $dbh; 124 | } 125 | 126 | END { 127 | eval { 128 | local $dbh->{PrintError} = 0; 129 | drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; 130 | }; 131 | } 132 | 133 | 1; 134 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Troubleshooting/Vms.pod: -------------------------------------------------------------------------------- 1 | #PODNAME: DBD::Oracle::Troubleshooting::Vms 2 | #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Vms 3 | 4 | =head1 General Info 5 | 6 | This is related to Oracle RDBMS 9.2 and later, since Oracle 7 | made fundamental changes to oracle installation requirements 8 | and factual installation with this release. 9 | 10 | Oracle's goal was to make VMS installation be more like on 11 | *nix and Windows, with an all new Oracle Home structure too, 12 | requiring an ODS-5 disk to install Oracle Home on instead of 13 | the good old ODS-2. 14 | 15 | Another major change is the introduction of an Oracle generated 16 | logical name table for oracle logical names like ORA_ROOT and all 17 | its derivatives like ORA_PROGINT etc. And that this logical name 18 | table is inserted in LNM$FILE_DEV in LNM$PROCESS_DIRECTORY. 19 | 20 | (LNM$PROCESS_DIRECTORY) 21 | 22 | "LNM$FILE_DEV" = "SERVER_810111112" 23 | = "LNM$PROCESS" 24 | = "LNM$JOB" 25 | = "LNM$GROUP" 26 | = "LNM$SYSTEM" 27 | = "DECW$LOGICAL_NAMES" 28 | 29 | This ensures that any process that needs to have access to 30 | oracle gets the environment by just adding one logical name table 31 | to a central process specific mechanism. 32 | 33 | But as it is inserted at the very top of LNM$FILE_DEV it also 34 | represents a source of misfortune - especially if a user with 35 | enough privilege to update the oracle table does so (presumably 36 | unintentionally), as an example by changing NLS_LANG. 37 | 38 | PERL has the ability to define, redefine and undefine (deassign) 39 | logical names, but if not told otherwise by the user does it 40 | in the first table in above list, and not as one would normally 41 | expect in the process table. 42 | 43 | Installing DBI and DBD::Oracle has influence upon this since in 44 | both cases a few environment variables are read or set in the 45 | test phase. 46 | For DBI it is the logical SYS$SCRATCH, which is a JOB logical. 47 | For DBD-Oracle it is when testing a new feature in the Oracle 48 | RDBMS: UTF8 and UTF16 character set functionality, and in order 49 | to do this it sets and unsets the related environment variables 50 | NLS_NCHAR and NLS_LANG. 51 | 52 | If one is not careful this changes the values set in the oracle 53 | table - and in the worst case stays active until the next major 54 | system reset. It can also be a very hard error to track down 55 | since it happens in a place where one normally never looks. 56 | 57 | Furthermore, it is very possibly that some or all of the UTF tests 58 | fails, since if one have a variable like NLS_LANG in his process 59 | table, then even though 'mms test' sets it in the wrong table 60 | it is not invoked as it is overruled by the process logical... 61 | 62 | The way to ensure that no logicals are set in the oracle table and 63 | that the UTF tests get the best environment to test in, and that 64 | DBI correctly translates the SYS$SCRATCH logical, use the 65 | logical 66 | 67 | PERL_ENV_TABLES 68 | 69 | to ensure that PERL's behavior is to leave the oracle table alone and 70 | use the process table instead: 71 | 72 | $ DEFINE PERL_ENV_TABLES LNM$PROCESS, LNM$JOB 73 | 74 | This tells PERL to use the LNM$PROCESS table as the default place to 75 | set and unset variables so that only the perl users environment 76 | is affected when installing DBD::Oracle, and ensures that the 77 | LNM$JOB table is read when SYS$SCRATCH is to be translated. 78 | 79 | PERL_ENV_TABLES is well documented in the PERLVMS man page. 80 | 81 | Oracle8 releases are not affected, as they don't have the 82 | oracle table implementation, and no UTF support. 83 | 84 | Oracle 9.0 is uncertain, since testing has not been possible yet, 85 | but the remedy will not hurt :) 86 | 87 | 88 | -------------------------------------------------------------------------------- /Todo: -------------------------------------------------------------------------------- 1 | [ In no particular order ] 2 | 3 | **************************** NOTE: ora_db_shutdown/ora_dv_startup/StrictlyType/DiscardString not documented 4 | 5 | User requested a document/link anywhere that details what Oracle client attributes 6 | are supported and which are not for Oracle 11g and interacting with a RAC 7 | and using things like TAF, FAN, etc... 8 | 9 | 10 | Seems this file has been neglected for quite a while so I will try to keep it up to date for now 11 | 12 | For release 1.26 or later 13 | 14 | Add support for TAF 15 | Add support for New Lob Functions 16 | Add support for Statement Cacheing 17 | Add support for callbacks?? 18 | Drop support for ProC connections 19 | 20 | For release 1.22 or later 21 | 22 | --> done 1.22Drop support for Oralce 8 and earlier 23 | 24 | add support for $dbh->trace('SQL'); 25 | 26 | Replace OCIInitialize + OCIEnvInit, with OCIEnvCreate 27 | 28 | --> done 1.22 dbd_verbose ora_verbose Add in the DBD only debugging flag 29 | 30 | --> done 1.22 Add new method oci_exe_mode to get the Name of the Execution Modes 31 | 32 | Add support for OCIClientVersion(),OCIPing(),OCIServerVersion() 33 | 34 | -->done 1.22 Expand support for Data Interface for Persistent LOBs by setting up support 35 | for Piecewise Fetch and Piecewise Fetch with Callback and perhaps Array Fetch as well 36 | 37 | Add support for version 2 of lob functions 38 | 39 | Add support for OCIStmtPrepare2(), Statement caching 40 | 41 | The below might of been done but this list has not been maintained; 42 | 43 | Add column_info test 44 | 45 | Add info about getting help - mailing lists etc. 46 | 47 | Public Oracle docs: 48 | http://www.csis.gvsu.edu/GeneralInfo/Oracle/nav/docindex.htm 49 | LOBs 50 | http://www.csis.gvsu.edu/GeneralInfo/Oracle/appdev.920/a96595/dci06mlt.htm 51 | http://technet.oracle.com/tech/oci/htdocs/faq.html#1000425 52 | 53 | Convert most of test.pl into standard t/*.t tests. 54 | 55 | Record ORACLE_HOME when building (auto::DBD::Oracle::mk) 56 | Check emails from Oracle about that. 57 | 58 | Check fix for unassigned placeholder (alen==SvLEN) can't be 59 | triggered by a valid assignment that's exactly that long. 60 | 61 | Resolve imp_sth->stmt_type != OCI_STMT_SELECT issue - add an attribute for it? 62 | 63 | connect with $user = "/ as sysdba" etc as per SQL*Plus 64 | 65 | Move urls from README into Oracle.pm 66 | 67 | Change all uses of perl global na (SvPV & sv_2pv) to local variables 68 | for better thread safety. 69 | 70 | Test script for bind type / field type / length / null interactions 71 | of char/varchar types. 72 | 73 | add docs about OPS$ login 74 | 75 | Add hint about SQL*Plus commands if execute gets an ORA-0900 invalid SQL 76 | statement? Maybe just if common SQL*Plus command word is first word. 77 | 78 | Support SERVICE_NAME in new connect syntax (allow inplace of SID) 79 | 80 | warn (trace_msg?) if ORACLE_HOME changes after first connect 81 | relates to Apache::DBI scenario where changing ORACLE_HOME 82 | upsets existing connections. 83 | 84 | PRECISION for oci7 on VARCHAR etc 85 | 86 | Detect "Error while trying to retrieve text for error ORA-XXXX" 87 | and add "refer to oracle docs or use 'oerr ora XXXX'". 88 | 89 | blob_read for oci8 with LONGs 90 | 91 | $sth = $dbh->prepare("select ... for update"); 92 | $dbh->commit; 93 | $sth->execute; # fails ? auto-re-prepare? 94 | 95 | ora_bind() failed err = ORA-01026: multiple buffers of size > 4000 in 96 | the bind list (DBD: oexec error) 97 | 98 | http://outside.organic.com/mail-archives/dbi-users/Nov1997/0116.html 99 | 100 | Handle PL/SQL arrays. 101 | 102 | Non-blocking 103 | 104 | Tests: 105 | RAW types at max length 106 | 107 | http://www.oracle-users.com/html/freeware.html 108 | 109 | http://freespace.virgin.net/j.hatcher/ociwrap.htm 110 | -------------------------------------------------------------------------------- /err_lob/err_nulllobsegv.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-1743-Tim.Bunce=ig.co.uk@perl.org Wed Apr 11 04:00:48 2001 2 | Return-Path: 3 | Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) 4 | id EAA17912; Wed, 11 Apr 2001 04:00:48 +0100 (BST) 5 | Received: from 194.217.242.36 by oink with SMTP (PP) id <02579-1@oink>; 6 | Sat, 11 Apr 1970 04:00:28 +0100 7 | Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk 8 | id 986956750:10:04398:0; Wed, 11 Apr 2001 02:39:10 GMT 9 | Received: from tmtowtdi.perl.org ([209.85.3.25]) by punt-1.mail.demon.net 10 | id aa1106187; 11 Apr 2001 2:39 GMT 11 | Received: (qmail 32618 invoked by uid 508); 11 Apr 2001 02:39:06 -0000 12 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 13 | Precedence: bulk 14 | List-Post: 15 | List-Help: 16 | List-Unsubscribe: 17 | List-Subscribe: 18 | Delivered-To: mailing list dbi-users@perl.org 19 | Received: (qmail 32603 invoked from network); 11 Apr 2001 02:39:05 -0000 20 | Received: from owns.warpcore.org (216.81.249.18) by tmtowtdi.perl.org with SMTP; 21 | 11 Apr 2001 02:39:05 -0000 22 | Received: (from thebrain@localhost) by owns.warpcore.org (8.11.1/8.11.1) 23 | id f3B2cxH06298 for dbi-users@perl.org; 24 | Tue, 10 Apr 2001 21:38:59 -0500 25 | Date: Tue, 10 Apr 2001 21:38:59 -0500 26 | From: Stephen Clouse 27 | To: dbi-users@perl.org 28 | Subject: Bizarre DBD::Oracle Segfault 29 | Message-ID: <20010410213859.B2766@owns.warpcore.org> 30 | Mail-Followup-To: dbi-users@perl.org 31 | Mime-Version: 1.0 32 | Content-Type: text/plain 33 | Content-Disposition: inline; filename="msg.pgp" 34 | User-Agent: Mutt/1.2.5i 35 | Status: RO 36 | Content-Length: 1918 37 | Lines: 54 38 | 39 | -----BEGIN PGP SIGNED MESSAGE----- 40 | Hash: SHA1 41 | 42 | I sent an email to the dbi-users list about a number of DBD::Oracle CLOB 43 | handling problems waaaaaaaaaaaaaaay back (end of January or so) that today 44 | someone dug up and inquired if I had ever found fixes for what I had pointed 45 | out. 46 | 47 | The problems outlined that day turned out to be the test script itself, which 48 | was doing so much bizarre stuff on one statement that DBD::Oracle just went to 49 | sleep instead (and so was the actual program that instigated the writing of the 50 | test script). 51 | 52 | Well, all but one problem was the script. This, the most serious one, continues 53 | to linger: 54 | 55 | my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); 56 | $st->bind_param(3,undef,{ ora_type => ORA_CLOB }); 57 | $st->execute('A','A',undef); 58 | 59 | On Linux, DBI 1.15, Oracle 8.1.6, and DBD::Oracle 1.06, this segfaults on the 60 | execute. Unfortunately this manifests itself too deep in Oracle for me to 61 | debug. 62 | 63 | The bizarre part is, either of the two snippets below will work: 64 | 65 | my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); 66 | $st->bind_param(3,undef,{ ora_type => ORA_CLOB }); 67 | $st->execute('A','A',''); 68 | $st->execute('B','B',undef); 69 | 70 | my $st = $db->prepare('INSERT INTO foo (col1, col2, col3) VALUES (?,?,?)'); 71 | $st->bind_param(3,undef,{ ora_type => ORA_CLOB }); 72 | $st->execute('A','A',$lobvalue); 73 | $st->execute('B','B',undef); 74 | 75 | It's only when binding undef as the LOB value in the very first execute of a 76 | statement that the segfault occurs. At any other time, it's kosher. That 77 | qualifies as bizarre in my book. 78 | 79 | Your guess is better than mine. 80 | 81 | - -- 82 | Stephen Clouse 83 | Senior Programmer, IQ Coordinator Project Lead 84 | The IQ Group, Inc. 85 | 86 | -----BEGIN PGP SIGNATURE----- 87 | Version: PGP 6.5.8 88 | 89 | iQA+AwUBOtPDwgOGqGs0PadnEQLmtgCeJHTStLu8Q8oFb9UQ4995f8vhZH8Al1p6 90 | RD5m0FEJH2tQiY0+b6542mQ= 91 | =L0M+ 92 | -----END PGP SIGNATURE----- 93 | 94 | -------------------------------------------------------------------------------- /err_unsorted/err_etherreal.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-11185-Tim.Bunce=pobox.com@perl.org Tue Apr 30 14:47:44 2002 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.11.6/8.11.6) with ESMTP id g3UDliR22576 4 | for ; Tue, 30 Apr 2002 14:47:44 +0100 (BST) 5 | (envelope-from dbi-users-return-11185-Tim.Bunce=pobox.com@perl.org) 6 | Received: from pop3.mail.demon.net [194.217.242.23] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Tue, 30 Apr 2002 14:47:44 +0100 (BST) 9 | Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com 10 | id 1020172466:10:24548:59; Tue, 30 Apr 2002 13:14:26 GMT 11 | Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net 12 | id aa1023391; 30 Apr 2002 13:13 GMT 13 | Received: from dolly1.pobox.com (localhost.localdomain [127.0.0.1]) 14 | by dolly1.pobox.com (Postfix) with ESMTP id A94562C075 15 | for ; Tue, 30 Apr 2002 09:12:33 -0400 (EDT) 16 | Delivered-To: tim.bunce@pobox.com 17 | Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) 18 | by dolly1.pobox.com (Postfix) with SMTP id F24B22BFBE 19 | for ; Tue, 30 Apr 2002 09:12:32 -0400 (EDT) 20 | Received: (qmail 36589 invoked by uid 1005); 30 Apr 2002 13:12:28 -0000 21 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 22 | Precedence: bulk 23 | List-Post: 24 | List-Help: 25 | List-Unsubscribe: 26 | List-Subscribe: 27 | Delivered-To: mailing list dbi-users@perl.org 28 | Delivered-To: moderator for dbi-users@perl.org 29 | Received: (qmail 36168 invoked by uid 76); 30 Apr 2002 13:10:41 -0000 30 | Content-Type: text/plain; 31 | charset="iso-8859-1" 32 | From: Calin Medianu 33 | To: Tim Bunce 34 | Subject: Re: DBD::Oracle Slow cursors 35 | Date: Tue, 30 Apr 2002 16:04:47 +0300 36 | X-Mailer: KMail [version 1.3.2] 37 | References: <20020429201853.52283.qmail@web10007.mail.yahoo.com> <20020429233138.E16831@dansat.data-plan.com> 38 | In-Reply-To: <20020429233138.E16831@dansat.data-plan.com> 39 | Cc: dbi-users@perl.org 40 | MIME-Version: 1.0 41 | Message-Id: <20020430131233.F24B22BFBE@dolly1.pobox.com> 42 | Content-Transfer-Encoding: 8bit 43 | X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id g3UDliR22576 44 | Status: RO 45 | X-Status: A 46 | Content-Length: 1213 47 | Lines: 38 48 | 49 | [Add note to DBD::Oracle docs about using ethereal to sniff Oracle packets] 50 | [Not sure if this bug got fixed yet. Maybe not.] 51 | 52 | Me again with the slow cursors. 53 | 54 | I modified both queries to only return 10 rows. 55 | I ran a sniffer (ethereal) on the NIC. It is pretty cool, it also decodes TNS. 56 | 57 | when I am using the SQL, it works like this, there are about 7 packets 58 | received by my workstation to set up the session, then all 10 rows are in the 59 | same packet, then there is another packet probably saying goodbye. 60 | 61 | When I am using the REF cursor, each row comes in it's own TNS packet, that 62 | is why it is so slow! 63 | 64 | Any idea how to fix it? 65 | 66 | thanks a lot, 67 | 68 | Calin 69 | 70 | > On Mon, Apr 29, 2002 at 01:18:53PM -0700, Calin Medianu wrote: 71 | > > Hello, 72 | > > 73 | > > I did the following. Wrote a perl script that retreves 74 | > > data via a straight select from the database. Then I 75 | > > wrote a stored procedure returning a ref cursor open 76 | > > on the same select statement and retrieved the data as 77 | > > well. Using the REF CURSOR/ sotred procedure was about 78 | > > 3 time slower, that is 40 seconds instead of around 79 | > > 10. 80 | > > 81 | > > Is this normal? Is this a problem with oracle or with 82 | > > DBD::Oracle? 83 | > 84 | > DBD::Oracle. It probably isn't setting up a row cache for the ref cursor. 85 | > 86 | > Get a level 3 trace and look for the "dbd_describe'd" line for the 87 | > ref cursor. 88 | > 89 | > Tim. 90 | 91 | -------------------------------------------------------------------------------- /t/34pres_lobs.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | 3 | use Test::More; 4 | 5 | use DBI; 6 | use Config; 7 | use DBD::Oracle qw(:ora_types); 8 | 9 | 10 | 11 | ## ---------------------------------------------------------------------------- 12 | ## 33pres_lobs.t 13 | ## By John Scoles, The Pythian Group 14 | ## ---------------------------------------------------------------------------- 15 | ## Checks to see if the Interface for Persistent LOBs is working 16 | ## Nothing fancy. Just an insert and a select if they fail this there is something up in OCI or the version 17 | ## of oci being used 18 | ## ---------------------------------------------------------------------------- 19 | 20 | unshift @INC ,'t'; 21 | require 'nchar_test_lib.pl'; 22 | 23 | $| = 1; 24 | 25 | # create a database handle 26 | my $dsn = oracle_test_dsn(); 27 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 28 | my $dbh; 29 | eval {$dbh = DBI->connect($dsn, $dbuser, '', 30 | { RaiseError=>1, 31 | AutoCommit=>1, 32 | PrintError => 0 ,LongReadLen=>10000000})}; 33 | if ($dbh) { 34 | plan skip_all => "Data Interface for Persistent LOBs new in Oracle 9" 35 | if $dbh->func('ora_server_version')->[0] < 9; 36 | plan tests => 28; 37 | } else { 38 | plan skip_all => "Unable to connect to Oracle"; 39 | } 40 | # check that our db handle is good 41 | my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar 42 | 43 | SKIP: { 44 | skip "OCI version less than 9.2\n Persistent LOBs Tests skiped.", 29 unless $ora_oci >= 9.2; 45 | 46 | 47 | my $table = table(); 48 | 49 | eval { $dbh->do("DROP TABLE $table") }; 50 | 51 | ok($dbh->do(qq{ 52 | CREATE TABLE $table ( 53 | id NUMBER, 54 | clob1 CLOB, 55 | clob2 CLOB, 56 | blob1 BLOB, 57 | blob2 BLOB) 58 | }), 'create test table'); 59 | 60 | 61 | my $in_clob='ABCD' x 10_000; 62 | my $in_blob=("0\177x\0X"x 2048) x (1); 63 | my ($sql, $sth,$value); 64 | 65 | $sql = "insert into ".$table." 66 | (id,clob1,clob2, blob1,blob2) 67 | values(?,?,?,?,?)"; 68 | ok($sth=$dbh->prepare($sql ), 'prepare for insert into lobs'); 69 | $sth->bind_param(1,3); 70 | ok($sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}), 'bind p2'); 71 | ok($sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}), 'bind p3'); 72 | ok($sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}), 'bind p4'); 73 | ok($sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}), 'bind p5'); 74 | ok($sth->execute(), 'execute'); 75 | 76 | $sql='select * from '.$table; 77 | 78 | ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1}), 'prepare with ora_pers_lob'); 79 | 80 | ok($sth->execute(), 'execute with ora_pers_lob'); 81 | my ($p_id,$log,$log2,$log3,$log4); 82 | 83 | ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 84 | 'fetcheow for ora_pers_lob'); 85 | 86 | is($log, $in_clob, 'clob1 = in_clob'); 87 | is($log2, $in_clob, 'clob2 = in_clob'); 88 | is($log3, $in_blob, 'clob1 = in_blob'); 89 | is($log4, $in_blob, 'clob2 = in_blob'); 90 | 91 | ok($sth=$dbh->prepare($sql,{ora_clbk_lob=>1,ora_piece_size=>.5*1024*1024}), 92 | 'prepare for ora_piece_size'); 93 | 94 | ok($sth->execute(), 'execute for ora_piece_size'); 95 | 96 | ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetchrow'); 97 | ok($log eq $in_clob, 'clob1 = in_clob'); 98 | ok($log2 eq $in_clob, 'clob2 = in_clob'); 99 | ok($log3 eq $in_blob, 'clob1 = in_clob'); 100 | ok($log4 eq $in_blob, 'clob2 = in_clob'); 101 | 102 | ok($sth=$dbh->prepare($sql,{ora_piece_lob=>1,ora_piece_size=>.5*1024*1024}), 103 | 'prepare with ora_piece_lob/ora_piece_size'); 104 | 105 | ok($sth->execute(), 'execute'); 106 | ok( ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 107 | 'fetchrow'); 108 | 109 | ok($log eq $in_clob, 'clob1 = in_clob'); 110 | ok($log2 eq $in_clob, 'clob2 = in_clob'); 111 | ok($log3 eq $in_blob, 'clob1 = in_clob'); 112 | ok($log4 eq $in_blob, 'clob2 = in_clob'); 113 | 114 | #no neeed to look at the data is should be ok 115 | 116 | $sth->finish(); 117 | drop_table($dbh); 118 | } 119 | 120 | 121 | $dbh->disconnect; 122 | 123 | 1; 124 | -------------------------------------------------------------------------------- /err_build/err_makefileundef.msg: -------------------------------------------------------------------------------- 1 | From timbo Tue Apr 26 09:19:54 2005 2 | Return-path: 3 | Received: from pop3.mail.demon.net [194.217.242.253] 4 | by localhost with POP3 (fetchmail-6.2.5) 5 | for timbo@localhost (single-drop); Tue, 26 Apr 2005 09:19:54 -0700 (PDT) 6 | Received: from punt-3.mail.demon.net by mailstore 7 | for pobox@data-plan.com id 1DQSgy-0006AU-4c; 8 | Tue, 26 Apr 2005 16:13:44 +0000 9 | Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) 10 | by punt-3.mail.demon.net with esmtp id 1DQSgy-0006AU-4c 11 | for pobox@data-plan.com; Tue, 26 Apr 2005 16:13:44 +0000 12 | Received: from [207.8.226.2] (helo=kelvin.pobox.com) 13 | by anchor-hub.mail.demon.net with esmtp id 1DQSgy-0003uM-1T 14 | for pobox@data-plan.com; Tue, 26 Apr 2005 16:13:44 +0000 15 | Received: from kelvin.pobox.com (localhost [127.0.0.1]) 16 | by kelvin.pobox.com (Postfix) with ESMTP id 759703B902A; 17 | Tue, 26 Apr 2005 12:13:43 -0400 (EDT) 18 | Delivered-To: tim.bunce@pobox.com 19 | Received: from kelvin (localhost [127.0.0.1]) 20 | by kelvin.pobox.com (Postfix) with ESMTP id 80C0A39F279 21 | for ; Tue, 26 Apr 2005 12:13:42 -0400 (EDT) 22 | Received-SPF: none (kelvin.pobox.com: domain of lembark@wrkhors.com does not designate permitted sender hosts) 23 | X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 66.246.154.128(mail-out.pilosoft.net) 24 | Received: from mail.pilosoft.net (mail-out.pilosoft.net [66.246.154.128]) 25 | by kelvin.pobox.com (Postfix) with ESMTP id 2ED743AB75B 26 | for ; Tue, 26 Apr 2005 12:12:30 -0400 (EDT) 27 | Received: from [192.168.1.2] (dsl-69-31-90-94.pilosoft.com [69.31.90.94]) 28 | by mail.pilosoft.net (8.12.8/8.12.8) with ESMTP id j3QGA3u1014203 29 | for ; Tue, 26 Apr 2005 12:10:03 -0400 30 | Date: Tue, 26 Apr 2005 12:14:22 -0400 31 | From: Steven Lembark 32 | Reply-To: lembark@wrkhors.com 33 | To: Tim Bunce 34 | Subject: Possible glitch in DBD::Oracle-1.48 Makefile.pl 35 | Message-ID: <269F0144DC99100E7C80975F@[192.168.1.2]> 36 | X-Mailer: Mulberry/3.1.3 (Linux/x86) 37 | X-Workhorse: lembark 1.1 38 | MIME-Version: 1.0 39 | Content-Type: text/plain; charset=us-ascii; format=flowed 40 | Content-Transfer-Encoding: 7bit 41 | Content-Disposition: inline 42 | X-Virus-Scanned: ClamAV version 0.83, clamav-milter version 0.83 on mail.pilosoft.net 43 | X-Virus-Status: Clean 44 | X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=failed version=3.0.2 45 | X-Spam-Level: 0.0 46 | X-Spam-Checker-Version: SpamAssassin 3.0.2 (2004-11-16) on cheeta.pilosoft.net 47 | X-Status: A 48 | Content-Length: 1342 49 | Lines: 36 50 | 51 | Linking with OTHERLDFLAGS = -L/opt/oracle/product/9.2/lib/ 52 | -L/opt/oracle/product/9.2/rdbms/lib/ -lclntsh `cat 53 | /opt/oracle/product/9.2/lib/sysliblist` -ldl -lm [from 'build' rule] 54 | 55 | Checking if your kit is complete... 56 | Looks good 57 | Use of uninitialized value in substitution (s///) at Makefile.PL line 1446. 58 | LD_RUN_PATH=/opt/oracle/product/9.2/lib:/opt/oracle/product/9.2/rdbms/lib 59 | Using DBD::Oracle 1.16. 60 | 61 | 62 | sub const_loadlibs { 63 | my $self = shift; 64 | local($_) = $self->SUPER::const_loadlibs(@_); 65 | # edit LD_RUN_PATH ... 66 | my ($ldrp) = m/^LD_RUN_PATH\s*=\s*(.*)/m; 67 | # remove redundant /lib or /usr/lib as it can cause problems 68 | -> $ldrp =~ s!:(/usr)?/lib$!!; 69 | # if it's empty then set it manually 70 | #Lincoln: if pick the right library path 71 | my $libdir = main::ora_libdir(); 72 | $ldrp ||= "$OH/$libdir:$OH/rdbms/$libdir"; 73 | #print "ldrp=$ldrp\n"; 74 | 75 | # stitch it back in 76 | s/^LD_RUN_PATH\s*=\s*(.*)/LD_RUN_PATH=$ldrp/m; 77 | my $env = $ENV{LD_RUN_PATH}; 78 | print "Ignoring LD_RUN_PATH='$env' in environment\n" if $env; 79 | print "LD_RUN_PATH=$ldrp\n"; 80 | return $_; 81 | } 82 | 83 | -- 84 | Steven Lembark 85-09 90th Street 85 | Workhorse Computing Woodhaven, NY 11421 86 | lembark@wrkhors.com 1 888 359 3508 87 | 88 | -------------------------------------------------------------------------------- /err_build/err_memleak.msg: -------------------------------------------------------------------------------- 1 | From SRS0=Dwok=LW=pallas.eruditorum.org=www-data@bounce2.pobox.com Wed Sep 1 16:31:37 2004 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i81FRlpg021884 4 | for ; Wed, 1 Sep 2004 16:31:37 +0100 (BST) 5 | (envelope-from SRS0=Dwok=LW=pallas.eruditorum.org=www-data@bounce2.pobox.com) 6 | Received: from pop3.mail.demon.net [194.217.242.253] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Wed, 01 Sep 2004 16:31:37 +0100 (BST) 9 | Received: from punt-3.mail.demon.net by mailstore 10 | for pobox@data-plan.com id 1C2WYO-00034m-M1; 11 | Wed, 01 Sep 2004 14:57:40 +0000 12 | Received: from [194.217.242.72] (helo=anchor-hub.mail.demon.net) 13 | by punt-3.mail.demon.net with esmtp id 1C2WYO-00034m-M1 14 | for pobox@data-plan.com; Wed, 01 Sep 2004 14:57:40 +0000 15 | Received: from [208.58.1.193] (helo=boggle.pobox.com) 16 | by anchor-hub.mail.demon.net with esmtp id 1C2WYO-0005CR-FY 17 | for pobox@data-plan.com; Wed, 01 Sep 2004 14:57:40 +0000 18 | Received: from boggle.pobox.com (localhost [127.0.0.1]) 19 | by boggle.pobox.com (Postfix) with ESMTP id 1C1D6A758C; 20 | Wed, 1 Sep 2004 10:57:36 -0400 (EDT) 21 | Delivered-To: tim.bunce@pobox.com 22 | Received: from boggle (localhost [127.0.0.1]) 23 | by boggle.pobox.com (Postfix) with ESMTP id 184C8A7214 24 | for ; Wed, 1 Sep 2004 10:57:32 -0400 (EDT) 25 | Received-SPF: fail (boggle.pobox.com: domain of www-data@pallas.eruditorum.org does not designate 63.251.223.170 as permitted sender) 26 | X-SPF-Override: pass (client 63.251.223.170 was found in trusted-forwarder.org, overrides regular SPF fail) 27 | X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.170(x1.develooper.com) 28 | Received: from x1.develooper.com (x1.develooper.com [63.251.223.170]) 29 | by boggle.pobox.com (Postfix) with SMTP id 7A6C9A7555 30 | for ; Wed, 1 Sep 2004 10:57:06 -0400 (EDT) 31 | Received: (qmail 5427 invoked by uid 225); 1 Sep 2004 14:57:04 -0000 32 | Delivered-To: TIMB@cpan.org 33 | Received: (qmail 5403 invoked by alias); 1 Sep 2004 14:57:02 -0000 34 | X-Spam-Status: No, hits=-4.9 required=8.0 35 | tests=BAYES_00 36 | X-Spam-Check-By: la.mx.develooper.com 37 | Received: from pallas.eruditorum.org (HELO pallas.eruditorum.org) (63.251.136.85) 38 | by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Wed, 01 Sep 2004 07:56:59 -0700 39 | Received: by pallas.eruditorum.org (Postfix, from userid 33) 40 | id 1FDD784C0F5; Wed, 1 Sep 2004 10:56:41 -0400 (EDT) 41 | Subject: [cpan #6245] Confirmed memory leak 42 | From: "Guest via RT" 43 | Reply-To: bug-DBD-Oracle@rt.cpan.org 44 | In-Reply-To: 45 | Message-ID: 46 | Precedence: bulk 47 | X-RT-Loop-Prevention: cpan 48 | RT-Ticket: cpan #6245 49 | Managed-by: RT 2.0.15 (http://bestpractical.com/rt/) 50 | RT-Originator: 51 | Date: Wed, 1 Sep 2004 10:56:41 -0400 (EDT) 52 | To: undisclosed-recipients: ; 53 | Status: RO 54 | Content-Length: 937 55 | Lines: 38 56 | 57 | 58 | This message about DBD-Oracle was sent to you by guest <> via rt.cpan.org 59 | 60 | Full context and any attached attachments can be found at: 61 | 62 | 63 | I Using : 64 | 1. SunOS 5.6 Generic_105181-33 sun4u sparc SUNW,Ultra-Enterprise 65 | Perl 5.005_03 66 | DBI 1.37 67 | DBD-Oracle 1.14 68 | Oracle Release 8.1.5.0.0 69 | 70 | 71 | 2. Linux 2.4.18-17.7.xsmp #1 SMP i686 72 | Perl 5.6.1 73 | DBI 1.41 74 | DBD-Oracle 1.16 75 | Oracle Release 8.1.6.0.0 76 | 77 | II The following code: 78 | 79 | use strict; 80 | use DBI; 81 | 82 | foreach ( 1 .. 100 ) { 83 | my $dbh = DBI->connect( 'dbi:Oracle:host=****', '***', '***' ); 84 | $dbh->disconnect(); 85 | sleep(1) 86 | } 87 | 88 | III Leak about 4K every 10 seconds 89 | 90 | PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND 91 | 24927 aldo 15 0 8724 8720 2760 S 1.3 3.4 0:01 perl 92 | 93 | PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND 94 | 24927 aldo 15 0 8736 8732 2760 S 0.7 3.4 0:01 perl 95 | 96 | -------------------------------------------------------------------------------- /err_unsorted/err_refcsr_rowcache.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-bounce@isc.org Tue May 16 22:53:12 2000 2 | Return-Path: 3 | Received: from oink by toad.ig.co.uk (SMI-8.6/SMI-SVR4) 4 | id WAA29547; Tue, 16 May 2000 22:53:11 +0100 5 | Received: from finch-punt-12.mail.demon.net by oink with SMTP (PP) 6 | id <04730-2@oink>; Sat, 16 May 1970 22:51:48 +0100 7 | Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk 8 | id 958512876:10:15786:0; Tue, 16 May 2000 21:34:36 GMT 9 | Received: from pub3.rc.vix.com ([204.152.186.34]) by punt-1.mail.demon.net 10 | id aa1122388; 16 May 2000 21:33 GMT 11 | Received: from pub3.rc.vix.com (pub3.rc.vix.com [204.152.186.34]) 12 | by pub3.rc.vix.com (Postfix) with ESMTP id 661E53EC8; 13 | Tue, 16 May 2000 14:33:38 -0700 (PDT) 14 | Received: with LISTAR (v0.129a; list dbi-users); 15 | Tue, 16 May 2000 14:28:31 -0700 (PDT) 16 | Received: from isrv3.isc.org (isrv3.isc.org [204.152.184.87]) 17 | by pub3.rc.vix.com (Postfix) with ESMTP id 7192F3E20 18 | for ; 19 | Tue, 16 May 2000 14:28:27 -0700 (PDT) 20 | Received: from anchor-post-34.mail.demon.net (anchor-post-34.mail.demon.net [194.217.242.92]) 21 | by isrv3.isc.org (8.9.1/8.9.1) via ESMTP id OAA27204 22 | for ; 23 | Tue, 16 May 2000 14:28:26 -0700 (PDT) env-from (Tim.Bunce@ig.co.uk) 24 | Received: from ignite.demon.co.uk ([158.152.8.99] helo=oink) 25 | by anchor-post-34.mail.demon.net with smtp (Exim 2.12 #1) 26 | id 12rot7-000Mp4-0Y; Tue, 16 May 2000 22:28:25 +0100 27 | Received: from toad by oink with SMTP (PP) id <04650-0@oink>; 28 | Sat, 16 May 1970 22:23:55 +0100 29 | Received: by toad.ig.co.uk (SMI-8.6/SMI-SVR4) id WAA29289; 30 | Tue, 16 May 2000 22:23:50 +0100 31 | Date: Tue, 16 May 2000 22:23:50 +0100 32 | From: Tim Bunce 33 | To: peter_dev@talk21.com 34 | Cc: dbi-users@isc.org 35 | Subject: Re: Oracle Stored Procs take longer than embedded SQL 36 | Message-ID: <20000516222350.F28435@ig.co.uk> 37 | References: <20000516174946.QLKD22548.t21mta02-app.talk21.com@t21mtaV-lrs> 38 | Mime-Version: 1.0 39 | Content-Type: text/plain; charset=us-ascii 40 | X-Mailer: Mutt 0.95.3i 41 | 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 42 | Organization: Paul Ingram Group, Software Systems, +44 1 483 862800 43 | Sender: dbi-users-bounce@isc.org 44 | Errors-To: dbi-users-bounce@isc.org 45 | X-original-sender: Tim.Bunce@ig.co.uk 46 | Precedence: bulk 47 | List-unsubscribe: 48 | X-List-ID: 49 | List-owner: 50 | List-post: 51 | Status: RO 52 | Content-Length: 1372 53 | Lines: 30 54 | 55 | On Tue, May 16, 2000 at 06:48:22PM +0100, peter_dev@talk21.com wrote: 56 | > I have a problem with the fetching of data from an Oracle Ref Cursor taking longer than the same query in Embeded SQL. 57 | > 58 | > $ get_sp.pl 59 | > Fetched in 0.00774896144866943 seconds 60 | > Completed in 0.106827020645142 seconds 61 | > 62 | > $ get_sql.pl 63 | > Fetched in 0.00138604640960693 seconds 64 | > Completed in 0.380790948867798 seconds 65 | > 66 | > 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. 67 | > 68 | > Any Help would be appreciated 69 | > thanks 70 | 71 | Possibly related to the lack of a row cache on that statement handle. 72 | You, or some kind volunteer, could probably hack that in without too 73 | much work. 74 | 75 | Tim. 76 | 77 | 78 | ------------------------------------------------------------------------------ 79 | DBI HOME PAGE AND ARCHIVES: http://www.symbolstone.org/technology/perl/DBI/ 80 | To unsubscribe from this list, please visit: http://www.isc.org/dbi-lists.html 81 | If you are without web access, or if you are having trouble with the web page, 82 | please send mail to dbi-users-request@isc.org with the subject line of: 83 | 'unsubscribe'. 84 | ------------------------------------------------------------------------------ 85 | 86 | -------------------------------------------------------------------------------- /t/55nested.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use Test::More; 3 | 4 | use DBI; 5 | use DBD::Oracle qw(ORA_RSET); 6 | use strict; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | $| = 1; 12 | 13 | my $dsn = oracle_test_dsn(); 14 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 15 | my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); 16 | 17 | if ($dbh) { 18 | plan tests=> 29; 19 | } else { 20 | plan skip_all =>"Unable to connect to Oracle"; 21 | } 22 | 23 | # ref cursors may be slow due to oracle bug 3735785 24 | # believed fixed in 25 | # 9.2.0.6 (Server Patch Set) 26 | # 10.1.0.4 (Server Patch Set) 27 | # 10.2.0.1 (Base Release) 28 | 29 | my $outer = $dbh->prepare(q{ 30 | SELECT object_name, CURSOR(SELECT object_name FROM dual) 31 | FROM all_objects WHERE rownum <= 5}); 32 | ok($outer, 'prepare select'); 33 | 34 | ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET'); 35 | ok( $outer->execute, 'outer execute'); 36 | ok( my @row1 = $outer->fetchrow_array, 'outer fetchrow'); 37 | my $inner1 = $row1[1]; 38 | is( ref $inner1, 'DBI::st', 'inner DBI::st'); 39 | ok( $inner1->{Active}, 'inner Active'); 40 | ok( my @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array'); 41 | is( $row1[0], $row1_1[0], 'rows equal'); 42 | ok( $inner1->{Active}, 'inner Active'); 43 | ok(my @row2 = $outer->fetchrow_array, 'outer fetchrow_array'); 44 | ok(!$inner1->{Active}, 'inner not Active'); 45 | ok(!$inner1->fetch, 'inner fetch finished'); 46 | is($dbh->err, -1, 'err = -1'); 47 | like($dbh->errstr, qr/ defunct /, 'defunct'); 48 | ok($outer->finish, 'outer finish'); 49 | is($dbh->{ActiveKids}, 0, 'ActiveKids'); 50 | 51 | ######################################################################### 52 | # Same test again but this time with 2 cursors 53 | ######################################################################### 54 | 55 | $outer = $dbh->prepare(q{ 56 | SELECT object_name, 57 | CURSOR(SELECT object_name FROM dual), 58 | CURSOR(SELECT object_name FROM dual) 59 | FROM all_objects WHERE rownum <= 5}); 60 | ok($outer, 'prepare select'); 61 | 62 | ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET'); 63 | ok( $outer->{ora_types}[2] == ORA_RSET, 'set ORA_RSET'); 64 | ok( $outer->execute, 'outer execute'); 65 | ok( @row1 = $outer->fetchrow_array, 'outer fetchrow'); 66 | $inner1 = $row1[1]; 67 | my $inner2 = $row1[2]; 68 | is( ref $inner1, 'DBI::st', 'inner DBI::st'); 69 | is( ref $inner2, 'DBI::st', 'inner DBI::st'); 70 | 71 | ok( $inner1->{Active}, 'inner Active'); 72 | ok( $inner2->{Active}, 'inner Active'); 73 | ok( @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array'); 74 | ok( my @row2_1 = $inner2->fetchrow_array, 'inner fetchrow_array'); 75 | is( $row1[0], $row1_1[0], 'rows equal'); 76 | is( $row1[0], $row2_1[0], 'rows equal'); 77 | 78 | 79 | 80 | ######################################################################### 81 | # Fetch speed test: START 82 | ######################################################################### 83 | 84 | $dbh->{RaiseError} = 1; 85 | 86 | sub timed_fetch { 87 | my ($rs,$caption) = @_; 88 | my $row_count = 0; 89 | my $tm_start = DBI::dbi_time(); 90 | $row_count++ while $rs->fetch; 91 | my $elapsed = DBI::dbi_time() - $tm_start; 92 | 93 | note "Fetched $row_count rows ($caption): $elapsed secs."; 94 | 95 | return $elapsed; 96 | } 97 | 98 | ################################################## 99 | # regular select 100 | ################################################## 101 | my $sql1 = q{ 102 | SELECT object_name 103 | FROM (SELECT object_name FROM all_objects WHERE ROWNUM<=70), 104 | (SELECT 1 FROM all_objects WHERE ROWNUM<=70) 105 | }; 106 | $outer = $dbh->prepare($sql1); 107 | $outer->execute(); 108 | my $dur_std = timed_fetch($outer,'select'); 109 | 110 | ################################################## 111 | # nested cursor 112 | ################################################## 113 | $outer = $dbh->prepare("SELECT CURSOR($sql1) FROM DUAL"); 114 | $outer->execute(); 115 | my $ref_csr = $outer->fetchrow_arrayref->[0]; 116 | my $dur_ref = timed_fetch($ref_csr,'nested cursor'); 117 | 118 | ######################################################################### 119 | # Fetch speed test: END 120 | ######################################################################### 121 | 122 | exit 0; 123 | 124 | -------------------------------------------------------------------------------- /err_bind/err_bind_param_inout_overrun_bug.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-215-Tim.Bunce=ig.co.uk@perl.org Mon Feb 5 23:03:29 2001 2 | Return-Path: 3 | Received: from oink by toad.ig.co.uk (8.8.8+Sun/SMI-SVR4) 4 | id XAA01289; Mon, 5 Feb 2001 23:03:27 GMT 5 | Received: from tele-punt-22.mail.demon.net by oink with SMTP (PP) 6 | id <06769-16@oink>; Fri, 6 Feb 1970 00:01:15 +0100 7 | Received: from punt-2.mail.demon.net by mailstore for Tim.Bunce@ig.co.uk 8 | id 981413584:20:24069:0; Mon, 05 Feb 2001 22:53:04 GMT 9 | Received: from tmtowtdi.perl.org ([209.85.3.25]) by punt-2.mail.demon.net 10 | id aa2024004; 5 Feb 2001 22:53 GMT 11 | Received: (qmail 6267 invoked by uid 508); 5 Feb 2001 22:52:23 -0000 12 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 13 | Precedence: bulk 14 | List-Post: 15 | List-Help: 16 | List-Unsubscribe: 17 | List-Subscribe: 18 | Delivered-To: mailing list dbi-users@perl.org 19 | Received: (qmail 6247 invoked from network); 5 Feb 2001 22:52:22 -0000 20 | Received: from seeme.dare.feddata.com (38.186.101.66) by tmtowtdi.perl.org 21 | with SMTP; 5 Feb 2001 22:52:22 -0000 22 | Received: by seeme.dare.feddata.com; id OAA05466; 23 | Mon, 5 Feb 2001 14:55:56 -0800 (PST) 24 | Received: from ifyou.dare.feddata.com(38.186.101.111) by seeme.dare.feddata.com 25 | via smap (4.1) id xma005448; Mon, 5 Feb 01 14:55:39 -0800 26 | Sender: oscar@dare.feddata.com 27 | Message-ID: <3A7F2FB0.A1507582@pasadena.feddata.com> 28 | Date: Mon, 05 Feb 2001 14:56:48 -0800 29 | From: Oscar DeMartino 30 | Organization: Federal Data Corporation 31 | X-Mailer: Mozilla 4.61 [en] (X11; U; SunOS 5.6 sun4u) 32 | X-Accept-Language: en 33 | MIME-Version: 1.0 34 | To: dbi-users@perl.org 35 | Subject: Undetected error - Binding and Stored Procedures 36 | Content-Type: multipart/alternative; 37 | boundary="------------E1028F7A8304BE268EB8F67B" 38 | Status: RO 39 | Content-Length: 2042 40 | Lines: 66 41 | 42 | --------------E1028F7A8304BE268EB8F67B 43 | Content-Type: text/plain; charset=us-ascii 44 | Content-Transfer-Encoding: 7bit 45 | 46 | I am running Oracle 8.1.5 and am using many stored procedures. We 47 | use returned cursors, and individual values. The problem is, when 48 | a stored procedure is executed and the specified bound variable has not 49 | be declared large enough to hold the returned value subsequent 50 | bound variables do not get set and I cannot find any way to 51 | automatically detect this. 52 | 53 | Example: 54 | 55 | The stored procedure takes 1-input value and returns three string 56 | values. 57 | 58 | the stored procedure is prepared , so I get the statement handle. 59 | 60 | I bind the input variable, and then bind the three output variables (1, 61 | 2, & 3) 62 | as 100 character strings. 63 | 64 | I then execute the statment handle. 65 | 66 | There do not appear to be any errors, after checking the returned value 67 | (for the execute call), 68 | and ->err and ->errstr are clean. 69 | 70 | variable 1 has the correct returned value. 71 | BUT, output variable 2 & 3, have no value. 72 | 73 | ------ 74 | Executing the stored procedure using sqlplus (sql command line 75 | interface) indicated: 76 | 77 | What really occured is that the returned output variables 1 & 3 were 78 | under 100 characters long 79 | output variable 2 was 120 characters long 80 | 81 | --------- 82 | 83 | I know I could make all output variables the max size allowed in the 84 | database field 85 | but this would seem to waste space in the perl code. Since the field in 86 | 87 | the database 88 | is simply defined as a varchar2 with no size limitation (upto 32767). 89 | 90 | ----- 91 | Am I missing something about detecting that variables 2 & 3 did not get 92 | stored correctly 93 | by DBI::Oracle?? 94 | 95 | 96 | 97 | -- 98 | Oscar "Fred" DeMartino FFFFF DDDD CCC 99 | 320 N. Halstead Ave. Ste #160 F D D C C 100 | Pasadena, CA 91107 FFF D D C 101 | e-mail: Oscar.DeMartino@pasadena.feddata.com F D D C 102 | Phone: (626)306-6649 F D D C C 103 | Federal Data Corporation F DDDD CCC 104 | 105 | 106 | 107 | --------------E1028F7A8304BE268EB8F67B-- 108 | 109 | -------------------------------------------------------------------------------- /t/10general.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | use DBI; 7 | use Config; 8 | use DBD::Oracle qw(ORA_OCI); 9 | 10 | unshift @INC ,'t'; 11 | require 'nchar_test_lib.pl'; 12 | 13 | $| = 1; 14 | 15 | my $dsn = oracle_test_dsn(); 16 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 17 | 18 | my $dbh = DBI->connect($dsn, $dbuser, '', 19 | { 20 | PrintError => 0, 21 | }); 22 | 23 | if ($dbh) { 24 | plan tests => 28; 25 | } else { 26 | plan skip_all => "Unable to connect to Oracle"; 27 | } 28 | 29 | my($sth, $p1, $p2, $tmp); 30 | SKIP: { 31 | skip "not unix-like", 2 unless $Config{d_semctl}; 32 | 33 | my @ora_oci_version = split /\./, ORA_OCI(); 34 | skip 'solaris with OCI>9.x', 2 35 | if $^O eq 'solaris' and $ora_oci_version[0] > 9; 36 | 37 | # basic check that we can fork subprocesses and wait for the status 38 | # after having connected to Oracle 39 | 40 | # at some point, this should become a subtest 41 | 42 | my $success = is system("exit 1;"), 1<<8, 'system exit 1 should return 256'; 43 | $success &&= is system("exit 0;"), 0, 'system exit 0 should return 0'; 44 | 45 | unless ( $success ) { 46 | diag <prepare(q{ 65 | /* also test preparse doesn't get confused by ? :1 */ 66 | /* also test placeholder binding is case insensitive */ 67 | select :a, :A from user_tables -- ? :1 68 | }); 69 | ok($sth->{ParamValues}, 'preparse, case insensitive, placeholders in comments'); 70 | is(keys %{$sth->{ParamValues}}, 1, 'number of parameters'); 71 | is($sth->{NUM_OF_PARAMS}, 1, 'expected number of parameters'); 72 | ok($sth->bind_param(':a', 'a value'), 'bind_param for select parameter'); 73 | ok($sth->execute, 'execute for select parameter'); 74 | ok($sth->{NUM_OF_FIELDS}, 'NUM_OF_FIELDS'); 75 | eval { 76 | local $SIG{__WARN__} = sub { die @_ }; # since DBI 1.43 77 | $p1=$sth->{NUM_OFFIELDS_typo}; 78 | }; 79 | ok($@ =~ /attribute/, 'unrecognised attribute'); 80 | ok($sth->{Active}, 'statement is active'); 81 | ok($sth->finish, 'finish'); 82 | ok(!$sth->{Active}, 'statement is not active'); 83 | 84 | $sth = $dbh->prepare("select * from user_tables"); 85 | ok($sth->execute, 'execute for user_tables'); 86 | ok($sth->{Active}, 'active for user_tables'); 87 | 1 while ($sth->fetch); # fetch through to end 88 | ok(!$sth->{Active}, 'user_tables not active after fetch'); 89 | 90 | # so following test works with other NLS settings/locations 91 | ok($dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"), 92 | 'set NLS_NUMERIC_CHARACTERS'); 93 | 94 | ok($tmp = $dbh->selectall_arrayref(q{ 95 | select 1 * power(10,-130) "smallest?", 96 | 9.9999999999 * power(10,125) "biggest?" 97 | from dual 98 | }), 'select all for arithmetic'); 99 | my @tmp = @{$tmp->[0]}; 100 | #warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp"; 101 | ok($tmp[0] <= 1.0000000000000000000000000000000001e-130, "tmp0=$tmp[0]"); 102 | ok($tmp[1] >= 9.99e+125, "tmp1=$tmp[1]"); 103 | 104 | 105 | my $warn=''; 106 | eval { 107 | local $SIG{__WARN__} = sub { $warn = $_[0] }; 108 | $dbh->{RaiseError} = 1; 109 | $dbh->{PrintError} = 1; 110 | $dbh->do("some invalid sql statement"); 111 | }; 112 | ok($@ =~ /DBD::Oracle::db do failed:/, "eval error: ``$@'' expected 'do failed:'"); 113 | #print "''$warn''"; 114 | ok($warn =~ /DBD::Oracle::db do failed:/, "warn error: ``$warn'' expected 'do failed:'"); 115 | ok($DBI::err, 'err defined'); 116 | $dbh->{RaiseError} = 0; 117 | $dbh->{PrintError} = 0; 118 | # --- 119 | 120 | ok( $dbh->ping, 'ping - connected'); 121 | 122 | my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar 123 | note sprintf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci; 124 | 125 | ok("$ora_oci", 'ora_oci defined'); 126 | ok($ora_oci >= 8, "ora_oci $ora_oci >= 8"); 127 | my @ora_oci = split(/\./, $ora_oci,-1); 128 | ok(scalar @ora_oci >= 2, 'version has 2 or more components'); 129 | ok((scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci), 130 | 'version looks like numbers'); 131 | is($ora_oci[0], int($ora_oci), 'first number is int'); 132 | -------------------------------------------------------------------------------- /err_lob/err_loblenwide.msg: -------------------------------------------------------------------------------- 1 | From nobody@fsck.com Thu Dec 4 07:36:20 2003 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id hB47Y2nE066844 4 | for ; Thu, 4 Dec 2003 07:36:20 GMT 5 | (envelope-from nobody@fsck.com) 6 | Received: from pop3.mail.demon.net [194.217.242.253] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Thu, 04 Dec 2003 07:36:20 +0000 (GMT) 9 | Received: from punt-3.mail.demon.net by mailstore 10 | for pobox@dbi.demon.co.uk id 1ARgrA-0005O4-5M; 11 | Wed, 03 Dec 2003 23:56:32 +0000 12 | Received: from [207.8.214.2] (helo=icicle.pobox.com) 13 | by punt-3.mail.demon.net with esmtp id 1ARgrA-0005O4-5M 14 | for pobox@dbi.demon.co.uk; Wed, 03 Dec 2003 23:56:32 +0000 15 | Received: from icicle.pobox.com (localhost[127.0.0.1]) 16 | by icicle.pobox.com (Postfix) with ESMTP id 314AB9A28F 17 | for ; Wed, 3 Dec 2003 18:56:32 -0500 (EST) 18 | Delivered-To: tim.bunce@pobox.com 19 | Received: from colander (localhost[127.0.0.1]) 20 | by icicle.pobox.com (Postfix) with ESMTP id 188369A287 21 | for ; Wed, 3 Dec 2003 18:56:32 -0500 (EST) 22 | Received: from x1.develooper.com (x1.develooper.com[63.251.223.170]) 23 | by icicle.pobox.com (Postfix) with SMTP 24 | for ; Wed, 3 Dec 2003 18:56:31 -0500 (EST) 25 | Received: (qmail 3178 invoked by uid 225); 3 Dec 2003 23:56:30 -0000 26 | Delivered-To: TIMB@cpan.org 27 | Received: (qmail 3174 invoked by alias); 3 Dec 2003 23:56:29 -0000 28 | 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 29 | Received: by pallas.eruditorum.org (Postfix, from userid 65534) id 91512114F1; Wed, 3 Dec 2003 18:56:07 -0500 (EST) 30 | Subject: [cpan #4564] Perl DBI bug handling CLOBs 31 | From: "Jay Turner via RT" 32 | Reply-To: bug-DBI@rt.cpan.org 33 | In-Reply-To: 34 | Message-ID: 35 | Precedence: bulk 36 | X-RT-Loop-Prevention: cpan 37 | RT-Ticket: cpan #4564 38 | Managed-by: RT 2.0.15 (http://bestpractical.com/rt/) 39 | RT-Originator: J.Turner@mdl.com 40 | To: "AdminCc of cpan Ticket #4564": ; 41 | Date: Wed, 3 Dec 2003 18:56:07 -0500 (EST) 42 | X-Spam-Check-By: la.mx.develooper.com 43 | 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 44 | Status: RO 45 | X-Status: A 46 | Content-Length: 1853 47 | Lines: 46 48 | 49 | 50 | This message about DBI was sent to you by J.Turner@mdl.com via rt.cpan.org 51 | 52 | Full context and any attached attachments can be found at: 53 | 54 | 55 | 56 | Date: Fri, 28 Feb 2003 16:55:28 -0800 57 | 58 | It has come to my attention that PERL DBI counts on OCILobGetLength 59 | returning BYTES. It returns CHARACTERS instead, which is the count of 60 | variable-width characters. For multi-byte character sets this results 61 | in errors such as: 62 | 63 | DBD::Oracle::st fetch failed: ORA-03130: the buffer for the next piece 64 | to be fetched is required (DBD ERROR: OCILobGetLength) at id rmsc01.pl 65 | line 294. 66 | 67 | The correct way to read CLOBs is 68 | 69 | 1) Query the LOB locator for the CSID and CSFRM (character set ID and 70 | form). A character set >= 800 is a mulitbyte character set and csfrm 71 | <> 0 is CLOB. 72 | 73 | 2) Pass the CSID and CSFRM to OCILobRead with AMT=0 and pass your 74 | buffer address and size. 75 | 76 | 3) Your callback routine must either be capable of completing the I/O 77 | by allocating additional buffers, or it must notify the caller of 78 | OCILobRead to free the lob locator, since an incomplete read jams the 79 | locator-you can't use it for anything else without finishing the read 80 | (attempts to reuse the locator will result in errors). 81 | 82 | Likewise, with OCILobWrite, you have to pass the CSID and CSFRM, with 83 | AMT=0 and the buffer size in bytes. The callback can just say it has 84 | zero bytes and set piece=OCI_LAST_PIECE. 85 | 86 | You cannot use the return value of OCILobGetLength as the size of the 87 | data that is being read. The actual size of the data is unknown for 88 | variable-width characters, and the buffer has to be big enough to 89 | accomplish the translation, so you can't just double or triple the 90 | return value from OCILobGetLength (I have seen that approach fail). 91 | 92 | You can simulate the effects of a foreign character set by 93 | 94 | $ export NLS_LANG=Japanese 95 | 96 | -------------------------------------------------------------------------------- /err_build/err_hpux_ld.msg: -------------------------------------------------------------------------------- 1 | From SRS0=JbZc=U3=lincolnbaxter.com=lab@bounce2.pobox.com Tue Jun 21 05:02:19 2005 2 | Return-Path: 3 | X-Original-To: timbo@localhost 4 | Delivered-To: timbo@localhost.data-plan.com 5 | Received: from localhost (localhost [127.0.0.1]) 6 | by timac.data-plan.com (Postfix) with ESMTP id B016F2A3D98 7 | for ; Tue, 21 Jun 2005 05:02:19 +0100 (IST) 8 | Received: from pop3.mail.demon.net [194.217.242.253] 9 | by localhost with POP3 (fetchmail-6.2.5) 10 | for timbo@localhost (single-drop); Tue, 21 Jun 2005 05:02:19 +0100 (IST) 11 | Received: from punt-3.mail.demon.net by mailstore 12 | for pobox@data-plan.com id 1DkYXK-0003m5-Mr; 13 | Tue, 21 Jun 2005 02:30:50 +0000 14 | Received: from [194.217.242.223] (helo=lon1-hub.mail.demon.net) 15 | by punt-3.mail.demon.net with esmtp id 1DkYXK-0003m5-Mr 16 | for pobox@data-plan.com; Tue, 21 Jun 2005 02:30:50 +0000 17 | Received: from [208.210.124.73] (helo=gold.pobox.com) 18 | by lon1-hub.mail.demon.net with esmtp id 1DkYXJ-00006n-QE 19 | for pobox@data-plan.com; Tue, 21 Jun 2005 02:30:50 +0000 20 | Received: from gold.pobox.com (localhost [127.0.0.1]) 21 | by gold.pobox.com (Postfix) with ESMTP id AF60172691; 22 | Mon, 20 Jun 2005 22:29:36 -0400 (EDT) 23 | Delivered-To: tim.bunce@pobox.com 24 | Received: from ms-smtp-04-eri0.southeast.rr.com (ms-smtp-04-lbl.southeast.rr.com [24.25.9.103]) 25 | by gold.pobox.com (Postfix) with ESMTP id A3C1E7272E 26 | for ; Mon, 20 Jun 2005 22:29:11 -0400 (EDT) 27 | Received: from lincolnbaxter.com (cpe-069-132-010-126.carolina.res.rr.com [69.132.10.126]) 28 | by ms-smtp-04-eri0.southeast.rr.com (8.12.10/8.12.7) with ESMTP id j5L2TIL4001864 29 | for ; Mon, 20 Jun 2005 22:29:18 -0400 (EDT) 30 | Received: (qmail 5171 invoked from network); 20 Jun 2005 22:29:07 -0400 31 | Received: from lws (192.168.0.25) 32 | by lws with SMTP; 20 Jun 2005 22:29:07 -0400 33 | Subject: Re: gcc options when building DBD:Oracle 34 | From: "Lincoln A. Baxter" 35 | Reply-To: lab@lincolnbaxter.com 36 | To: jriekenberg@everestkc.net 37 | Cc: Tim Bunce 38 | In-Reply-To: 39 | References: 40 | Content-Type: text/plain 41 | Date: Mon, 20 Jun 2005 22:29:07 -0400 42 | Message-Id: <1119320947.17452.484.camel@lws> 43 | Mime-Version: 1.0 44 | X-Mailer: Evolution 2.2.1.1 45 | Content-Transfer-Encoding: 7bit 46 | X-Virus-Scanned: Symantec AntiVirus Scan Engine 47 | Status: RO 48 | Content-Length: 2011 49 | Lines: 38 50 | 51 | Hi Jan, 52 | 53 | This looks like something that might be relatively easy to fix in 54 | Makefile.PL. But I no longer have access to HPUX systems, and never 55 | built DBD-Oracle with gcc on that platform. I could add your message to 56 | the README.hpux file, but it is becoming less and less necessary to read 57 | this file with newer versions of DBD-Oracle, in which Makefile.PL has 58 | been made much smarter. 59 | 60 | Would you consider sending Tim or me a patch to Makefile.PL that 61 | generates the right $(LD) command (only on HP rp8400, and only for your 62 | version of gcc or later? 63 | 64 | Lincoln 65 | 66 | On Mon, 2005-06-20 at 15:36 -0500, jriekenberg@everestkc.net wrote: 67 | > Lincoln, 68 | > 69 | > 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: 70 | > 71 | > $(LD) -Xlinker +b -Xlinker "$(LD_RUN_PATH)" $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) 72 | > 73 | > Running "make" now works correctly. 74 | > 75 | > Also, "make test" returned the following error when attempting to build the various tests: 76 | > 77 | > /usr/lib/dld.sl: Can't shl_load() a library containing Thread Local Storage: /usr/lib/libcl.2 78 | > 79 | > Setting LD_PRELOAD with "export LD_PRELOAD=/usr/lib/libcl.2" corrected this problem, and "make test" worked correctly. 80 | > 81 | > 82 | > 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. 83 | > 84 | > Jon Riekenberg 85 | > 86 | > 87 | > 88 | 89 | 90 | -------------------------------------------------------------------------------- /t/51scroll.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use Test::More; 5 | use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); 6 | use DBI; 7 | 8 | unshift @INC ,'t'; 9 | require 'nchar_test_lib.pl'; 10 | 11 | ## ---------------------------------------------------------------------------- 12 | ## 51scroll.t 13 | ## By John Scoles, The Pythian Group 14 | ## ---------------------------------------------------------------------------- 15 | ## Just a few checks to see if one can use a scrolling cursor 16 | ## Nothing fancy. 17 | ## ---------------------------------------------------------------------------- 18 | 19 | # create a database handle 20 | my $dsn = oracle_test_dsn(); 21 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 22 | my $dbh; 23 | eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, 24 | AutoCommit=>1, 25 | PrintError => 0 })}; 26 | if ($dbh) { 27 | plan skip_all => "Scrollable cursors new in Oracle 9" 28 | if $dbh->func('ora_server_version')->[0] < 9; 29 | plan tests => 37; 30 | } else { 31 | plan skip_all => "Unable to connect to Oracle"; 32 | } 33 | ok ($dbh->{RowCacheSize} = 10); 34 | 35 | # check that our db handle is good 36 | isa_ok($dbh, "DBI::db"); 37 | 38 | my $table = table(); 39 | 40 | 41 | $dbh->do(qq{ 42 | CREATE TABLE $table ( 43 | id INTEGER ) 44 | }); 45 | 46 | 47 | my ($sql, $sth,$value); 48 | my $i=0; 49 | $sql = "INSERT INTO ".$table." VALUES (?)"; 50 | 51 | $sth =$dbh-> prepare($sql); 52 | 53 | $sth->execute($_) foreach (1..10); 54 | 55 | $sql="select * from ".$table; 56 | ok($sth=$dbh->prepare($sql, 57 | {ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, 58 | ora_prefetch_memory=>200})); 59 | ok ($sth->execute()); 60 | 61 | #first loop all the way forward with OCI_FETCH_NEXT 62 | foreach (1..10) { 63 | $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); 64 | is($value->[0], $_, '... we should get the next record'); 65 | } 66 | $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0); 67 | cmp_ok($value->[0], '==', 10, '... we should get the 10th record'); 68 | 69 | # fetch off the end of the result-set 70 | $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT, 0); 71 | is($value, undef, "end of result-set"); 72 | 73 | #now loop all the way back 74 | for($i=1;$i<=9;$i++){ 75 | $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0); 76 | cmp_ok($value->[0], '==', 10-$i, '... we should get the prior record'); 77 | } 78 | 79 | #now +4 records relative from the present position of 0; 80 | 81 | $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,4); 82 | cmp_ok($value->[0], '==', 5, '... we should get the 5th record'); 83 | 84 | #now +2 records relative from the present position of 4; 85 | 86 | $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2); 87 | cmp_ok($value->[0], '==', 7, '... we should get the 7th record'); 88 | 89 | #now -3 records relative from the present position of 6; 90 | 91 | $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-3); 92 | 93 | cmp_ok($value->[0], '==', 4, '... we should get the 4th record'); 94 | 95 | #now get the 9th record from the start 96 | $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,9); 97 | 98 | cmp_ok($value->[0], '==', 9, '... we should get the 9th record'); 99 | 100 | #now get the last record 101 | 102 | $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0); 103 | 104 | cmp_ok($value->[0], '==', 10, '... we should get the 10th record'); 105 | 106 | #now get the ora_scroll_position 107 | 108 | cmp_ok($sth->ora_scroll_position(), '==', 10, '... we should get the 10 for the ora_scroll_position'); 109 | 110 | #now back to the first 111 | 112 | $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0); 113 | cmp_ok($value->[0], '==', 1, '... we should get the 1st record'); 114 | 115 | #check the ora_scroll_position one more time 116 | 117 | cmp_ok($sth->ora_scroll_position(), '==', 1, '... we should get the 1 for the ora_scroll_position'); 118 | 119 | # rt 76695 - fetch after fetch scroll maintains offset 120 | # now fetch forward 2 places then just call fetch 121 | # it should give us the 4th rcord and not the 5th 122 | 123 | $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2); 124 | is($value->[0], 3, '... we should get the 3rd record rt76695'); 125 | ($value) = $sth->fetchrow; 126 | is($value, 4, '... we should get the 4th record rt 76695'); 127 | 128 | # rt 76410 - fetch after fetch absolute always returns the same row 129 | $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE, 2); 130 | is($value->[0], 2, "... we should get the 2nd row rt76410_2"); 131 | ($value) = $sth->fetchrow; 132 | is($value, 3, "... we should get the 3rd row rt76410_2"); 133 | 134 | $sth->finish(); 135 | drop_table($dbh); 136 | 137 | 138 | $dbh->disconnect; 139 | 140 | 1; 141 | 142 | -------------------------------------------------------------------------------- /t/40ph_type.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use Test::More; 3 | 4 | use strict; 5 | use DBI qw(neat); 6 | use DBD::Oracle qw(ORA_OCI); 7 | use vars qw($tests); 8 | 9 | unshift @INC ,'t'; 10 | require 'nchar_test_lib.pl'; 11 | 12 | $| = 1; 13 | $^W = 1; 14 | 15 | # XXX ought to extend tests to check 'blank padded comparision semantics' 16 | my @tests = ( 17 | # type: oracle internal type to use for placeholder values 18 | # name: oracle name for type above 19 | # chops_space: set true if type trims trailing space characters 20 | # embed_nul: set true if type allows embedded nul characters 21 | # (also SKIP=1 to skip test, ti=N to trace insert, ts=N to trace select) 22 | { type=> 1, name=>"VARCHAR2", chops_space=>1, embed_nul=>1, }, # current DBD::Oracle 23 | { type=> 5, name=>"STRING", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 }, # old Oraperl 24 | { type=>96, name=>"CHAR", chops_space=>0, embed_nul=>1, }, 25 | { type=>97, name=>"CHARZ", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 }, 26 | ); 27 | 28 | $tests = 3; 29 | $_->{SKIP} or $tests+=8 for @tests; 30 | 31 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 32 | my $dsn = oracle_test_dsn(); 33 | my $dbh = DBI->connect($dsn, $dbuser, '', { 34 | AutoCommit => 0, 35 | PrintError => 0, 36 | FetchHashKeyName => 'NAME_lc', 37 | }); 38 | 39 | if ($dbh) { 40 | plan tests => $tests; 41 | } else { 42 | plan skip_all => 43 | "Unable to connect to Oracle"; 44 | } 45 | 46 | eval { 47 | require Data::Dumper; 48 | $Data::Dumper::Useqq = $Data::Dumper::Useqq =1; 49 | $Data::Dumper::Terse = $Data::Dumper::Terse =1; 50 | $Data::Dumper::Indent= $Data::Dumper::Indent=1; 51 | }; 52 | 53 | my ($sth,$tmp); 54 | my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); 55 | 56 | # drop table but don't warn if not there 57 | eval { 58 | local $dbh->{PrintError} = 0; 59 | $dbh->do("DROP TABLE $table"); 60 | }; 61 | 62 | ok($dbh->do("CREATE TABLE $table (name VARCHAR2(2), vc VARCHAR2(20), c CHAR(20))"), 'create test table'); 63 | 64 | my $val_with_trailing_space = "trailing "; 65 | my $val_with_embedded_nul = "embedded\0nul"; 66 | 67 | for my $test_info (@tests) { 68 | next if $test_info->{SKIP}; 69 | 70 | my $ph_type = $test_info->{type} || die; 71 | my $name = $test_info->{name} || die; 72 | note("\ntesting @{[ %$test_info ]} ...\n\n"); 73 | 74 | SKIP: { 75 | skip "skipping tests", 12 if ($test_info->{SKIP}); 76 | 77 | $dbh->{ora_ph_type} = $ph_type; 78 | ok($dbh->{ora_ph_type} == $ph_type, 'set ora_ph_type'); 79 | 80 | $sth = $dbh->prepare("INSERT INTO $table(name,vc,c) VALUES (?,?,?)"); 81 | $sth->trace($test_info->{ti}) if $test_info->{ti}; 82 | $sth->execute("ts", $val_with_trailing_space, $val_with_trailing_space); 83 | $sth->execute("en", $val_with_embedded_nul, $val_with_embedded_nul); 84 | $sth->execute("es", '', ''); # empty string 85 | $sth->trace(0) if $test_info->{ti}; 86 | 87 | $dbh->trace($test_info->{ts}) if $test_info->{ts}; 88 | $tmp = $dbh->selectall_hashref(qq{ 89 | SELECT name, vc, length(vc) as len, nvl(vc,'ISNULL') as isnull, c 90 | FROM $table}, "name"); 91 | ok(keys(%$tmp) == 3, 'right keys'); 92 | $dbh->trace(0) if $test_info->{ts}; 93 | $dbh->rollback; 94 | 95 | delete $_->{name} foreach values %$tmp; 96 | note(Data::Dumper::Dumper($tmp)); 97 | 98 | # check trailing_space behaviour 99 | my $expect = $val_with_trailing_space; 100 | $expect =~ s/\s+$// if $test_info->{chops_space}; 101 | my $ok = ($tmp->{ts}->{vc} eq $expect); 102 | if (!$ok && $ph_type==1 && $name eq 'VARCHAR2') { 103 | note " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies with Oracle version.\n" 104 | . " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n" 105 | . " Your system doesn't. If that seems odd, let us know.\n"; 106 | $ok = 1; 107 | } 108 | ok($ok, sprintf(" using ora_type %d expected %s but got %s for $name", 109 | $ph_type, neat($expect), neat($tmp->{ts}->{vc})) ); 110 | 111 | # check embedded nul char behaviour 112 | $expect = $val_with_embedded_nul; 113 | $expect =~ s/\0.*// unless $test_info->{embed_nul}; 114 | is($tmp->{en}->{vc}, $expect, sprintf(" expected %s but got %s for $name", 115 | neat($expect),neat($tmp->{en}->{vc})) ); 116 | 117 | # check empty string is NULL (irritating Oracle behaviour) 118 | ok(!defined $tmp->{es}->{vc}, 'vc defined'); 119 | ok(!defined $tmp->{es}->{c}, 'c defined'); 120 | ok(!defined $tmp->{es}->{len}, 'len defined'); 121 | is($tmp->{es}->{isnull}, 'ISNULL', 'ISNULL'); 122 | 123 | exit 1 if $test_info->{ti} || $test_info->{ts}; 124 | } 125 | } 126 | 127 | ok($dbh->do("DROP TABLE $table"), 'drop table'); 128 | ok($dbh->disconnect, 'disconnect'); 129 | 130 | 131 | __END__ 132 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Troubleshooting.pod: -------------------------------------------------------------------------------- 1 | #PODNAME: DBD::Oracle::Troubleshooting 2 | #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle 3 | 4 | =head1 CONNECTING TO ORACLE 5 | 6 | If you are reading this it is assumed that you have successfully 7 | installed DBD::Oracle and you are having some problems connecting to 8 | Oracle. 9 | 10 | First off you will have to tell DBD::Oracle where the binaries reside 11 | for the Oracle client it was compiled against. This is the case when 12 | you encounter a 13 | 14 | DBI connect('','system',...) failed: ERROR OCIEnvNlsCreate. 15 | 16 | error in Linux or in Windows when you get 17 | 18 | OCI.DLL not found 19 | 20 | The solution to this problem in the case of Linux is to ensure your 21 | 'ORACLE_HOME' (or LD_LIBRARY_PATH for InstantClient) environment 22 | variable points to the correct directory. 23 | 24 | export ORACLE_HOME=/app/oracle/product/xx.x.x 25 | 26 | For Windows the solution is to add this value to you PATH 27 | 28 | PATH=c:\app\oracle\product\xx.x.x;%PATH% 29 | 30 | 31 | If you get past this stage and get a 32 | 33 | ORA-12154: TNS:could not resolve the connect identifier specified 34 | 35 | error then the most likely cause is DBD::ORACLE cannot find your .ORA 36 | (F, F, F) files. This can be 37 | solved by setting the TNS_ADMIN environment variable to the directory 38 | where these files can be found. 39 | 40 | If you get to this stage and you have either one of the following 41 | errors; 42 | 43 | ORA-12560: TNS:protocol adapter error 44 | ORA-12162: TNS:net service name is incorrectly specified 45 | 46 | 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. 47 | 48 | =head2 Oracle utilities 49 | 50 | If you are still having problems connecting then the Oracle adapters 51 | utility may offer some help. Run these two commands: 52 | 53 | $ORACLE_HOME/bin/adapters 54 | $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/sqlplus 55 | 56 | and check the output. The "Protocol Adapters" should include at least "IPC Protocol Adapter" and "TCP/IP 57 | Protocol Adapter". 58 | 59 | If it generates any errors which look relevant then please talk to your 60 | Oracle technical support (and not the dbi-users mailing list). 61 | 62 | =head2 Connecting using a bequeather 63 | 64 | If you are using a bequeather to connect to a server 65 | on the same host as the client, you might have 66 | to add 67 | 68 | bequeath_detach = yes 69 | 70 | to your sqlnet.ora file or you won't be able to safely use fork/system 71 | functions in Perl. 72 | 73 | See the discussion at 74 | L 75 | and L 76 | for more gory details. 77 | 78 | 79 | =head1 USING THE LONG TYPES 80 | 81 | Some examples related to the use of LONG types are available in 82 | the C directory of the distribution. 83 | 84 | =head1 Can't find I 85 | 86 | I is the shared 87 | library composed of all the other Oracle libs you used to have to 88 | statically link. 89 | libclntsh.so should be in I<$ORACLE_HOME/lib>. If it's missing, try 90 | running I<$ORACLE_HOME/lib/genclntsh.sh> and it should create it. 91 | 92 | Never copy I to a different machine or Oracle version. 93 | If DBD::Oracle was built on a machine with a different path to I 94 | then you'll need to set an environment variable, typically 95 | I, to include the directory containing I. 96 | 97 | I is typically ignored if the script is running set-uid 98 | (which is common in some httpd/CGI configurations). In this case 99 | either rebuild with I set to include the path to I 100 | or create a symbolic link so that I is available via the same 101 | path as it was when the module was built. (On Solaris the command 102 | "ldd -s Oracle.so" can be used to see how the linker is searching for it.) 103 | 104 | =head1 Miscellaneous 105 | 106 | =head2 Crash with an open connection and Module::Runtime in mod_perl2 107 | 108 | See RT 72989 (https://rt.cpan.org/Ticket/Display.html?id=72989) 109 | 110 | Apache2 MPM Prefork with mod_perl2 will crash if Module::Runtime is 111 | loaded, and an Oracle connection is opened through PerlRequire (before 112 | forking). 113 | 114 | It looks like this was fixed in 0.012 of Module::Runtime. 115 | 116 | =head2 bind_param_inout swapping return values 117 | 118 | See RT 71819 (https://rt.cpan.org/Ticket/Display.html?id=71819) 119 | 120 | It seems that in some older versions of Oracle Instant Client 121 | (certainly 10.2.0.4.0) when output parameters are bound with lengths 122 | greater than 3584 the output parameters can be returned in the wrong 123 | placeholders. 124 | 125 | It is reported fixed in Instant Client 11.2.0.2.0. 126 | -------------------------------------------------------------------------------- /t/14threads.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | $| = 1; 3 | 4 | ## ---------------------------------------------------------------------------- 5 | ## 14threads.t 6 | ## By Jeffrey Klein, 7 | ## ---------------------------------------------------------------------------- 8 | 9 | BEGIN { eval "use threads; use threads::shared;" } 10 | my $use_threads_err = $@; 11 | use DBI; 12 | use Config qw(%Config); 13 | use Test::More; 14 | 15 | BEGIN { 16 | if ( !$Config{useithreads} || $] < 5.008 ) { 17 | plan skip_all => "this $^O perl $] not configured to support iThreads"; 18 | } elsif ($DBI::VERSION <= 1.601){ 19 | plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later."; 20 | } 21 | die $use_threads_err if $use_threads_err; # need threads 22 | } 23 | 24 | use strict; 25 | use DBI; 26 | 27 | use Test::More; 28 | 29 | unshift @INC, 't'; 30 | require 'nchar_test_lib.pl'; 31 | 32 | my $dsn = oracle_test_dsn(); 33 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 34 | my $dbh = DBI->connect($dsn, $dbuser, '',{ 35 | PrintError => 0, 36 | }); 37 | 38 | if ($dbh) { 39 | plan tests => 19; 40 | $dbh->disconnect; 41 | } else { 42 | plan skip_all => "Unable to connect to Oracle"; 43 | } 44 | 45 | my $last_session : shared; 46 | our @pool : shared; 47 | 48 | # run five threads in sequence 49 | # each should get the same session 50 | 51 | # TESTS: 5 52 | 53 | for my $i ( 0 .. 4 ) { 54 | threads->create( 55 | sub { 56 | my $dbh = get_dbh_from_pool(); 57 | 58 | my $session = session_id($dbh); 59 | 60 | if ( $i > 0 ) { 61 | is $session, $last_session, 62 | "session $i matches previous session"; 63 | } else { 64 | ok $session, "session $i created", 65 | } 66 | 67 | $last_session = $session; 68 | free_dbh_to_pool($dbh); 69 | } 70 | )->join; 71 | 72 | 73 | } 74 | 75 | # TESTS: 1 76 | is scalar(@pool), 1, 'one imp_data in pool'; 77 | 78 | # get two sessions in same thread 79 | # TESTS: 2 80 | threads->create( 81 | sub { 82 | my $dbh1 = get_dbh_from_pool(); 83 | my $s1 = session_id($dbh1); 84 | 85 | my $dbh2 = get_dbh_from_pool(); 86 | my $s2 = session_id($dbh2); 87 | 88 | ok $s1 ne $s2, 'thread gets two separate sessions'; 89 | 90 | free_dbh_to_pool($dbh1); 91 | 92 | my $dbh3 = get_dbh_from_pool(); 93 | my $s3 = session_id($dbh3); 94 | 95 | is $s3, $s1, 'get same session after free'; 96 | 97 | free_dbh_to_pool($dbh2); 98 | free_dbh_to_pool($dbh3); 99 | } 100 | )->join; 101 | 102 | # TESTS: 1 103 | is scalar(@pool), 2, 'two imp_data in pool'; 104 | 105 | #trade dbh between threads 106 | my @thr; 107 | my @sem; 108 | use Thread::Semaphore; 109 | 110 | # create locked semaphores 111 | for my $i (0..2) { 112 | push @sem, Thread::Semaphore->new(0); 113 | } 114 | 115 | undef $last_session; 116 | 117 | # 3 threads, 3 iterations 118 | # TESTS: 9 119 | for my $t ( 0..2 ) { 120 | $thr[$t] = threads->create( 121 | sub { 122 | my $partner = ( $t + 1 ) % 3; 123 | 124 | for my $i ( 1 .. 3 ) { 125 | $sem[$t]->down; 126 | 127 | my $dbh = get_dbh_from_pool(); 128 | my $session = session_id($dbh); 129 | if ( defined $last_session ) { 130 | is $session, $last_session, 131 | "thread $t, loop $i matches previous session"; 132 | } else { 133 | ok $session, 134 | "thread $t, loop $i created session"; 135 | } 136 | $last_session = $session; 137 | free_dbh_to_pool($dbh); 138 | 139 | # signal next thread 140 | $sem[$partner]->up; 141 | } 142 | } 143 | ); 144 | } 145 | 146 | # start thread 0! 147 | $sem[0]->up; 148 | 149 | $_->join for @thr; 150 | 151 | # TESTS: 1 152 | empty_pool(); 153 | 154 | is scalar(@pool), 0, 'pool empty'; 155 | 156 | exit; 157 | 158 | sub get_dbh_from_pool { 159 | my $imp = pop @pool; 160 | 161 | # if pool is empty, $imp is undef 162 | # in that case, get new dbh 163 | return connect_dbh($imp); 164 | } 165 | 166 | sub free_dbh_to_pool { 167 | my $imp = $_[0]->take_imp_data or return; 168 | push @pool, $imp; 169 | } 170 | 171 | sub empty_pool { 172 | get_dbh_from_pool() while @pool; 173 | } 174 | 175 | sub connect_dbh { 176 | my $imp_data = shift; 177 | my $dsn = oracle_test_dsn(); 178 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 179 | DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } ); 180 | } 181 | 182 | sub session_id { 183 | my $dbh = shift; 184 | my ($s) = $dbh->selectrow_array("select userenv('sessionid') from dual"); 185 | return $s; 186 | } 187 | __END__ 188 | -------------------------------------------------------------------------------- /Oracle.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (c) 1994-2006 Tim Bunce 3 | 4 | See the COPYRIGHT section in the Oracle.pm file for terms. 5 | 6 | */ 7 | 8 | /* ====== Include Oracle Header Files ====== */ 9 | 10 | #ifndef CAN_PROTOTYPE 11 | #define signed /* Oracle headers use signed */ 12 | #endif 13 | 14 | /* The following define avoids a problem with Oracle >=7.3 where 15 | * ociapr.h has the line: 16 | * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ... 17 | * In some compilers that clashes with perls 'opcode' enum definition. 18 | */ 19 | #define opcode opcode_redefined 20 | 21 | /* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */ 22 | #if defined(__osf__) && defined(__alpha) 23 | #ifndef A_OSF 24 | #define A_OSF 25 | #endif 26 | #endif 27 | 28 | /* egcs-1.1.2 does not have _int64 */ 29 | #if defined(__MINGW32__) || defined(__CYGWIN32__) 30 | #define _int64 long long 31 | #endif 32 | 33 | 34 | /* ori.h uses 'dirty' as an arg name in prototypes so we use this */ 35 | /* hack to prevent ori.h being read (since we don't need it) */ 36 | /*#define ORI_ORACLE*/ 37 | #include 38 | #include 39 | #include 40 | #include 41 | #include 42 | 43 | /* ------ end of Oracle include files ------ */ 44 | 45 | 46 | #define NEED_DBIXS_VERSION 93 47 | 48 | #define PERL_NO_GET_CONTEXT /*for Threaded Perl */ 49 | 50 | #include /* installed by the DBI module */ 51 | 52 | #include "dbdimp.h" 53 | 54 | #include "dbivport.h" 55 | 56 | #include /* installed by the DBI module */ 57 | 58 | /* These prototypes are for dbdimp.c funcs used in the XS file */ 59 | /* These names are #defined to driver specific names in dbdimp.h */ 60 | 61 | void dbd_init _((dbistate_t *dbistate)); 62 | void dbd_init_oci_drh _((imp_drh_t * imp_drh)); 63 | 64 | int dbd_db_login _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd)); 65 | int dbd_db_do _((SV *sv, char *statement)); 66 | int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh)); 67 | int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh)); 68 | int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs); 69 | int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh)); 70 | void dbd_db_destroy _((SV *dbh, imp_dbh_t *imp_dbh)); 71 | int dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)); 72 | SV *dbd_db_FETCH_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)); 73 | 74 | int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, 75 | char *statement, SV *attribs)); 76 | int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth)); 77 | int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth)); 78 | int dbd_st_cancel _((SV *sth, imp_sth_t *imp_sth)); 79 | AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth)); 80 | 81 | int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth)); 82 | void dbd_st_destroy _((SV *sth, imp_sth_t *imp_sth)); 83 | int dbd_st_blob_read _((SV *sth, imp_sth_t *imp_sth, 84 | int field, long offset, long len, SV *destrv, long destoffset)); 85 | int dbd_st_STORE_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)); 86 | SV *dbd_st_FETCH_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv)); 87 | int dbd_bind_ph _((SV *sth, imp_sth_t *imp_sth, 88 | SV *param, SV *value, IV sql_type, SV *attribs, int is_inout, IV maxlen)); 89 | 90 | int dbd_db_login6 _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd, SV *attr)); 91 | int dbd_describe _((SV *sth, imp_sth_t *imp_sth)); 92 | ub4 ora_blob_read_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, 93 | long offset, UV len, long destoffset)); 94 | ub4 ora_blob_read_mb_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, 95 | long offset, ub4 len, long destoffset)); 96 | 97 | /* Oracle types */ 98 | #define ORA_VARCHAR2 1 99 | #define ORA_STRING 5 100 | #define ORA_NUMBER 2 101 | #define ORA_LONG 8 102 | #define ORA_ROWID 11 103 | #define ORA_DATE 12 104 | #define ORA_RAW 23 105 | #define ORA_LONGRAW 24 106 | #define ORA_CHAR 96 107 | #define ORA_CHARZ 97 108 | #define ORA_MLSLABEL 105 109 | #define ORA_CLOB 112 110 | #define ORA_BLOB 113 111 | #define ORA_BFILE 114 112 | #define ORA_RSET 116 113 | #define ORA_VARCHAR2_TABLE 201 114 | #define ORA_NUMBER_TABLE 202 115 | #define ORA_XMLTYPE 108 116 | 117 | 118 | 119 | 120 | /* other Oracle not in noraml API defines 121 | 122 | most of these are largly undocumented XML functions that are in the API but not defined 123 | not noramlly found in the defines the prototypes of OCI functions in most clients 124 | Normally can be found in ociap.h (Oracle Call Interface - Ansi Prototypes 125 | ) and ocikp.h (functions in K&R style) 126 | 127 | They will be added when needed 128 | 129 | */ 130 | 131 | sword OCIXMLTypeCreateFromSrc( OCISvcCtx *svchp, OCIError *errhp, 132 | OCIDuration dur, ub1 src_type, dvoid *src_ptr, 133 | sb4 ind, OCIXMLType **retInstance ); 134 | 135 | 136 | /* end of Oracle.h */ 137 | -------------------------------------------------------------------------------- /examples/proc.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # Short examples of procedure calls from Oracle.pm 3 | # These PL/SQL examples come from: Eric Bartley . 4 | 5 | use DBI; 6 | 7 | use strict; 8 | 9 | # Set trace level if '-# trace_level' option is given 10 | DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; 11 | 12 | die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; 13 | my ( $inst, $user, $pass ) = @ARGV; 14 | 15 | # So we don't have to check every DBI call we set RaiseError. 16 | # See the DBI docs if you're not familiar with RaiseError. 17 | # AutoCommit is currently encouraged and may be required later. 18 | my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, 19 | { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) 20 | or die "Unable to connect: $DBI::errstr"; 21 | 22 | # Create the package for the examples 23 | $dbh->do( <do( <prepare( q{ 70 | BEGIN 71 | plsql_example.proc_np; 72 | END; 73 | } ); 74 | $sth->execute; 75 | 76 | 77 | print "\nExample 2\n"; 78 | # Now we call a procedure that has 1 IN parameter. Here we use bind_param 79 | # to bind out parameter to the prepared statement just like you might 80 | # do for an INSERT, UPDATE, DELETE, or SELECT statement. 81 | # 82 | # I could have used positional placeholders (e.g. :1, :2, etc.) or 83 | # ODBC style placeholders (e.g. ?), but I prefer Oracle's named 84 | # placeholders (but few DBI drivers support them so they're not portable). 85 | # 86 | # proc_in() will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'. 87 | # Because we set RaiseError, the DBI will die() so we catch that with eval {}. 88 | 89 | my $err_code = -20001; 90 | 91 | $sth = $dbh->prepare( q{ 92 | BEGIN 93 | plsql_example.proc_in( :err_code ); 94 | END; 95 | } ); 96 | $sth->bind_param( ":err_code", $err_code ); 97 | eval { $sth->execute; }; 98 | print 'After proc_in: $@ = ', "'$@', errstr = '$DBI::errstr'\n"; 99 | 100 | 101 | print "\nExample 3\n"; 102 | # Building on the last example, I've added 1 IN OUT parameter. We still 103 | # use a placeholders in the call to prepare, the difference is that 104 | # we now call bind_param_inout to bind the value to the place holder. 105 | # 106 | # Note that the third parameter to bind_param_inout is the maximum size 107 | # of the variable. You normally make this slightly larger than necessary. 108 | # But note that the perl variable will have that much memory assigned to 109 | # it even if the actual value returned is shorter. 110 | 111 | my $test_num = 5; 112 | my $is_odd; 113 | 114 | $sth = $dbh->prepare( q{ 115 | BEGIN 116 | plsql_example.proc_in_inout( :test_num, :is_odd ); 117 | END; 118 | } ); 119 | 120 | # The value of $test_num is _copied_ here 121 | $sth->bind_param( ":test_num", $test_num ); 122 | $sth->bind_param_inout( ":is_odd", \$is_odd, 1 ); 123 | 124 | # The execute will automagically update the value of $is_odd 125 | $sth->execute; 126 | print "$test_num is ", $is_odd ? "odd - ok" : "even - error!", "\n"; 127 | 128 | 129 | print "\nExample 4\n"; 130 | # What about the return value of a PL/SQL function? Well treat it the same 131 | # as you would a call to a function from SQL*Plus. We add a placeholder 132 | # for the return value and bind it with a call to bind_param_inout so 133 | # we can access it's value after execute. 134 | 135 | my $whoami = ""; 136 | 137 | $sth = $dbh->prepare( q{ 138 | BEGIN 139 | :whoami := plsql_example.func_np; 140 | END; 141 | } ); 142 | $sth->bind_param_inout( ":whoami", \$whoami, 30 ); 143 | $sth->execute; 144 | print "Your database user name is $whoami\n"; 145 | 146 | # Get rid of the example package 147 | $dbh->do( 'DROP PACKAGE plsql_example' ); 148 | $dbh->disconnect; 149 | -------------------------------------------------------------------------------- /t/36lob_leak.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | 3 | ##---------------------------------------------------------------------------- 4 | ## 36lob_leak.pl 5 | ## By Martin Evans, Easysoft Limited 6 | ##---------------------------------------------------------------------------- 7 | ## Test we are not leaking temporary lobs 8 | ##---------------------------------------------------------------------------- 9 | 10 | use Test::More; 11 | 12 | use DBI; 13 | use Config; 14 | use DBD::Oracle qw(:ora_types); 15 | use strict; 16 | use warnings; 17 | use Data::Dumper; 18 | 19 | unshift @INC ,'t'; 20 | require 'nchar_test_lib.pl'; 21 | 22 | $| = 1; 23 | 24 | my $dsn = oracle_test_dsn(); 25 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 26 | my $dbh = DBI->connect($dsn, $dbuser, '',,{ 27 | PrintError => 0, 28 | }); 29 | 30 | if ($dbh) { 31 | plan tests => 7; 32 | } else { 33 | $dbh->{PrintError}=1; 34 | plan skip_all => "Unable to connect to Oracle"; 35 | } 36 | 37 | # get SID and cached lobs 38 | # if sid not passed in we run 2 tests, get the sid and the cached lobs 39 | # if sid passed in we run 1 test which is to get the cached lobs 40 | sub get_cached_lobs 41 | { 42 | my ($dbh, $sid) = @_; 43 | my $cached_lobs; 44 | 45 | if (!defined($sid)) { 46 | SKIP: { 47 | eval { 48 | ($sid) = $dbh->selectrow_array( 49 | q/select sid from v$session where audsid = 50 | SYS_CONTEXT('userenv', 'sessionid')/); 51 | }; 52 | skip 'unable to find sid', 2 if ($@ || !defined($sid)); 53 | 54 | pass("found sid $sid"); 55 | }; 56 | } 57 | if (defined($sid)) { 58 | SKIP: { 59 | eval { 60 | $cached_lobs = $dbh->selectrow_array( 61 | q/select CACHE_LOBS from V$TEMPORARY_LOBS where sid 62 | = ?/, undef, $sid); 63 | }; 64 | skip 'unable to find cached lobs', 1 65 | if ($@ || !defined($cached_lobs)); 66 | pass("found $cached_lobs cached lobs"); 67 | }; 68 | } 69 | return ($sid, $cached_lobs); 70 | } 71 | 72 | sub setup_test 73 | { 74 | my ($h) = @_; 75 | my ($sth, $ev); 76 | 77 | my $fn = 'p_DBD_Oracle_drop_me'; 78 | 79 | my $createproc = << "EOT"; 80 | CREATE OR REPLACE FUNCTION $fn(pc IN CLOB) RETURN NUMBER AS 81 | BEGIN 82 | NULL; 83 | RETURN 0; 84 | END; 85 | EOT 86 | 87 | eval {$h->do($createproc);}; 88 | BAIL_OUT("Failed to create test function - $@") if $@; 89 | pass("created test function"); 90 | 91 | return $fn; 92 | } 93 | 94 | sub call_func 95 | { 96 | my ($dbh, $function, $how) = @_; 97 | 98 | eval { 99 | my $sth; 100 | my $sql = qq/BEGIN ? := $function(?); END;/; 101 | if ($how eq 'prepare') { 102 | $sth = $dbh->prepare($sql) or die($dbh->errstr); 103 | } elsif ($how eq 'prepare_cached') { 104 | $sth = $dbh->prepare_cached($sql) or die($dbh->errstr); 105 | } else { 106 | BAIL_OUT("Unknown prepare type $how"); 107 | } 108 | $sth->{RaiseError} = 1; 109 | 110 | BAIL_OUT("Cannot prepare a call to $function") if !$sth; 111 | 112 | my ($return, $clob); 113 | $clob = 'x' x 1000; 114 | $sth->bind_param_inout(1, \$return, 10); 115 | $sth->bind_param(2, $clob, {ora_type => ORA_CLOB}); 116 | $sth->execute; 117 | }; 118 | BAIL_OUT("Cannot call $function successfully") if $@; 119 | } 120 | 121 | 122 | my ($sid, $cached_lobs); 123 | my ($function); 124 | SKIP: { 125 | ($sid, $cached_lobs) = get_cached_lobs($dbh); # 1 2 126 | skip 'Cannot find sid/cached lobs', 5 if !defined($cached_lobs); 127 | 128 | $function = setup_test($dbh); # 3 129 | my $new_cached_lobs; 130 | 131 | foreach my $type (qw(prepare prepare_cached)) { 132 | for my $count(1..100) { 133 | call_func($dbh, $function, $type); 134 | }; 135 | ($sid, $new_cached_lobs) = get_cached_lobs($dbh, $sid); 136 | 137 | # we expect to leak 1 temporary lob as the last statement is 138 | # cached and the temp lob is not thrown away until you next 139 | # execute 140 | if ($new_cached_lobs > ($cached_lobs + 1)) { 141 | diag("Looks like we might be leaking temporary lobs from 142 | $type"); 143 | fail("old cached lobs: $cached_lobs " . 144 | "new cached lobs: $new_cached_lobs"); 145 | } else { 146 | pass("Not leaking temporary lobs on $type"); 147 | } 148 | $cached_lobs = $new_cached_lobs; 149 | } 150 | 151 | }; 152 | 153 | END { 154 | if ($dbh) { 155 | local $dbh->{PrintError} = 0; 156 | local $dbh->{RaiseError} = 1; 157 | if ($function){ 158 | eval {$dbh->do(qq/drop function $function/);}; 159 | if ($@) { 160 | diag("function p_DBD_Oracle_drop_me possibly not dropped" . 161 | "- check - $@\n") if $dbh->err ne '4043'; 162 | } else { 163 | note("function p_DBD_Oracle_drop_me dropped"); 164 | } 165 | } 166 | } 167 | } 168 | -------------------------------------------------------------------------------- /t/20select.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use Test::More; 3 | use DBI; 4 | use DBD::Oracle qw(:ora_types ORA_OCI); 5 | use Data::Dumper; 6 | use Math::BigInt; 7 | use strict; 8 | 9 | unshift @INC ,'t'; 10 | require 'nchar_test_lib.pl'; 11 | 12 | $| = 1; 13 | 14 | my @test_sets = ( 15 | [ "CHAR(10)", 10 ], 16 | [ "VARCHAR(10)", 10 ], 17 | [ "VARCHAR2(10)", 10 ], 18 | ); 19 | 20 | # Set size of test data (in 10KB units) 21 | # Minimum value 3 (else tests fail because of assumptions) 22 | # Normal value 8 (to test 64KB threshold well) 23 | my $sz = 8; 24 | 25 | my $tests = 3; 26 | my $tests_per_set = 11; 27 | $tests += @test_sets * $tests_per_set; 28 | 29 | my $t = 0; 30 | my $failed = 0; 31 | my %ocibug; 32 | my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); 33 | 34 | 35 | my $dsn = oracle_test_dsn(); 36 | my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; 37 | my $dbh = DBI->connect($dsn, $dbuser, '', { 38 | PrintError => 0, 39 | }); 40 | 41 | if ($dbh) { 42 | plan tests=>$tests; 43 | } else { 44 | plan skip_all => "Unable to connect to oracle\n"; 45 | } 46 | 47 | # test simple select statements with [utf8] 48 | 49 | my $utf8_test = ($] >= 5.006) 50 | && client_ochar_is_utf8() # for correct output (utf8 bind vars should be fine regardless) 51 | && ($dbh->ora_can_unicode() & 2); 52 | diag("Including unicode data in test") if $utf8_test; 53 | 54 | unless(create_test_table("str CHAR(10)", 1)) { 55 | BAIL_OUT("Unable to create test table ($DBI::errstr)\n"); 56 | print "1..0\n"; 57 | exit 0; 58 | } 59 | 60 | my($sth, $p1, $p2, $tmp, @tmp); 61 | 62 | foreach (@test_sets) { 63 | run_select_tests( @$_ ); 64 | } 65 | 66 | my $ora_server_version = $dbh->func("ora_server_version"); 67 | SKIP: { 68 | skip "Oracle < 10", 1 if ($ora_server_version->[0] < 10); 69 | my $data = $dbh->selectrow_array(q! 70 | select to_dsinterval(?) from dual 71 | !, {}, "1 07:00:00"); 72 | ok ((defined $data and $data eq '+000000001 07:00:00.000000000'), 73 | "ds_interval"); 74 | } 75 | 76 | if (0) { 77 | # UNION ALL causes Oracle 9 (not 8) to describe col1 as zero length 78 | # causing "ORA-24345: A Truncation or null fetch error occurred" error 79 | # Looks like an Oracle bug 80 | $dbh->trace(9); 81 | ok 0, $sth = $dbh->prepare(qq{ 82 | SELECT :HeadCrncy FROM DUAL 83 | UNION ALL 84 | SELECT :HeadCrncy FROM DUAL}); 85 | $dbh->trace(0); 86 | ok 0, $sth->execute("EUR"); 87 | ok 0, $tmp = $sth->fetchall_arrayref; 88 | use Data::Dumper; 89 | die Dumper $tmp; 90 | } 91 | 92 | 93 | # $dbh->{USER} is just there so it works for old DBI's before Username was added 94 | my @pk = $dbh->primary_key(undef, $dbh->{USER}||$dbh->{Username}, $table); 95 | ok(@pk, 'primary key on table'); 96 | is(join(",",@pk), 'DT,IDX', 'DT,IDX'); 97 | 98 | exit 0; 99 | 100 | END { 101 | $dbh->do(qq{ drop table $table }) if $dbh; 102 | } 103 | 104 | sub run_select_tests { 105 | my ($type_name, $field_len) = @_; 106 | 107 | my $data0; 108 | if ($utf8_test) { 109 | $data0 = eval q{ "0\x{263A}xyX" }; #this includes the smiley from perlunicode (lab) BTW: it is busted 110 | } else { 111 | $data0 = "0\177x\0X"; 112 | } 113 | my $data1 = "1234567890"; 114 | my $data2 = "2bcdefabcd"; 115 | 116 | SKIP: { 117 | if (!create_test_table("lng $type_name", 1)) { 118 | # typically OCI 8 client talking to Oracle 7 database 119 | diag("Unable to create test table for '$type_name' data ($DBI::err)"); 120 | skip $tests_per_set; 121 | } 122 | 123 | $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)"); 124 | ok($sth, "prepare for insert of $type_name"); 125 | ok($sth->execute(40, $data0), "insert 8bit or utf8"); 126 | ok($sth->execute(Math::BigInt->new(41), $data1), 'bind overloaded value'); 127 | ok($sth->execute(42, $data2), "insert data2"); 128 | 129 | ok(!$sth->execute(43, "12345678901234567890"), 'insert string too long'); 130 | 131 | ok($sth = $dbh->prepare("select * from $table order by idx"), 132 | "prepare select ordered by idx"); 133 | ok($sth->execute, "execute"); 134 | # allow for padded blanks 135 | $sth->{ChopBlanks} = 1; 136 | ok($tmp = $sth->fetchall_arrayref, 'fetchall'); 137 | my $dif; 138 | if ($utf8_test) { 139 | $dif = DBI::data_diff($tmp->[0][1], $data0); 140 | ok(!defined($dif) || $dif eq '', 'first row matches'); 141 | diag($dif) if $dif; 142 | } else { 143 | is($tmp->[0][1], $data0, 'first row matches'); 144 | } 145 | is($tmp->[1][1], $data1, 'second row matches'); 146 | is($tmp->[2][1], $data2, 'third row matches'); 147 | 148 | } 149 | } # end of run_select_tests 150 | 151 | # end. 152 | 153 | 154 | sub create_test_table { 155 | my ($fields, $drop) = @_; 156 | my $sql = qq{create table $table ( 157 | idx integer, 158 | $fields, 159 | dt date, 160 | primary key (dt, idx) 161 | )}; 162 | $dbh->do(qq{ drop table $table }) if $drop; 163 | $dbh->do($sql); 164 | if ($dbh->err && $dbh->err==955) { 165 | $dbh->do(qq{ drop table $table }); 166 | warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err; 167 | $dbh->do($sql); 168 | } 169 | return 0 if $dbh->err; 170 | return 1; 171 | } 172 | 173 | __END__ 174 | -------------------------------------------------------------------------------- /err_unsorted/err_ref_type.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-19574-Tim.Bunce=pobox.com@perl.org Wed Jul 23 18:40:02 2003 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id h6NHUUA0010501 4 | for ; Wed, 23 Jul 2003 18:40:02 +0100 (BST) 5 | (envelope-from dbi-users-return-19574-Tim.Bunce=pobox.com@perl.org) 6 | Received: from pop3.mail.demon.net [194.217.242.253] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Wed, 23 Jul 2003 18:40:02 +0100 (BST) 9 | Received: from punt-1.mail.demon.net by mailstore for Tim.Bunce@data-plan.com 10 | id 1058948095:10:09585:8; Wed, 23 Jul 2003 08:14:55 GMT 11 | Received: from dolly1.pobox.com ([207.106.49.22]) by punt-1.mail.demon.net 12 | id aa1116163; 23 Jul 2003 8:14 GMT 13 | Received: from dolly1.pobox.com (localhost [127.0.0.1]) 14 | by dolly1.pobox.com (Postfix) with ESMTP id 88C1B21C024 15 | for ; Wed, 23 Jul 2003 04:13:51 -0400 (EDT) 16 | Delivered-To: tim.bunce@pobox.com 17 | Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) 18 | by dolly1.pobox.com (Postfix) with SMTP id AA89B21C082 19 | for ; Wed, 23 Jul 2003 04:13:50 -0400 (EDT) 20 | Received: (qmail 26606 invoked by uid 1005); 23 Jul 2003 08:13:44 -0000 21 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 22 | Precedence: bulk 23 | List-Post: 24 | List-Help: 25 | List-Unsubscribe: 26 | List-Subscribe: 27 | Delivered-To: mailing list dbi-users@perl.org 28 | Received: (qmail 26590 invoked by uid 76); 23 Jul 2003 08:13:43 -0000 29 | 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 30 | Received: (qmail 16360 invoked by uid 225); 23 Jul 2003 08:13:41 -0000 31 | Delivered-To: dbi-users@perl.org 32 | Received: (qmail 16355 invoked by uid 507); 23 Jul 2003 08:13:41 -0000 33 | Received-SPF: unknown 34 | 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 35 | Received: (qmail 5378 invoked from network); 23 Jul 2003 08:54:08 -0000 36 | 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 37 | Received: (qmail 8984 invoked from network); 23 Jul 2003 08:13:49 -0000 38 | 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 39 | 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) 40 | Subject: Re: binding to parameters of type REF 41 | From: Hendrik =?ISO-8859-1?Q?Fu=DF?= 42 | To: dbi-users@perl.org 43 | In-Reply-To: <1058865345.1241.56.camel@mars> 44 | References: <1058865345.1241.56.camel@mars> 45 | Content-Type: text/plain 46 | Content-Transfer-Encoding: 7bit 47 | X-Mailer: Ximian Evolution 1.0.8 48 | Date: 23 Jul 2003 10:11:49 +0200 49 | Message-Id: <1058947909.6353.5.camel@mars> 50 | Mime-Version: 1.0 51 | X-SMTPD: qpsmtpd/0.27-dev, http://develooper.com/code/qpsmtpd/ 52 | X-Spam-Check-By: one.develooper.com 53 | 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 54 | X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ 55 | Status: RO 56 | Content-Length: 1354 57 | Lines: 56 58 | 59 | I've also found out, that DBD::Oracle does not support type SQL_REF: 60 | When not using DBD::Proxy I get: 61 | 62 | SQL type 20 for ':p1' is not fully supported, 63 | bound as SQL_VARCHAR instead 64 | 65 | I even get segmentation faults when trying to fetch REF columns. :-( 66 | 67 | Any ideas? 68 | 69 | > Hi, 70 | > 71 | > I'm trying to bind a perl variable to an Oracle table reference with 72 | > Oracle 9.2.0.3, DBD::Proxy and Perl::DBI 1.37 without success. I 73 | > could'nt find help on this in the docs or list archives. I hope this is 74 | > the right place to post. 75 | > 76 | > In SQL*Plus: 77 | > 78 | > SQL> desc getReference 79 | > FUNCTION getReference RETURNS REF OF TABLETYPE 80 | > 81 | > SQL> select getReference() from dual; 82 | > 83 | > GETREFERENCE() 84 | > ---------------------------------------------------------------------- 85 | > 0000280209C229D2216EF6A5F4E030010A8D086AD3C204FC6EE0E46501E030010A8D08 86 | > 2CE703C0000E0000 87 | > 88 | > 89 | > My code: 90 | > 91 | > my $ref = undef; 92 | > my $sth = $dbh->prepare('BEGIN ? := getReference(); END;'); 93 | > $sth->bind_param_inout(1, \$ref, 128, SQL_REF ); 94 | > $sth->execute(); 95 | > 96 | > yields: 97 | > 98 | > PLS-00382: expression is of wrong type 99 | > 100 | > 101 | > Even fetching a reference does not work: 102 | > 103 | > my $sth = $dbh->prepare('SELECT getReference() FROM DUAL'); 104 | > $sth->execute(); 105 | > ($ref) = $sth->fetchrow_array(); 106 | > 107 | > yields undef in $ref. 108 | > 109 | > I'd very much appreciate your help. 110 | > cheers, 111 | > Hendrik 112 | 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /err_build/err_testfailnotable.msg: -------------------------------------------------------------------------------- 1 | From SRS0=RhpE=NO=perl.org=dbi-dev-return-3750-Tim.Bunce=pobox.com@bounce2.pobox.com Wed Oct 27 18:10:51 2004 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i9RHAOAK026067 4 | for ; Wed, 27 Oct 2004 18:10:51 +0100 (BST) 5 | (envelope-from SRS0=RhpE=NO=perl.org=dbi-dev-return-3750-Tim.Bunce=pobox.com@bounce2.pobox.com) 6 | Received: from pop3.mail.demon.net [194.217.242.253] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Wed, 27 Oct 2004 18:10:51 +0100 (BST) 9 | Received: from punt-3.mail.demon.net by mailstore 10 | for pobox@data-plan.com id 1CMp30-0000e2-Hh; 11 | Wed, 27 Oct 2004 14:45:10 +0000 12 | Received: from [194.217.242.77] (helo=anchor-hub.mail.demon.net) 13 | by punt-3.mail.demon.net with esmtp id 1CMp30-0000e2-Hh 14 | for pobox@data-plan.com; Wed, 27 Oct 2004 14:45:10 +0000 15 | Received: from [208.210.124.73] (helo=gold.pobox.com) 16 | by anchor-hub.mail.demon.net with esmtp id 1CMp30-0001QS-2p 17 | for pobox@data-plan.com; Wed, 27 Oct 2004 14:45:10 +0000 18 | Received: from gold.pobox.com (localhost [127.0.0.1]) 19 | by gold.pobox.com (Postfix) with ESMTP id 87C155A7D; 20 | Wed, 27 Oct 2004 10:45:09 -0400 (EDT) 21 | Delivered-To: tim.bunce@pobox.com 22 | Received: from gold (localhost [127.0.0.1]) 23 | by gold.pobox.com (Postfix) with ESMTP id 7779A59A1 24 | for ; Wed, 27 Oct 2004 10:45:09 -0400 (EDT) 25 | 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) 26 | X-SPF-Guess: pass (seems reasonable for dbi-dev-return-3750-Tim.Bunce=pobox.com@perl.org to mail through 63.251.223.186) 27 | X-Pobox-Antispam: dnsbl/blackholes.five-ten-sg.com returned DENY: for 63.251.223.186(x6.develooper.com) 28 | Received: from lists.develooper.com (x6.develooper.com [63.251.223.186]) 29 | by gold.pobox.com (Postfix) with SMTP id DC5795A4A 30 | for ; Wed, 27 Oct 2004 10:45:07 -0400 (EDT) 31 | Received: (qmail 18140 invoked by uid 514); 27 Oct 2004 14:45:04 -0000 32 | Mailing-List: contact dbi-dev-help@perl.org; run by ezmlm 33 | Precedence: bulk 34 | List-Post: 35 | List-Help: 36 | List-Unsubscribe: 37 | List-Subscribe: 38 | Delivered-To: mailing list dbi-dev@perl.org 39 | Received: (qmail 18131 invoked from network); 27 Oct 2004 14:45:04 -0000 40 | Received: from x1.develooper.com (63.251.223.170) 41 | by lists.develooper.com with SMTP; 27 Oct 2004 14:45:04 -0000 42 | Received: (qmail 8663 invoked by uid 225); 27 Oct 2004 14:45:03 -0000 43 | Delivered-To: dbi-dev@perl.org 44 | Received: (qmail 8659 invoked by alias); 27 Oct 2004 14:45:03 -0000 45 | X-Spam-Status: No, hits=-4.9 required=8.0 46 | tests=BAYES_00 47 | X-Spam-Check-By: la.mx.develooper.com 48 | Received: from ns2.aramiska.net (HELO dmzms01.aramiska.net) (80.242.32.2) 49 | by la.mx.develooper.com (qpsmtpd/0.27.1) with ESMTP; Wed, 27 Oct 2004 07:45:01 -0700 50 | Received: from ip-80-242-36-115.aramiska-arc.aramiska.net (ip-80-242-36-115.aramiska-arc.aramiska.net [80.242.36.115]) 51 | by dmzms01.aramiska.net (Postfix) with ESMTP 52 | id 9F21E1100D9; Wed, 27 Oct 2004 14:44:55 +0000 (UTC) 53 | Received: from localhost (localhost [127.0.0.1]) 54 | by ip-80-242-36-115.aramiska-arc.aramiska.net (Postfix) with ESMTP 55 | id E558E7C; Wed, 27 Oct 2004 14:44:52 +0000 (UTC) 56 | Received: from dansat.data-plan.com (ip-192-168-0-3.internal.data-plan.aramiska.net [192.168.0.3]) 57 | by ip-80-242-36-115.aramiska-arc.aramiska.net (Postfix) with ESMTP 58 | id D8A5E71; Wed, 27 Oct 2004 14:44:50 +0000 (UTC) 59 | Received: from dansat.data-plan.com (localhost [127.0.0.1]) 60 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id i9REioAA023212; 61 | Wed, 27 Oct 2004 15:44:50 +0100 (BST) 62 | (envelope-from timbo@dansat.data-plan.com) 63 | Received: (from timbo@localhost) 64 | by dansat.data-plan.com (8.12.9/8.12.9/Submit) id i9REinmW023211; 65 | Wed, 27 Oct 2004 15:44:49 +0100 (BST) 66 | Date: Wed, 27 Oct 2004 15:44:49 +0100 67 | From: Tim Bunce 68 | To: "H.Merijn Brand" 69 | Cc: Tim Bunce , DBI developers 70 | Subject: Re: ANNOUNCE: DBD::Oracle 1.16 71 | Message-ID: <20041027144449.GB19991@dansat.data-plan.com> 72 | References: <20041022213625.GA22377@dansat.data-plan.com> <20041027093516.D001.H.M.BRAND@hccnet.nl> 73 | Mime-Version: 1.0 74 | Content-Type: text/plain; charset=us-ascii 75 | Content-Disposition: inline 76 | In-Reply-To: <20041027093516.D001.H.M.BRAND@hccnet.nl> 77 | User-Agent: Mutt/1.4i 78 | X-Virus-Scanned: by Aramiska Arc 79 | Status: RO 80 | Content-Length: 634 81 | Lines: 14 82 | 83 | On Wed, Oct 27, 2004 at 09:39:33AM +0200, H.Merijn Brand wrote: 84 | > On Fri 22 Oct 2004 23:36, Tim Bunce wrote: 85 | > > file: $CPAN/authors/id/T/TI/TIMB/DBD-Oracle-1.16.tar.gz 86 | > > size: 235224 bytes 87 | > > md5: 9711550ed0ebfc743920a6a357ed717c 88 | > 89 | > I know you can't blame the test for not being able to create a table for the 90 | > reason this failure shows, but there might be a more user-friendly way to fail ... 91 | 92 | Yeap. Some tests behave better in that situation. Looks like those 93 | two need improving. Patches welcome! (I'd happily not touch DBD::Oracle 94 | for a few months after the pain of the last few months :) 95 | 96 | Tim. 97 | 98 | -------------------------------------------------------------------------------- /hints/svr4.pl: -------------------------------------------------------------------------------- 1 | my $archname = $Config::Config{archname} || die; 2 | $att{LIBS} ||= []; 3 | $att{LIBS}->[0] ||= ''; 4 | 5 | # Some SVR4 systems may need to link against -lc to pick up things like 6 | # fpsetmask, sys_nerr and ecvt. 7 | my @libs = qw(-lsocket -lnsl -lm -ldl); # general svr4 default 8 | 9 | # modified by Davide Migliavacca 10 | if ($archname eq 'RM400-svr4') { 11 | @libs = qw(-lucb); 12 | } 13 | 14 | push @libs, '-lc'; 15 | 16 | warn "$^O LIBS attribute defaulted to '$att{LIBS}->[0]' for '$archname'"; 17 | $att{LIBS}->[0] .= " ".join(" ", @libs); # append libs 18 | warn "$^O LIBS attribute updated to '$att{LIBS}->[0]'"; 19 | 20 | 21 | __END__ 22 | 23 | From doughera@lafcol.lafayette.edu Mon Aug 21 07:01:51 1995 24 | Date: Fri, 18 Aug 1995 15:33:22 -0400 (EDT) 25 | From: Andy Dougherty 26 | Subject: Re: [MM] Re: hints file for Oracle 27 | To: Tim Bunce 28 | In-Reply-To: <9508181853.ab12333@post.demon.co.uk> 29 | Mime-Version: 1.0 30 | Content-Type: TEXT/PLAIN; charset=US-ASCII 31 | 32 | On Fri, 18 Aug 1995, Tim Bunce wrote: 33 | > > From: Alan Burlison 34 | > > 35 | > > Tim, 36 | > > 37 | > > The following hints file is required for DBD::Oracle on svr4, you might 38 | > > like to add it to the next release :-) 39 | > > 40 | > > File: Oracle/hints/svr4.pl 41 | > > 42 | > > # Some SVR4 systems may need to link against -lc to pick up things like 43 | > > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; 44 | > 45 | > Umm, 'some', 'may', 'things like'. Care to clarify? 46 | > 47 | > Why _exactly_ is this needed, and why doesn't MakeMaker do this already? 48 | > (CC'd to the MakeMaker mailing list.) 49 | 50 | That looks like a bad editing of the ODBM_File/hints/svr4.pl: 51 | 52 | ########################## hints/svr4.pl ######################### 53 | # Some SVR4 systems may need to link against routines in -lucb for 54 | # odbm. Some may also need to link against -lc to pick up things like 55 | # ecvt. 56 | $att{LIBS} = ['-ldbm -lucb -lc']; 57 | ################################################################### 58 | 59 | "Some" includes Unisys 6000 (or something like that). I don't know 60 | if it includes anything else. It doesn't include Unixware 2.1, but it 61 | might include Esix. It's *really* hard to get accurate info. 62 | 63 | "May" because some do and some don't, and any listing gets out of date 64 | quickly as vendors issue different versions, and probably more than 65 | half the info you *do* get about specific versions is wrong. Hence all 66 | the vague weasel-words. 67 | 68 | "Things like" is ecvt() for Unisys (for ODBM_File). Since some linkers 69 | only report the first missing symbol, it's sometimes hard (and 70 | sometimes pointless) to get a complete list of things that you need). 71 | 72 | Basically, there are *many* SVR4-derived systems out there, and there are 73 | many little idiosyncracies; the best bet is to put someone else's name 74 | and email address in the hint file so you can blame them :-). 75 | 76 | Andy Dougherty doughera@lafcol.lafayette.edu 77 | 78 | 79 | From: Tye McQueen 80 | Subject: Re: [MM] Re: hints file for Oracle 81 | Date: Fri, 18 Aug 1995 16:01:39 -0500 (CDT) 82 | Cc: aburlison@cix.compulink.co.uk, perldb-interest@vix.com, 83 | makemaker@franz.ww.tu-berlin.de 84 | 85 | Excerpts from the mail message of Tim Bunce: 86 | ) > From: Alan Burlison 87 | ) > 88 | ) > The following hints file is required for DBD::Oracle on svr4, you might 89 | ) > like to add it to the next release :-) 90 | ) > 91 | ) > File: Oracle/hints/svr4.pl 92 | ) > 93 | ) > # Some SVR4 systems may need to link against -lc to pick up things like 94 | ) > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; 95 | ) 96 | ) Umm, 'some', 'may', 'things like'. Care to clarify? 97 | ) 98 | ) Why _exactly_ is this needed, and why doesn't MakeMaker do this already? 99 | ) (CC'd to the MakeMaker mailing list.) 100 | ) 101 | ) Is anyone else using DBD::Oracle on an svr4 system (not solaris 2)? 102 | 103 | That looks like something I wrote. I'll take credit and blame 104 | for it at least for the sake of the next paragraph. 105 | 106 | So far "some" is only whatever Unisys system Alan and one other 107 | person have used. "may" is because, as far as I could tell from 108 | my end, some of the dynamically loaded extensions worked okay 109 | before this fix but one of them didn't. "thinks like" must be 110 | because I couldn't remember which routine was not being found 111 | and then forgot to finish my sentence. I think it was _ecvt(). 112 | 113 | The description is very vague because it doesn't make sense to 114 | me why it is needed and I don't have access to a system to play 115 | around with it if I really wanted to try to figure it out. But 116 | it seems to fix the few problems it addresses and have not heard 117 | of it hurting anything yet (and I've tested it on my machines). 118 | 119 | I'm putting together a README.svr4 for Perl that will describe this 120 | and many other things in case people are curious or run into a 121 | problem and need to know why some of the strange things were done. 122 | -- 123 | Tye McQueen tye@metronet.com || tye@doober.usu.edu 124 | Nothing is obvious unless you are overlooking something 125 | http://www.metronet.com/~tye/ (scripts, links, nothing fancy) 126 | 127 | -------------------------------------------------------------------------------- /lib/DBD/Oracle/Troubleshooting/Linux.pod: -------------------------------------------------------------------------------- 1 | #PODNAME: DBD::Oracle::Troubleshooting::Linux 2 | #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Linux 3 | 4 | =head1 SELinux and httpd 5 | 6 | If SELinux is running, it can prevents DBD::Oracle running in 7 | an Apache process to load shared libraries it requires (libclntsh.so 8 | or libnnz12.so). A typical symptom is a line like the following in 9 | the Apache error logs: 10 | 11 | [Tue Apr 17 13:22:45 2012] [error] Can't load '.../DBD/Oracle/Oracle.so' for 12 | module DBD::Oracle: libnnz11.so: cannot enable executable stack as shared 13 | object requires: Permission denied at .../DynaLoader.pm line 190.\n at 14 | .../startup.pl line 17\nCompilation failed in require at ... 15 | 16 | The fix: 17 | 18 | /usr/sbin/setsebool -P httpd_execmem 19 | 20 | 21 | =head1 Installing with Instantclient .rpm files. 22 | 23 | Nothing special with this you just have to set up you permissions as follows; 24 | 25 | 1) Have permission for RWE on '/usr/lib/oracle/10.2.0.3/client/' or the other directory where you RPMed to 26 | 27 | 2) Set export ORACLE_HOME=/usr/lib/oracle/10.2.0.3/client 28 | 29 | 3) Set export LD_LIBRARY_PATH=$ORACLE_HOME/lib 30 | 31 | 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 32 | 33 | =head1 undefined symbol: __cmpdi2 comes up when Oracle isn't properly linked to the libgcc.a library. 34 | 35 | In version 8, this was corrected by changing the SYSLIBS entry in 36 | $ORACLE_HOME/bin/genclntsh to include 37 | "-L/usr/lib/gcc-lib/i386-redhat-linux/3.2 -lgcc". 38 | 39 | I had tried this with no success as when this program was then run, the 40 | error "unable to find libgcc" was generated. Of course, this was the 41 | library I was trying to describe! 42 | 43 | It turns out that now it is necessary to edit the same file and append 44 | "`gcc -print-libgcc-file-name`" (including the backquotes!). If you do 45 | this and then run "genclntsh", the libclntsh is properly generated and 46 | the linkage with DBD::Oracle proceeds properly. 47 | 48 | 49 | =head1 cc1: invalid option `tune=pentium4'" error 50 | 51 | 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. 52 | 53 | No real problem with the above however you will have to 54 | 55 | 1) run Perl Makefile.PL 56 | 57 | 2) edit the Makefile and remove the offending '-mtune=pentium4' text 58 | 59 | 3) save and exit 60 | 61 | 4) do the make install and it should work fine for you 62 | 63 | =head1 Oracle 9i Lite 64 | 65 | The advice is to use the regular Oracle9i not the lite version. 66 | 67 | Another great source of help was: http://www.puschitz.com/InstallingOracle9i.html 68 | 69 | just getting 9i and 9i lite installed. I use fvwm2(nvidia X driver) as 70 | a window manager which does not work with the 9i install program, works 71 | fine with the default Gnomish(nv X driver), it could have been the X 72 | driver too. 73 | 74 | With Redhat9 it is REAL important to set LD_ASSUME_KERNEL to 2.4.1. 75 | 76 | I didn't try this but it may be possible to install what is needed by 77 | only downloading the first disk saving some 1.3GB of download fun. 78 | 79 | I installed a custom install from the client group. The packages I 80 | installed are the Programmers section and sqlplus. I noticed that the 81 | Pro*C when on as a result of the checking the Programmers section I 82 | assume. 83 | 84 | Once Oracle was installed properly the DBD::Oracle install went as 85 | smooth as just about every other CPAN module. 86 | 87 | =head1 Oracle 10g Instantclient 88 | 89 | The Makefile.PL will now work for Oracle 10g Instantclient. To have both the Compile and 90 | the test.pl to work you must first have the LD_LIBRARY_PATH correctly set to your 91 | "instantclient" directory. (http://www.oracle.com/technology/tech/oci/instantclient/instantclient.html) 92 | 93 | The present version of the make creates a link on your "instantclient" directory as follows 94 | "ln -s libclntsh.so.10.1 libclntsh.so". It is needed for both the makefile creation and the compile 95 | but is not need for the test.pl. It should be removed after the compile. 96 | 97 | If the Makefile.PL or make fails try creating this link directly in your "instantclient" directory. 98 | 99 | =head1 Oracle Database 10g Express Edition 10.2 100 | 101 | To get 10Xe to compile correctly I had to add $ORACLE_HOME/lib to the LD_LIBRARY_PATH 102 | as you would for an install against 10g Standard Edition, Standard Edition One, or 103 | Enterprise Edition 104 | 105 | =head1 UTF8 bug in Oracle 9.2.0.5.0 and 9.2.0.7.0 106 | 107 | DBD::Oracle seems to hit some sort of bug with the above two versions of DB. 108 | The bug seems to hit when you when the Oracle database charset: US7ASCII and the Oracle nchar charset: AL16UTF16 and it has also 109 | been reported when the Oracle database charset: WE8ISO8850P1 Oracle nchar charset: AL32UTF16. 110 | 111 | So far there is no patch for this but here are some workarounds 112 | 113 | use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR ); 114 | ... 115 | $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR }); 116 | 117 | or this way 118 | 119 | $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders 120 | 121 | or this way 122 | 123 | utf8::downgrade($parameter, 1); 124 | 125 | 126 | -------------------------------------------------------------------------------- /err_unsorted/err_xml.msg: -------------------------------------------------------------------------------- 1 | From dbi-users-return-19852-Tim.Bunce=pobox.com@perl.org Fri Aug 15 14:41:14 2003 2 | Received: from localhost (localhost [127.0.0.1]) 3 | by dansat.data-plan.com (8.12.9/8.12.9) with ESMTP id h7FDe3MA043557 4 | for ; Fri, 15 Aug 2003 14:41:13 +0100 (BST) 5 | (envelope-from dbi-users-return-19852-Tim.Bunce=pobox.com@perl.org) 6 | Received: from pop3.mail.demon.net [194.217.242.253] 7 | by localhost with POP3 (fetchmail-5.8.5) 8 | for timbo@localhost (single-drop); Fri, 15 Aug 2003 14:41:13 +0100 (BST) 9 | Received: from punt-3.mail.demon.net by mailstore 10 | for pobox@dbi.demon.co.uk id 19nc4X-0006LQ-BC; 11 | Fri, 15 Aug 2003 10:44:41 +0000 12 | Received: from [207.106.49.22] (helo=dolly1.pobox.com) 13 | by punt-3.mail.demon.net with esmtp id 19nc4X-0006LQ-BC 14 | for pobox@dbi.demon.co.uk; Fri, 15 Aug 2003 10:44:41 +0000 15 | Received: from dolly1.pobox.com (localhost[127.0.0.1]) 16 | by dolly1.pobox.com (Postfix) with ESMTP id 16F6B21C13B 17 | for ; Fri, 15 Aug 2003 06:44:41 -0400 (EDT) 18 | Delivered-To: tim.bunce@pobox.com 19 | Received: from onion.perl.org (onion.develooper.com[63.251.223.166]) 20 | by dolly1.pobox.com (Postfix) with SMTP id 021F121C36F 21 | for ; Fri, 15 Aug 2003 06:44:40 -0400 (EDT) 22 | Received: (qmail 78180 invoked by uid 1005); 15 Aug 2003 10:44:34 -0000 23 | Mailing-List: contact dbi-users-help@perl.org; run by ezmlm 24 | Precedence: bulk 25 | List-Post: 26 | List-Help: 27 | List-Unsubscribe: 28 | List-Subscribe: 29 | Delivered-To: mailing list dbi-users@perl.org 30 | Delivered-To: moderator for dbi-users@perl.org 31 | Received: (qmail 71287 invoked by uid 76); 15 Aug 2003 10:32:13 -0000 32 | Delivered-To: dbi-users@perl.org 33 | Received-SPF: unknown (domain of sender andyhassall@yahoo.com does not designate mailers: NXDOMAIN) 34 | Message-ID: <20030815103200.24313.qmail@web9605.mail.yahoo.com> 35 | Date: Fri, 15 Aug 2003 11:32:00 +0100 (BST) 36 | From: =?iso-8859-1?q?Andy=20Hassall?= 37 | Reply-To: andy@andyh.co.uk 38 | Subject: Re: ERROR OCIDefineObject call needed but not implemented yet using XMLElement function 39 | To: Susan Cassidy , dbi-users@perl.org 40 | In-Reply-To: 41 | MIME-Version: 1.0 42 | Content-Type: text/plain; charset=iso-8859-1 43 | X-SMTPD: qpsmtpd/0.27-dev, http://develooper.com/code/qpsmtpd/ 44 | X-Spam-Check-By: one.develooper.com 45 | 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 46 | X-SMTPD: qpsmtpd/0.26, http://develooper.com/code/qpsmtpd/ 47 | Content-Transfer-Encoding: 8bit 48 | X-MIME-Autoconverted: from quoted-printable to 8bit by dansat.data-plan.com id h7FDe3MA043557 49 | Status: RO 50 | Content-Length: 2299 51 | Lines: 65 52 | 53 | --- Susan Cassidy wrote: > I am using DBD::Oracle. 54 | I was on version 1.12, then I installed version 55 | > 1.14, with the same result. 56 | > 57 | > This is Oracle 9.2.0. 58 | > 59 | > I have this select statement that works fine from SQL*Plus: 60 | > 61 | > select XMLElement("Sequences", 62 | > XMLElement("Sequence", 63 | > XMLATTRIBUTES ( b.local_name AS "ic-acckey", 64 | > b.mol_type AS "molecule", 65 | > n.seq_name AS "title"))) 66 | > from gcg_bioseq b, gcg_annot_seq_name a, gcg_seq_name n 67 | > where 68 | > b.local_name = 'K00306' and 69 | > b.seq_status = 'D' and 70 | > b.seq_oid = a.seq_oid and 71 | > a.seq_name_oid = n.seq_name_oid and 72 | > n.name_type = 'LOCUS' 73 | > 74 | > 75 | > When I run it via DBI/DBD I get this (trace level 2): 76 | > 77 | > DBI 1.32-nothread dispatch trace level set to 2 78 | > Note: perl is running without the recommended perl -w option 79 | > -> prepare for DBD::Oracle::db (DBI::db=HASH(0x1b2314)~0x122bec ' 80 | [snip 81 | > Field 1 has an Oracle type (108) which is not explicitly supported 82 | > fbh 1: 83 | > 84 | 'XMLELEMENT("SEQUENCES",XMLELEMENT("SEQUENCE",XMLATTRIBUTES(B.LOCAL_NAMEAS"IC-ACCKEY",B.MOL_TYPEAS"MOLECULE",N.SEQ_NAMEAS"TITLE")))' 85 | [snip] 86 | > Error: prepare failed 87 | > at line 56, error: ERROR OCIDefineObject call needed but not 88 | > implemented yet 89 | > 90 | > Is there any other workaround for this than wrapping this up in a PL/SQL 91 | > function? 92 | 93 | Don't rely on the implicit conversion to a string type that is done when 94 | SQL*Plus displays an XMLElement; add .getClobVal() to the end of the 95 | statement to retrieve it as a CLOB rather than the XMLElement object type 96 | (which DBD::Oracle doesn't accept). 97 | 98 | i.e. 99 | 100 | select XMLElement("Sequences", 101 | XMLElement("Sequence", 102 | XMLATTRIBUTES ( b.local_name AS "ic-acckey", 103 | b.mol_type AS "molecule", 104 | n.seq_name AS "title"))).getClobVal() 105 | from ... 106 | 107 | (or getStringVal() for a VARCHAR2) 108 | 109 | ===== 110 | -- 111 | Andy Hassall (andy@andyh.org) icq(5747695) http://www.andyh.co.uk 112 | http://www.andyhsoftware.co.uk/space | disk usage analysis tool 113 | 114 | ________________________________________________________________________ 115 | Want to chat instantly with your online friends? Get the FREE Yahoo! 116 | Messenger http://uk.messenger.yahoo.com/ 117 | 118 | 119 | -------------------------------------------------------------------------------- /hints/macos_syms.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | # 6 | # Perl program that *should* generate a list of duplicate symbols 7 | # between DBD::Oracle and Oracle client library. It produces useful 8 | # output as-is, but it's not a general solution as it forces a 9 | # symbol in that isn't reported, and eliminates a bunch of symbols 10 | # that can't be removed for one reason or another. 11 | 12 | # 13 | # This file may prove useful in the long run as a starting point, so 14 | # I've included it. 15 | # 16 | 17 | my %unstrippable = map { $_ => 1 } qw( _OCIAttrGet 18 | _OCIAttrSet 19 | _OCIBindByName 20 | _OCIBindDynamic 21 | _OCIBreak 22 | _OCIDefineByPos 23 | _OCIDescribeAny 24 | _OCIDescriptorAlloc 25 | _OCIDescriptorFree 26 | _OCIEnvInit 27 | _OCIErrorGet 28 | _OCIHandleAlloc 29 | _OCIHandleFree 30 | _OCIInitialize 31 | _OCILobGetLength 32 | _OCILobFileClose 33 | _OCILobFileOpen 34 | _OCILobRead 35 | _OCILobTrim 36 | _OCILobWrite 37 | _OCIParamGet 38 | _OCIServerAttach 39 | _OCIServerDetach 40 | _OCISessionBegin 41 | _OCISessionEnd 42 | _OCIStmtExecute 43 | _OCIStmtFetch 44 | _OCIStmtPrepare 45 | _OCITransCommit 46 | _OCITransRollback 47 | __dyld_func_lookup 48 | _atoi 49 | _fprintf 50 | _fwrite 51 | _getenv 52 | _kgefac_ 53 | _kgesec0 54 | _korfpoid 55 | _kotgtivn 56 | _kpgdcd 57 | _kpggGetPG 58 | _kpugsqlt 59 | _kpumfs 60 | _kpumgs 61 | _kpummLtsCtx 62 | _kpusc 63 | _kpuscn 64 | _kpuucf 65 | _kpuuch 66 | _lmsagbf 67 | _lmsaicmt 68 | _lstmup 69 | _ltsmxd 70 | _ltstidd 71 | _lxhLangEnv 72 | _lxhci2h 73 | _lxhnsize 74 | _lxlterm 75 | _lxsCnvCase 76 | _main 77 | _memcmp 78 | _memcpy 79 | _memset 80 | _ociepgoe 81 | _sprintf 82 | _strcasecmp 83 | _strcat 84 | _strchr 85 | _strcpy 86 | _strlen 87 | _strncpy 88 | _ttckpu 89 | _upiacp0 90 | _upigdl 91 | _upihst 92 | _upioep 93 | _upirtr 94 | _upirtrc 95 | dyld_func_lookup_pointer 96 | dyld_lazy_symbol_binding_entry_point 97 | dyld_stub_binding_helper ); 98 | 99 | print "_main\n"; 100 | #print "_dlsym\n"; 101 | #print "\n\n"; 102 | 103 | my %oracle; 104 | 105 | open FH,'nm /Users/oracle/9iR2/orahome/lib/libclntsh.dylib.9.0 |'; 106 | 107 | while ( ) { 108 | unless ( /^\// || /^\n/ ) { 109 | s/...........(\w+)\n/$1/; 110 | $oracle{$_} = 1; 111 | } 112 | } 113 | 114 | close FH; 115 | 116 | open FH,'nm ../blib/arch/auto/DBD/Oracle/Oracle.bundle |'; 117 | 118 | while ( ) { 119 | unless ( /^\// || /^\n/ ) { 120 | s/...........(\w+)\n/$1/; 121 | if ( exists($oracle{$_}) && ! exists($unstrippable{$_}) ) { 122 | print "$_\n"; 123 | } 124 | } 125 | } 126 | 127 | close FH; 128 | 129 | --------------------------------------------------------------------------------