DBD-Oracle

 view release on metacpan or  search on metacpan

lib/DBD/Oracle.pm  view on Meta::CPAN

            ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE
            ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE
            SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN
        ) ],
      ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM) ],
      ora_fetch_orient  => [ qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST
                                 OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE
                                 OCI_FETCH_RELATIVE)],
      ora_exe_modes     => [ qw( OCI_STMT_SCROLLABLE_READONLY)],
      ora_fail_over     => [ qw( OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN
                                 OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT
                                 OCI_FO_TXNAL OCI_FO_RETRY)],
    );
    @EXPORT_OK = qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR
                     OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR
                     ora_env_var ora_cygwin_set_env );

    #unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin';
    Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient ora_exe_modes ora_fail_over));

    require_version DBI 1.623;

    DBD::Oracle->bootstrap($DBD::Oracle::VERSION);

    $drh = undef;        # holds driver handle once initialized

    sub CLONE {
        $drh = undef;
    }

    sub driver {
        return $drh if $drh;

        my($class, $attr) = @_;
        my $oci = DBD::Oracle::ORA_OCI();

        $class .= '::dr';

        # not a 'my' since we use it above to prevent multiple drivers

        $drh = DBI::_new_drh($class, {
            'Name'        => 'Oracle',
            'Version'     => $VERSION,
            'Err'         => \my $err,
            'Errstr'      => \my $errstr,
            'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce et. al.",
        });

        DBD::Oracle::dr::init_oci($drh) ;
        $drh->STORE('ShowErrorStatement', 1);

        DBD::Oracle::db->install_method($_) for qw/
            ora_lob_read
            ora_lob_write
            ora_lob_append
            ora_lob_trim
            ora_lob_length
            ora_lob_chunk_size
            ora_lob_is_init
            ora_nls_parameters
            ora_can_unicode
            ora_can_taf
            ora_db_startup
            ora_db_shutdown
        /;

        DBD::Oracle::st->install_method($_) for qw/
            ora_fetch_scroll
            ora_scroll_position
            ora_ping
            ora_stmt_type_name
            ora_stmt_type
        /;

        $drh;
    }


    END {
        # Used to silence 'Bad free() ...' warnings caused by bugs in Oracle's code
        # being detected by Perl's malloc.
        $ENV{PERL_BADFREE} = 0;
        #undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry;
    }

    sub AUTOLOAD {
            (my $constname = $AUTOLOAD) =~ s/.*:://;
            my $val = constant($constname);
            *$AUTOLOAD = sub { $val };
            goto &$AUTOLOAD;
    }

}


{   package                     # hide from PAUSE
    DBD::Oracle::dr;            # ====== DRIVER ======
    use strict;

    my %dbnames = ();        # holds list of known databases (oratab + tnsnames)

    sub load_dbnames {
        my ($drh) = @_;
        my $debug = $drh->debug;
        my $oracle_home = DBD::Oracle::ora_env_var($ORACLE_ENV);
        my $d;

        if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) {
          # XXX experimental, will probably change
          $drh->trace_msg("Trying to fetch ORACLE_HOME and ORACLE_SID from the registry.\n")
               if $debug;
          my $sid = DBD::Oracle::ora_env_var("ORACLE_SID");
          $dbnames{$sid} = $oracle_home if $sid and $oracle_home;
          $drh->trace_msg("Found $sid \@ $oracle_home.\n") if $debug && $sid;
        }

        # get list of 'local' database SIDs from oratab
        foreach $d (qw(/etc /var/opt/oracle), DBD::Oracle::ora_env_var("TNS_ADMIN")) {
            next unless defined $d;
            next unless open(my $FH, '<', "$d/oratab");
            $drh->trace_msg("Loading $d/oratab\n") if $debug;

lib/DBD/Oracle.pm  view on Meta::CPAN



    sub dbms_msgpipe_get {
        my $dbh = shift;
        my $sth = $dbh->prepare_cached(q{
            begin dbms_msgpipe.get_request(:returnpipe, :proc, :param); end;
        }) or return;
        my $msg = ['','',''];
        $sth->bind_param_inout(":returnpipe", \$msg->[0],   30);
        $sth->bind_param_inout(":proc",       \$msg->[1],   30);
        $sth->bind_param_inout(":param",      \$msg->[2], 4000);
        $sth->execute or return undef;
        return $msg;
    }

    sub dbms_msgpipe_ack {
        my $dbh = shift;
        my $msg = shift;
        my $sth = $dbh->prepare_cached(q{
            begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;}) or return;
        $sth->bind_param_inout(':returnpipe', \$msg->[0],   30);
        $sth->bind_param_inout(':proc',       \$msg->[1],   30);
        $sth->bind_param_inout(':param',      \$msg->[2], 4000);
        $sth->execute or return undef;
        return 1;
    }

    sub ora_server_version {
        my $dbh = shift;
        return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
        my $banner = $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%');
SELECT banner
  FROM v$version
  WHERE banner LIKE ? OR banner LIKE ?
SQL
        if (defined $banner) {
            my @version = $banner =~ /(?:^|\s)(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\s|$)/;
            $dbh->{ora_server_version} = \@version if @version;
        }

        # TODO looks like a bug that we don't return
        # $dbh->{ora_server_version} here
    }

    sub ora_nls_parameters {
        my $dbh = shift;
        my $refresh = shift;

        if ($refresh || !$dbh->{ora_nls_parameters}) {
            my $nls_parameters = $dbh->selectall_arrayref(q{
               SELECT parameter, value FROM v$nls_parameters
            }) or return;
            $dbh->{ora_nls_parameters} = { map { $_->[0] => $_->[1] } @$nls_parameters };
        }

        # return copy of params to protect against accidental editing
        my %nls = %{$dbh->{ora_nls_parameters}};
        return \%nls;
    }

    sub ora_can_unicode {
        my $dbh = shift;
        my $refresh = shift;
        # 0 = No Unicode support.
        # 1 = National character set is Unicode-based.
        # 2 = Database character set is Unicode-based.
        # 3 = Both character sets are Unicode-based.

        return $dbh->{ora_can_unicode}
            if defined $dbh->{ora_can_unicode} && !$refresh;

        my $nls = $dbh->ora_nls_parameters($refresh);

        $dbh->{ora_can_unicode}  = 0;
        $dbh->{ora_can_unicode} += 1 if $nls->{NLS_NCHAR_CHARACTERSET} =~ m/UTF/;
        $dbh->{ora_can_unicode} += 2 if $nls->{NLS_CHARACTERSET}       =~ m/UTF/;

        return $dbh->{ora_can_unicode};
    }

}   # end of package DBD::Oracle::db


{   package                     # hide from PAUSE
    DBD::Oracle::st;            # ====== STATEMENT ======


   sub bind_param_inout_array {
        my $sth = shift;
        my ($p_id, $value_array,$maxlen, $attr) = @_;
        return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be an arrayref, not a ".ref($value_array))
           if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY';

        return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id' for non-driver supported bind_param_inout_array")
           unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here

        return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of range")
           if $p_id <= 0; # can't easily/reliably test for too big

        # get/create arrayref to hold params
        my $hash_of_arrays = $sth->{ParamArrays} ||= { };

        $$hash_of_arrays{$p_id} = $value_array;
        return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen, $attr);
        1;

    }


    sub execute_for_fetch {
       my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
       my $row_count = 0;
       my $err_total = 0;
       my $tuple_count="0E0";
       my $tuple_batch_status;
       my $dbh = $sth->{Database};
       my $batch_size =($dbh->{'ora_array_chunk_size'}||= 1000);
       if(defined($tuple_status)) {
           @$tuple_status = ();
           $tuple_batch_status = [ ];
       }

       my $finished;
       while (1) {
           my @tuple_batch;
           for (my $i = 0; $i < $batch_size; $i++) {
               $finished = $fetch_tuple_sub->();
               push @tuple_batch, [@{$finished || last}];

           }
           last unless @tuple_batch;

           my $err_count = 0;
           my $res = ora_execute_array($sth,
                                           \@tuple_batch,
                                           scalar(@tuple_batch),
                                           $tuple_batch_status,
                                           $err_count );

lib/DBD/Oracle.pm  view on Meta::CPAN

=head2 B<HandleSetErr> (code ref, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<ErrCount> (unsigned integer)

Implemented by DBI, no driver-specific impact.

=head2 B<FetchHashKeyName> (string, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<ChopBlanks> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<Taint> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<TaintIn> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<TaintOut> (boolean, inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<Profile> (inherited)

Implemented by DBI, no driver-specific impact.

=head2 B<Type> (scalar)

Returns C<dr> for a driver handle, C<db> for a database handle, and C<st> for a statement handle.
Should be rarely needed.

=head2 B<LongReadLen>

The maximum size of long or longraw columns to retrieve. If one of
these columns is longer than LongReadLen then either a data truncation
error will be raised (LongTrunkOk is false) or the column will be
silently truncated (LongTruncOk is true).

DBI currently defaults this to 80.

=head2 B<LongTruncOk>

Implemented by DBI, no driver-specific impact.

=head2 B<CompatMode>

Type: boolean, inherited

The CompatMode attribute is used by emulation layers (such as Oraperl) to enable compatible behaviour in the underlying driver (e.g., DBD::Oracle) for this handle. Not normally set by application code.

It also has the effect of disabling the 'quick FETCH' of attribute values from the handles attribute cache. So all attribute values are handled by the drivers own FETCH method. This makes them slightly slower but is useful for special-purpose drivers...

=head1 ORACLE-SPECIFIC DATABASE HANDLE METHODS

=head2 B<ora_can_unicode ( [ $refresh ] )>

Returns a number indicating whether either of the database character sets
is a Unicode encoding. Calls ora_nls_parameters() and passes the optional
$refresh parameter to it.

0 = Neither character set is a Unicode encoding.

1 = National character set is a Unicode encoding.

2 = Database character set is a Unicode encoding.

3 = Both character sets are Unicode encodings.

=head2 B<ora_can_taf>

Returns true if the current connection supports TAF events. False if otherwise.

=head2 B<ora_nls_parameters ( [ $refresh ] )>

Returns a hash reference containing the current NLS parameters, as given
by the v$nls_parameters view. The values fetched are cached between calls.
To cause the latest values to be fetched, pass a true value to the function.

=head1 ORACLE-SPECIFIC DATABASE FUNCTIONS

=head2 B<ora_server_version>

  $versions = $dbh->func('ora_server_version');

Returns an array reference of server version strings e.g.,

  [11,2,0,2,0]

=head1 DATABASE HANDLE METHODS

=head2 B<selectall_arrayref>

  $ary_ref = $dbh->selectall_arrayref($sql);
  $ary_ref = $dbh->selectall_arrayref($sql, \%attr);
  $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values);

Returns a reference to an array containing the rows returned by preparing and executing the SQL string.
See the DBI documentation for full details.

=head2 B<selectall_hashref>

  $hash_ref = $dbh->selectall_hashref($sql, $key_field);

Returns a reference to a hash containing the rows returned by preparing and executing the SQL string.
See the DBI documentation for full details.

=head2 B<selectcol_arrayref>

  $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values);

Returns a reference to an array containing the first column
from each rows returned by preparing and executing the SQL string. It is possible to specify exactly
which columns to return. See the DBI documentation for full details.

=head2 B<prepare>

lib/DBD/Oracle.pm  view on Meta::CPAN

select the LOB locators 'FOR UPDATE'.

   my $sth = $dbh->prepare( <<"   SQL", { ora_auto_lob => 0 } );
      SELECT bindata
      FROM lob_example
      FOR UPATE
   SQL
   $sth->execute();
   while( my ( $bin_locator ) = $sth->fetchrow_array() ) {
      my $binlength = $dbh->ora_lob_length( $bin_locator );
      if( $binlength > 0 ) {
         $dbh->ora_lob_trim( $bin_locator, $binlength/2 );
      }
   }

=head1 SPACES AND PADDING

=head2 Trailing Spaces

Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder
values and uses Nonpadded Comparison Semantics with the result.
This causes trouble if the spaces are needed for
comparison with a CHAR value or to prevent the value from
becoming '' which Oracle treats as NULL.
Look for Blank-padded Comparison Semantics and Nonpadded
Comparison Semantics in Oracle's SQL Reference or Server
SQL Reference for more details.

To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8,
either change the default placeholder type with L</ora_ph_type> or the placeholder
type for a particular call to L<DBI/bind> or L<DBI/bind_param_inout>
with L</ora_type> or C<TYPE>.
Using L<ORA_CHAR> with L<ora_type> or C<SQL_CHAR> with C<TYPE>
allows the placeholder to be used with Padded Comparison Semantics
if the value it is being compared to is a CHAR, NCHAR, or literal.

Please remember that using spaces as a value or at the end of
a value makes visually distinguishing values with different
numbers of spaces difficult and should be avoided.

Oracle Clients that use OCI 9.2 do not strip trailing spaces.

=head2 Padded Char Fields

Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR.
As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access this behaviour you will
have to change the default placeholder type with L</ora_ph_type> or placeholder
type for a particular call with L<DBI/bind> or L<DBI/bind_param_inout>
with L</ORA_CHAR>.

=head1 UNICODE

DBD::Oracle now supports Unicode UTF-8. There are, however, a number
of issues you should be aware of, so please read all this section
carefully.

In this section we'll discuss "Perl and Unicode", then "Oracle and
Unicode", and finally "DBD::Oracle and Unicode".

Information about Unicode in general can be found at:
L<http://www.unicode.org/>. It is well worth reading because there are
many misconceptions about Unicode and you may be holding some of them.

=head2 Perl and Unicode

Perl began implementing Unicode with version 5.6, but the implementation
did not mature until version 5.8 and later. If you plan to use Unicode
you are I<strongly> urged to use Perl 5.8.2 or later and to I<carefully> read
the Perl documentation on Unicode:

   perldoc perluniintro    # in Perl 5.8 or later
   perldoc perlunicode

And then read it again.

Perl's internal Unicode format is UTF-8
which corresponds to the Oracle character set called AL32UTF8.

=head2 Oracle and Unicode

Oracle supports many characters sets, including several different forms
of Unicode.  These include:

  AL16UTF16  =>  valid for NCHAR columns (CSID=2000)
  UTF8       =>  valid for NCHAR columns (CSID=871), deprecated
  AL32UTF8   =>  valid for NCHAR and CHAR columns (CSID=873)

When you create an Oracle database, you must specify the DATABASE
character set (used for DDL, DML and CHAR datatypes) and the NATIONAL
character set (used for NCHAR and NCLOB types).
The character sets used in your database can be found using:

  $hash_ref = $dbh->ora_nls_parameters()
  $database_charset = $hash_ref->{NLS_CHARACTERSET};
  $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET};

The Oracle 9.2 and later default for the national character set is AL16UTF16.
The default for the database character set is often US7ASCII.
Although many experienced DBAs will consider an 8bit character set like
WE8ISO8859P1 or WE8MSWIN1252.  To use any character set with Oracle
other than US7ASCII, requires that the NLS_LANG environment variable be set.
See the L<"Oracle UTF8 is not UTF-8"> section below.

You are strongly urged to read the Oracle Internationalization documentation
specifically with respect the choices and trade offs for creating
a databases for use with international character sets.

Oracle uses the NLS_LANG environment variable to indicate what
character set is being used on the client.  When fetching data Oracle
will convert from whatever the database character set is to the client
character set specified by NLS_LANG. Similarly, when sending data to
the database Oracle will convert from the character set specified by
NLS_LANG to the database character set.

The NLS_NCHAR environment variable can be used to define a different
character set for 'national' (NCHAR) character types.

Both UTF8 and AL32UTF8 can be used in NLS_LANG and NLS_NCHAR.
For example:

   NLS_LANG=AMERICAN_AMERICA.UTF8
   NLS_LANG=AMERICAN_AMERICA.AL32UTF8
   NLS_NCHAR=UTF8
   NLS_NCHAR=AL32UTF8

=head2 Oracle UTF8 is not UTF-8

AL32UTF8 should be used in preference to UTF8 if it works for you,
which it should for Oracle 9.2 or later. If you're using an old
version of Oracle that doesn't support AL32UTF8 then you should
avoid using any Unicode characters that require surrogates, in other
words characters beyond the Unicode BMP (Basic Multilingual Plane).

That's because the character set that Oracle calls "UTF8" doesn't
conform to the UTF-8 standard in its handling of surrogate characters.
Technically the encoding that Oracle calls "UTF8" is known as "CESU-8".
Here are a couple of extracts from L<http://www.unicode.org/reports/tr26/>:

  CESU-8 is useful in 8-bit processing environments where binary
  collation with UTF-16 is required. It is designed and recommended
  for use only within products requiring this UTF-16 binary collation
  equivalence. It is not intended nor recommended for open interchange.

  As a very small percentage of characters in a typical data stream
  are expected to be supplementary characters, there is a strong
  possibility that CESU-8 data may be misinterpreted as UTF-8.
  Therefore, all use of CESU-8 outside closed implementations is
  strongly discouraged, such as the emittance of CESU-8 in output
  files, markup language or other open transmission forms.

Oracle uses this internally because it collates (sorts) in the same order
as UTF16, which is the basis of Oracle's internal collation definitions.

Rather than change UTF8 for clients Oracle chose to define a new character
set called "AL32UTF8" which does conform to the UTF-8 standard.
(The AL32UTF8 character set can't be used on the server because it
would break collation.)

Because of that, for the rest of this document we'll use "AL32UTF8".
If you're using an Oracle version below 9.2 you'll need to use "UTF8"
until you upgrade.

=head2 DBD::Oracle and Unicode

DBD::Oracle Unicode support has been implemented for Oracle versions 9
or greater, and Perl version 5.6 or greater (though we I<strongly>
suggest that you use Perl 5.8.2 or later).

You can check which Oracle version your DBD::Oracle was built with by
importing the C<ORA_OCI> constant from DBD::Oracle.

B<Fetching Data>

Any data returned from Oracle to DBD::Oracle in the AL32UTF8
character set will be marked as UTF-8 to ensure correct handling by Perl.

For Oracle to return data in the AL32UTF8 character set the
NLS_LANG or NLS_NCHAR environment variable I<must> be set as described
in the previous section.

When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle
will set the Perl UTF-8 flag on the returned data if either NLS_NCHAR
is AL32UTF8, or NLS_NCHAR is not set and NLS_LANG is AL32UTF8.

When fetching other character data from Oracle, DBD::Oracle
will set the Perl UTF-8 flag on the returned data if NLS_LANG is AL32UTF8.

B<Sending Data using Placeholders>

Data bound to a placeholder is assumed to be in the default client
character set (specified by NLS_LANG) except for a few special
cases. These are listed here with the highest precedence first:

If the C<ora_csid> attribute is given to bind_param() then that
is passed to Oracle and takes precedence.

If the value is a Perl Unicode string (UTF-8) then DBD::Oracle



( run in 0.467 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )