Apache-LoggedAuthDBI
view release on metacpan or search on metacpan
# XXX warn if BegunWork?
# XXX warn if $dbh->FETCH('AutoCommit') != $attr->{AutoCommit} ?
# but that's just one (bad) case of a more general issue.
return $dbh;
}
$dbh = $drh->connect(@_);
$cache->{$key} = $dbh; # replace prev entry, even if connect failed
return $dbh;
}
}
{ package # hide from PAUSE
DBD::_::db; # ====== DATABASE ======
@DBD::_::db::ISA = qw(DBD::_::common);
use strict;
sub clone {
my ($old_dbh, $attr) = @_;
my $closure = $old_dbh->{dbi_connect_closure} or return;
unless ($attr) {
# copy attributes visible in the attribute cache
keys %$old_dbh; # reset iterator
while ( my ($k, $v) = each %$old_dbh ) {
# ignore non-code refs, i.e., caches, handles, Err etc
next if ref $v && ref $v ne 'CODE'; # HandleError etc
$attr->{$k} = $v;
}
# explicitly set attributes which are unlikely to be in the
# attribute cache, i.e., boolean's and some others
$attr->{$_} = $old_dbh->FETCH($_) for (qw(
AutoCommit ChopBlanks InactiveDestroy
LongTruncOk PrintError PrintWarn Profile RaiseError
ShowErrorStatement TaintIn TaintOut
));
}
# use Data::Dumper; warn Dumper([$old_dbh, $attr]);
my $new_dbh = &$closure($old_dbh, $attr);
unless ($new_dbh) {
# need to copy err/errstr from driver back into $old_dbh
my $drh = $old_dbh->{Driver};
return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
}
return $new_dbh;
}
sub quote_identifier {
my ($dbh, @id) = @_;
my $attr = (@id > 3 && ref($id[-1])) ? pop @id : undef;
my $info = $dbh->{dbi_quote_identifier_cache} ||= [
$dbh->get_info(29) || '"', # SQL_IDENTIFIER_QUOTE_CHAR
$dbh->get_info(41) || '.', # SQL_CATALOG_NAME_SEPARATOR
$dbh->get_info(114) || 1, # SQL_CATALOG_LOCATION
];
my $quote = $info->[0];
foreach (@id) { # quote the elements
next unless defined;
s/$quote/$quote$quote/g; # escape embedded quotes
$_ = qq{$quote$_$quote};
}
# strip out catalog if present for special handling
my $catalog = (@id >= 3) ? shift @id : undef;
# join the dots, ignoring any null/undef elements (ie schema)
my $quoted_id = join '.', grep { defined } @id;
if ($catalog) { # add catalog correctly
$quoted_id = ($info->[2] == 2) # SQL_CL_END
? $quoted_id . $info->[1] . $catalog
: $catalog . $info->[1] . $quoted_id;
}
return $quoted_id;
}
sub quote {
my ($dbh, $str, $data_type) = @_;
return "NULL" unless defined $str;
unless ($data_type) {
$str =~ s/'/''/g; # ISO SQL2
return "'$str'";
}
my $dbi_literal_quote_cache = $dbh->{'dbi_literal_quote_cache'} ||= [ {} , {} ];
my ($prefixes, $suffixes) = @$dbi_literal_quote_cache;
my $lp = $prefixes->{$data_type};
my $ls = $suffixes->{$data_type};
if ( ! defined $lp || ! defined $ls ) {
my $ti = $dbh->type_info($data_type);
$lp = $prefixes->{$data_type} = $ti ? $ti->{LITERAL_PREFIX} || "" : "'";
$ls = $suffixes->{$data_type} = $ti ? $ti->{LITERAL_SUFFIX} || "" : "'";
}
return $str unless $lp || $ls; # no quoting required
# XXX don't know what the standard says about escaping
# in the 'general case' (where $lp != "'").
# So we just do this and hope:
$str =~ s/$lp/$lp$lp/g
if $lp && $lp eq $ls && ($lp eq "'" || $lp eq '"');
return "$lp$str$ls";
}
sub rows { -1 } # here so $DBI::rows 'works' after using $dbh
sub do {
my($dbh, $statement, $attr, @params) = @_;
my $sth = $dbh->prepare($statement, $attr) or return undef;
$sth->execute(@params) or return undef;
my $rows = $sth->rows;
($rows == 0) ? "0E0" : $rows;
}
sub _do_selectrow {
my ($method, $dbh, $stmt, $attr, @bind) = @_;
my $sth = ((ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr))
The data_string_desc() function was added in DBI 1.46.
=item C<data_string_diff>
$diff = data_string_diff($a, $b);
Returns an informal description of the first character difference
between the strings. If both $a and $b contain the same sequence
of characters then data_string_diff() returns an empty string.
For example:
Params a & b Result
------------ ------
'aaa', 'aaa' ''
'aaa', 'abc' 'Strings differ at index 2: a[2]=a, b[2]=b'
'aaa', undef 'String b is undef, string a has 3 characters'
'aaa', 'aa' 'String b truncated after 2 characters'
Unicode characters are reported in C<\x{XXXX}> format. Unicode
code points in the range U+0800 to U+08FF are unassigned and most
likely to occur due to double-encoding. Characters in this range
are reported as C<\x{08XX}='C'> where C<C> is the corresponding
latin-1 character.
The data_string_diff() function only considers logical I<characters>
and not the underlying encoding. See L</data_diff> for an alternative.
The data_string_diff() function was added in DBI 1.46.
=item C<data_diff>
$diff = data_diff($a, $b);
$diff = data_diff($a, $b, $logical);
Returns an informal description of the difference between two strings.
It calls L</data_string_desc> and L</data_string_diff>
and returns the combined results as a multi-line string.
For example, C<data_diff("abc", "ab\x{263a}")> will return:
a: UTF8 off, ASCII, 3 characters 3 bytes
b: UTF8 on, non-ASCII, 3 characters 5 bytes
Strings differ at index 2: a[2]=c, b[2]=\x{263A}
If $a and $b are identical in both the characters they contain I<and>
their physical encoding then data_diff() returns an empty string.
If $logical is true then physical encoding differences are ignored
(but are still reported if there is a difference in the characters).
The data_diff() function was added in DBI 1.46.
=item C<neat>
$str = neat($value);
$str = neat($value, $maxlen);
Return a string containing a neat (and tidy) representation of the
supplied value.
Strings will be quoted, although internal quotes will I<not> be escaped.
Values known to be numeric will be unquoted. Undefined (NULL) values
will be shown as C<undef> (without quotes).
If the string is flagged internally as utf8 then double quotes will
be used, otherwise single quotes are used and unprintable characters
will be replaced by dot (.).
For result strings longer than C<$maxlen> the result string will be
truncated to C<$maxlen-4> and "C<...'>" will be appended. If C<$maxlen> is 0
or C<undef>, it defaults to C<$DBI::neat_maxlen> which, in turn, defaults to 400.
This function is designed to format values for human consumption.
It is used internally by the DBI for L</trace> output. It should
typically I<not> be used for formatting values for database use.
(See also L</quote>.)
=item C<neat_list>
$str = neat_list(\@listref, $maxlen, $field_sep);
Calls C<neat> on each element of the list and returns a string
containing the results joined with C<$field_sep>. C<$field_sep> defaults
to C<", ">.
=item C<looks_like_number>
@bool = looks_like_number(@array);
Returns true for each element that looks like a number.
Returns false for each element that does not look like a number.
Returns C<undef> for each element that is undefined or empty.
=item C<hash>
$hash_value = DBI::hash($buffer, $type);
Return a 32-bit integer 'hash' value corresponding to the contents of $buffer.
The $type parameter selects which kind of hash algorithm should be used.
For the technically curious, type 0 (which is the default if $type
isn't specified) is based on the Perl 5.1 hash except that the value
is forced to be negative (for obscure historical reasons).
Type 1 is the better "Fowler / Noll / Vo" (FNV) hash. See
L<http://www.isthe.com/chongo/tech/comp/fnv/> for more information.
Both types are implemented in C and are very fast.
This function doesn't have much to do with databases, except that
it can be handy to store hash values in a database.
=back
=head2 DBI Dynamic Attributes
Dynamic attributes are always associated with the I<last handle used>
(that handle is represented by C<$h> in the descriptions below).
Where an attribute is equivalent to a method call, then refer to
the method call for all related documentation.
point, it's undocumented and very liable to change. (Volunteers to
polish up and document the interface are very welcome to get in
touch via dbi-dev@perl.org)
Methods installed using install_method default to the standard error
handling behaviour for DBI methods: clearing err and errstr before
calling the method, and checking for errors to trigger RaiseError
etc. on return. This differs from the default behaviour of func().
Note for driver authors: The DBD::Foo::xx->install_method call won't
work until the class-hierarchy has been setup. Normally the DBI
looks after that just after the driver is loaded. This means
install_method() can't be called at the time the driver is loaded
unless the class-hierarchy is set up first. The way to do that is
to call the setup_driver() method:
DBI->setup_driver('DBD::Foo');
before using install_method().
=back
=head1 FURTHER INFORMATION
=head2 Catalog Methods
An application can retrieve metadata information from the DBMS by issuing
appropriate queries on the views of the Information Schema. Unfortunately,
C<INFORMATION_SCHEMA> views are seldom supported by the DBMS.
Special methods (catalog methods) are available to return result sets
for a small but important portion of that metadata:
column_info
foreign_key_info
primary_key_info
table_info
All catalog methods accept arguments in order to restrict the result sets.
Passing C<undef> to an optional argument does not constrain the search for
that argument.
However, an empty string ('') is treated as a regular search criteria
and will only match an empty value.
B<Note>: SQL/CLI and ODBC differ in the handling of empty strings. An
empty string will not restrict the result set in SQL/CLI.
Most arguments in the catalog methods accept only I<ordinary values>, e.g.
the arguments of C<primary_key_info()>.
Such arguments are treated as a literal string, i.e. the case is significant
and quote characters are taken literally.
Some arguments in the catalog methods accept I<search patterns> (strings
containing '_' and/or '%'), e.g. the C<$table> argument of C<column_info()>.
Passing '%' is equivalent to leaving the argument C<undef>.
B<Caveat>: The underscore ('_') is valid and often used in SQL identifiers.
Passing such a value to a search pattern argument may return more rows than
expected!
To include pattern characters as literals, they must be preceded by an
escape character which can be achieved with
$esc = $dbh->get_info( 14 ); # SQL_SEARCH_PATTERN_ESCAPE
$search_pattern =~ s/([_%])/$esc$1/g;
The ODBC and SQL/CLI specifications define a way to change the default
behaviour described above: All arguments (except I<list value arguments>)
are treated as I<identifier> if the C<SQL_ATTR_METADATA_ID> attribute is
set to C<SQL_TRUE>.
I<Quoted identifiers> are very similar to I<ordinary values>, i.e. their
body (the string within the quotes) is interpreted literally.
I<Unquoted identifiers> are compared in UPPERCASE.
The DBI (currently) does not support the C<SQL_ATTR_METADATA_ID> attribute,
i.e. it behaves like an ODBC driver where C<SQL_ATTR_METADATA_ID> is set to
C<SQL_FALSE>.
=head2 Transactions
Transactions are a fundamental part of any robust database system. They
protect against errors and database corruption by ensuring that sets of
related changes to the database take place in atomic (indivisible,
all-or-nothing) units.
This section applies to databases that support transactions and where
C<AutoCommit> is off. See L</AutoCommit> for details of using C<AutoCommit>
with various types of databases.
The recommended way to implement robust transactions in Perl
applications is to use C<RaiseError> and S<C<eval { ... }>>
(which is very fast, unlike S<C<eval "...">>). For example:
$dbh->{AutoCommit} = 0; # enable transactions, if possible
$dbh->{RaiseError} = 1;
eval {
foo(...) # do lots of work here
bar(...) # including inserts
baz(...) # and updates
$dbh->commit; # commit the changes if we get this far
};
if ($@) {
warn "Transaction aborted because $@";
# now rollback to undo the incomplete changes
# but do it in an eval{} as it may also fail
eval { $dbh->rollback };
# add other application on-error-clean-up code here
}
If the C<RaiseError> attribute is not set, then DBI calls would need to be
manually checked for errors, typically like this:
$h->method(@args) or die $h->errstr;
With C<RaiseError> set, the DBI will automatically C<die> if any DBI method
call on that handle (or a child handle) fails, so you don't have to
test the return value of each method call. See L</RaiseError> for more
details.
A major advantage of the C<eval> approach is that the transaction will be
properly rolled back if I<any> code (not just DBI calls) in the inner
( run in 1.047 second using v1.01-cache-2.11-cpan-59e3e3084b8 )