File Coverage

blib/lib/Oraperl.pm

Criterion	Covered	Total	%
statement	16	60	26.7
branch	1	20	5.0
condition	0	7	0.0
subroutine	5	17	29.4
pod	9	9	100.0
total	31	113	27.4

line	stmt	bran	cond	sub	pod	time	code
1							# Oraperl Emulation Interface for Perl 5 DBD::Oracle DBI
2							#
3							# Oraperl.pm
4							#
5							# Copyright (c) 1994,1995 Tim Bunce
6							#
7							# See the COPYRIGHT section in the Oracle.pm file for terms.
8							#
9							# To use this interface use one of the following invocations:
10							#
11							# use Oraperl;
12							# or
13							# eval 'use Oraperl; 1;' \|\| die $@ if $] >= 5;
14							#
15							# The second form allows oraperl scripts to be used with
16							# both oraperl and perl 5.
17
18							package Oraperl;
19
20							require 5.004;
21
22	1			1		15	use DBI 1.21;
	1					30
	1					16
23	1			1		15	use Exporter;
	1					9
	1					15
24
25							$VERSION = substr(q$Revision: 1.44 $, 10);
26
27							@ISA = qw(Exporter);
28
29							@EXPORT = qw(
30							&ora_login &ora_open &ora_bind &ora_fetch &ora_close
31							&ora_logoff &ora_do &ora_titles &ora_lengths &ora_types
32							&ora_commit &ora_rollback &ora_autocommit &ora_version
33							&ora_readblob
34							$ora_cache $ora_long $ora_trunc $ora_errno $ora_errstr
35							$ora_verno $ora_debug
36							);
37
38							$debug = 0 unless defined $debug;
39							$debugdbi = 0;
40							# $safe # set true/false before 'use Oraperl' if needed.
41							$safe = 1 unless defined $safe;
42
43							# Help those who get core dumps from non-'safe' Oraperl (bad cursors)
44	1			1		50	use sigtrap qw(ILL);
	1					10
	1					16
45							if (!$safe) {
46							$SIG{BUS} = $SIG{SEGV} = sub {
47							print STDERR "Add BEGIN { \$Oraperl::safe=1 } above 'use Oraperl'.\n"
48							unless $safe;
49							goto &sigtrap::trap;
50							};
51							}
52
53
54							# Install Driver (use of install_driver is a special case here)
55							$drh = DBI->install_driver('Oracle');
56							if ($drh) {
57							print "DBD::Oracle driver installed as $drh\n" if $debug;
58							$drh->trace($debug);
59							$drh->{CompatMode} = 1;
60							$drh->{Warn} = 0;
61							}
62
63
64	1			1		19	use strict;
	1					9
	1					15
65
66							sub _func_ref {
67	5			5		45	my $name = shift;
68	5	50				47	my $pkg = ($Oraperl::safe) ? "DBI" : "DBD::Oracle";
69	5					40	\&{"${pkg}::$name"};
	5					64
70							}
71
72							sub _warn {
73	0			0			my $prev_warn = shift;
74	0	0					if ($_[0] =~ /^(Bad\|Duplicate) free/) {
75	0	0					return unless $ENV{PERL_DBD_DUMP} eq 'dump';
76	0						print STDERR "Aborting with a core dump for diagnostics (PERL_DBD_DUMP)\n";
77	0						CORE::dump;
78							}
79	0	0					$prev_warn ? &$prev_warn(@_) : warn @_;
80							}
81
82
83							# -----------------------------------------------------------------
84							#
85							# $lda = &ora_login($system_id, $name, $password)
86							# &ora_logoff($lda)
87
88							sub ora_login {
89	0			0	1		my($system_id, $name, $password) = @_;
90	0		0				local($Oraperl::prev_warn) = $SIG{'__WARN__'} \|\| 0; # must be local
91	0			0			local($SIG{'__WARN__'}) = sub { _warn($Oraperl::prev_warn, @_) };
	0
92	0						return DBI->connect("dbi:Oracle:$system_id", $name, $password, {
93							PrintError => 0, AutoCommit => 0
94							});
95							}
96							sub ora_logoff {
97	0			0	1		my($dbh) = @_;
98	0	0					return if !$dbh;
99	0		0				local($Oraperl::prev_warn) = $SIG{'__WARN__'} \|\| 0; # must be local
100	0			0			local($SIG{'__WARN__'}) = sub { _warn($Oraperl::prev_warn, @_) };
	0
101	0						$dbh->disconnect();
102							}
103
104
105
106							# -----------------------------------------------------------------
107							#
108							# $csr = &ora_open($lda, $stmt [, $cache])
109							# &ora_bind($csr, $var, ...)
110							# &ora_fetch($csr [, $trunc])
111							# &ora_do($lda, $stmt)
112							# &ora_close($csr)
113
114							sub ora_open {
115	0			0	1		my($lda, $stmt) = @_;
116	0						$Oraperl::ora_cache_o = $_[2]; # temp hack to pass cache through
117
118	0	0					my $csr = $lda->prepare($stmt) or return undef;
119
120							# only execute here if no bind vars specified
121	0	0	0				$csr->execute or return undef unless $csr->{NUM_OF_PARAMS};
122
123	0						$csr;
124							}
125
126							*ora_bind = _func_ref('st::execute');
127							*ora_fetch = \&{"DBD::Oracle::st::ora_fetch"};
128							*ora_close = _func_ref('st::finish');
129
130							sub ora_do {
131							# error => undef
132							# 0 => "0E0" (0 but true)
133							# >0 => >0
134	0			0	1		my($lda, $stmt, @params) = @_; # @params are an extension to the original Oraperl.
135
136	0						return $lda->do($stmt, undef, @params); # SEE DEFAULT METHOD IN DBI.pm
137
138							# OLD CODE:
139							# $csr is local, cursor will be closed on exit
140	0	0					my $csr = $lda->prepare($stmt) or return undef;
141							# Oracle OCI will automatically execute DDL statements in prepare()!
142							# We must be carefull not to execute them again! This needs careful
143							# examination and thought.
144							# Perhaps oracle is smart enough not to execute them again?
145	0						my $ret = $csr->execute(@params);
146	0						my $rows = $csr->rows;
147	0	0					($rows == 0) ? "0E0" : $rows;
148							}
149
150
151							# -----------------------------------------------------------------
152							#
153							# &ora_titles($csr [, $truncate])
154							# &ora_lengths($csr)
155							# &ora_types($csr)
156
157							sub ora_titles{
158	0			0	1		my($csr, $trunc) = @_;
159	0	0					warn "ora_titles: truncate option not implemented" if $trunc;
160	0						@{$csr->{'NAME'}};
	0
161							}
162							sub ora_lengths{
163	0			0	1		@{shift->{'ora_lengths'}} # oracle specific
	0
164							}
165							sub ora_types{
166	0			0	1		@{shift->{'ora_types'}} # oracle specific
	0
167							}
168
169
170							# -----------------------------------------------------------------
171							#
172							# &ora_commit($lda)
173							# &ora_rollback($lda)
174							# &ora_autocommit($lda, $on_off)
175							# &ora_version
176
177							*ora_commit = _func_ref('db::commit');
178							*ora_rollback = _func_ref('db::rollback');
179
180							sub ora_autocommit {
181	0			0	1		my($lda, $mode) = @_;
182	0						$lda->{AutoCommit} = $mode;
183	0						"0E0";
184							}
185							sub ora_version {
186	0			0	1		my($sw) = DBI->internal;
187	0						print "\n";
188	0						print "Oraperl emulation interface version $Oraperl::VERSION\n";
189	0						print "$Oraperl::drh->{Attribution}\n";
190	0						print "$sw->{Attribution}\n\n";
191							}
192
193
194							# -----------------------------------------------------------------
195							#
196							# $ora_errno
197							# $ora_errstr
198							*Oraperl::ora_errno = \$DBI::err;
199							*Oraperl::ora_errstr = \$DBI::errstr;
200
201
202							# -----------------------------------------------------------------
203							#
204							# $ora_verno
205							# $ora_debug not supported, use $h->debug(2) where $h is $lda or $csr
206							# $ora_cache not supported
207							# $ora_long used at ora_open()
208							# $ora_trunc used at ora_open()
209
210							$Oraperl::ora_verno = '3.000'; # to distinguish it from oraperl 2.4
211
212							# ora_long is left unset so that the DBI $h->{LongReadLen} attrib will be used
213							# by default. If ora_long is set then LongReadLen will be ignored (sadly) but
214							# that behaviour may change later to only apply to oraperl mode handles.
215							#$Oraperl::ora_long = 80; # 80, oraperl default
216							$Oraperl::ora_trunc = 0; # long trunc is error, oraperl default
217
218
219							# -----------------------------------------------------------------
220							#
221							# Non-oraperl extensions added here to make it easy to still run
222							# script using oraperl (by avoiding $csr->blob_read(...))
223
224							*ora_readblob = _func_ref('st::blob_read');
225
226
227							1;
228							__END__
229
230							=head1 NAME
231
232							Oraperl - Perl access to Oracle databases for old oraperl scripts
233
234							=head1 SYNOPSIS
235
236							eval 'use Oraperl; 1;' \|\| die $@ if $] >= 5; # ADD THIS LINE TO OLD SCRIPTS
237
238							$lda = &ora_login($system_id, $name, $password)
239							$csr = &ora_open($lda, $stmt [, $cache])
240							&ora_bind($csr, $var, ...)
241							&ora_fetch($csr [, $trunc])
242							&ora_close($csr)
243							&ora_logoff($lda)
244
245							&ora_do($lda, $stmt)
246
247							&ora_titles($csr)
248							&ora_lengths($csr)
249							&ora_types($csr)
250							&ora_commit($lda)
251							&ora_rollback($lda)
252							&ora_autocommit($lda, $on_off)
253							&ora_version()
254
255							$ora_cache
256							$ora_long
257							$ora_trunc
258							$ora_errno
259							$ora_errstr
260							$ora_verno
261
262							$ora_debug
263
264							=head1 DESCRIPTION
265
266							Oraperl is an extension to Perl which allows access to Oracle databases.
267
268							The original oraperl was a Perl 4 binary with Oracle OCI compiled into it.
269							The Perl 5 Oraperl module described here is distributed with L<DBD::Oracle>
270							(a database driver what operates within L<DBI>) and adds an extra layer over
271							L<DBI> method calls.
272							The Oraperl module should only be used to allow existing Perl 4 oraperl scripts
273							to run with minimal changes; any new development should use L<DBI> directly.
274
275							The functions which make up this extension are described in the
276							following sections. All functions return a false or undefined (in the
277							Perl sense) value to indicate failure. You do not need to understand
278							the references to OCI in these descriptions. They are here to help
279							those who wish to extend the routines or to port them to new machines.
280
281							The text in this document is largely unchanged from the original Perl4
282							oraperl manual written by Kevin Stock <kstock@auspex.fr>. Any comments
283							specific to the DBD::Oracle Oraperl emulation are prefixed by B<DBD:>.
284							See the DBD::Oracle and DBI manuals for more information.
285
286							B<DBD:> In order to make the oraperl function definitions available in
287							perl5 you need to arrange to 'use' the Oraperl.pm module in each file
288							or package which uses them. You can do this by simply adding S<C<use
289							Oraperl;>> in each file or package. If you need to make the scripts work
290							with both the perl4 oraperl and perl5 you should add add the following
291							text instead:
292
293							eval 'use Oraperl; 1;' \|\| die $@ if $] >= 5;
294
295							=head2 Principal Functions
296
297							The main functions for database access are &ora_login(), &ora_open(),
298							&ora_bind(), &ora_fetch(), &ora_close(), &ora_do() and &ora_logoff().
299
300							=over 2
301
302							=item * ora_login
303
304							$lda = &ora_login($system_id, $username, $password)
305
306							In order to access information held within an Oracle database, a
307							program must first log in to it by calling the &ora_login() function.
308							This function is called with three parameters, the system ID (see
309							below) of the Oracle database to be used, and the Oracle username and
310							password. The value returned is a login identifier (actually an Oracle
311							Login Data Area) referred to below as $lda.
312
313							Multiple logins may be active simultaneously. This allows a simple
314							mechanism for correlating or transferring data between databases.
315
316							Most Oracle programs (for example, SQLPlus or SQLForms) examine the
317							environment variable ORACLE_SID or TWO_TASK to determine which database
318							to connect to. In an environment which uses several different
319							databases, it is easy to make a mistake, and attempt to run a program
320							on the wrong one. Also, it is cumbersome to create a program which
321							works with more than one database simultaneously. Therefore, Oraperl
322							requires the system ID to be passed as a parameter. However, if the
323							system ID parameter is an empty string then oracle will use the
324							existing value of ORACLE_SID or TWO_TASK in the usual manner.
325
326							Example:
327
328							$lda = &ora_login('personnel', 'scott', 'tiger') \|\| die $ora_errstr;
329
330							This function is equivalent to the OCI olon and orlon functions.
331
332							B<DBD:> note that a name is assumed to be a TNS alias if it does not
333							appear as the name of a SID in /etc/oratab or /var/opt/oracle/oratab.
334							See the code in Oracle.pm for the full logic of database name handling.
335
336							B<DBD:> Since the returned $lda is a Perl5 reference the database login
337							identifier is now automatically released if $lda is overwritten or goes
338							out of scope.
339
340							=item * ora_open
341
342							$csr = &ora_open($lda, $statement [, $cache])
343
344							To specify an SQL statement to be executed, the program must call the
345							&ora_open() function. This function takes at least two parameters: a
346							login identifier (obtained from &ora_login()) and the SQL statement to
347							be executed. An optional third parameter specifies the size of the row
348							cache to be used for a SELECT statement. The value returned from
349							&ora_open() is a statement identifier (actually an ORACLE Cursor)
350							referred to below as $csr.
351
352							If the row cache size is not specified, a default size is
353							used. As distributed, the default is five rows, but this
354							may have been changed at your installation (see the
355							&ora_version() function and $ora_cache variable below).
356
357							Examples:
358
359							$csr = &ora_open($lda, 'select ename, sal from emp order by ename', 10);
360
361							$csr = &ora_open($lda, 'insert into dept values(:1, :2, :3)');
362
363							This function is equivalent to the OCI oopen and oparse functions. For
364							statements which do not contain substitution variables (see the section
365							Substitution Variables below), it also uses of the oexec function. For
366							SELECT statements, it also makes use of the odescr and odefin functions
367							to allocate memory for the values to be returned from the database.
368
369							=item * ora_bind
370
371							&ora_bind($csr, $var, ...)
372
373							If an SQL statement contains substitution variables (see the section
374							Substitution Variables below), &ora_bind() is used to assign actual
375							values to them. This function takes a statement identifier (obtained
376							from &ora_open()) as its first parameter, followed by as many
377							parameters as are required by the statement.
378
379							Example:
380
381							&ora_bind($csr, 50, 'management', 'Paris');
382
383							This function is equivalent to the OCI obndrn and oexec statements.
384
385							The OCI obndrn function does not allow empty strings to be bound. As
386							distributed, $ora_bind therefore replaces empty strings with a single
387							space. However, a compilation option allows this substitution to be
388							suppressed, causing &ora_bind() to fail. The output from the
389							&ora_version() function specifies which is the case at your installation.
390
391							=item * ora_fetch
392
393							$nfields = &ora_fetch($csr)
394
395							@data = &ora_fetch($csr [, $trunc])
396
397							The &ora_fetch() function is used in conjunction with a SQL SELECT
398							statement to retrieve information from a database. This function takes
399							one mandatory parameter, a statement identifier (obtained from
400							&ora_open()).
401
402							Used in a scalar context, the function returns the number of fields
403