Author: darnold
Date: Thu Nov 30 16:47:22 2006
New Revision: 8328
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/01basics.t
Log:
added SQL_BIGINT support; closed a C<> pod tag
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Thu Nov 30 16:47:22 2006
@@ -12,6 +12,8 @@
Changed t/40profile.t to skip tests for perl < 5.8.0.
Updated DBI::DBD docs for driver authors thanks to Ammon Riley.
+ Added SQL_BIGINT type code (resolved to the ODBC/JDBC value (-5))
+
=head2 Changes in DBI 1.53 (svn rev 7995), 31st October 2006
Fixed checks for weaken to work with early 5.8.x versions
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Thu Nov 30 16:47:22 2006
@@ -167,6 +167,7 @@
SQL_WLONGVARCHAR
SQL_WVARCHAR
SQL_WCHAR
+ SQL_BIGINT
SQL_BIT
SQL_TINYINT
SQL_LONGVARBINARY
@@ -277,7 +278,7 @@
}
# check for weaken support, used by ChildHandles
-my $HAS_WEAKEN = eval {
+my $HAS_WEAKEN = eval {
require Scalar::Util;
# this will croak() if this Scalar::Util doesn't have a working weaken().
Scalar::Util::weaken( \my $test ); # same test as in t/72childhandles.t
@@ -1051,7 +1052,7 @@
$diff .= "\n" if $diff;
return "a: $a_desc\nb: $b_desc\n$diff";
}
-
+
sub data_string_diff {
# Compares 'logical' characters, not bytes, so a latin1 string and an
@@ -1111,7 +1112,7 @@
# (might be ascii so also need to check for hibit to make it worthwhile)
# - UTF8 flag set but invalid UTF8 byte sequence
# could do better here, but this'll do for now
- my $utf8 = sprintf "UTF8 %s%s",
+ my $utf8 = sprintf "UTF8 %s%s",
utf8::is_utf8($a) ? "on" : "off",
utf8::valid($a||'') ? "" : " but INVALID encoding";
return "$utf8, undef" unless defined $a;
@@ -1804,12 +1805,12 @@
# use bind_param_array() so long as they don't pass any attribs.
$$hash_of_arrays{$p_id} = $value_array;
- return $sth->bind_param($p_id, undef, $attr)
+ return $sth->bind_param($p_id, undef, $attr)
if $attr;
1;
}
- sub bind_param_inout_array {
+ sub bind_param_inout_array {
my $sth = shift;
# XXX not supported so we just call bind_param_array instead
# and then return an error
@@ -2353,7 +2354,7 @@
UPDATE people SET age = ? WHERE fullname = ?
});
$sth->execute(undef, "Joe Bloggs");
-
+
However, care must be taken when trying to use NULL values in a
C<WHERE> clause. Consider:
@@ -2416,7 +2417,7 @@
4) age = ? OR (age IS NULL AND ? IS NULL)
5) age = ? OR (age IS NULL AND SP_ISNULL(?) = 1)
6) age = ? OR (age IS NULL AND ? = 1)
-
+
Statements formed with the above C<WHERE> clauses require execute
statements as follows. The arguments are required, whether their
values are C<defined> or C<undef>.
@@ -2453,7 +2454,7 @@
Informix IDS 9 N N N Y N Y Y
MS SQL N N Y N Y ? Y
Sybase Y N N N N N Y
- AnyData,DBM,CSV Y N N N Y Y* Y
+ AnyData,DBM,CSV Y N N N Y Y* Y
* Works only because Example 0 works.
@@ -3398,7 +3399,7 @@
my ($h, $level) = @_;
$level ||= 0;
printf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
- show_child_handles($_, $level + 1)
+ show_child_handles($_, $level + 1)
for (grep { defined } @{$h->{ChildHandles}});
}
@@ -4095,7 +4096,7 @@
@result = @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
See L</fetchall_arrayref> method for more details.
-
+
=item C<selectall_hashref>
$hash_ref = $dbh->selectall_hashref($statement, $key_field);
@@ -4283,14 +4284,14 @@
$sth = $dbh->prepare_cached("...", { dbi_dummy => __FILE__.__LINE__ });
which will ensure that prepare_cached only returns statements cached
-by that line of code in that source file.
+by that line of code in that source file.
+
+If you'd like the cache to managed intelligently, you can tie the
+hashref returned by C<CachedKids> to an appropriate caching module,
+such as L<Tie::Cache::LRU>:
-If you'd like the cache to managed intelligently, you can tie the
-hashref returned by C<CachedKids> to an appropriate caching module,
-such as L<Tie::Cache::LRU>:
-
- my $cache = $dbh->{CachedKids};
- tie %$cache, 'Tie::Cache::LRU', 500;
+ my $cache = $dbh->{CachedKids};
+ tie %$cache, 'Tie::Cache::LRU', 500;
=item C<commit>
@@ -5518,7 +5519,7 @@
not implemented array binding) is to iteratively call L</execute> for
each parameter tuple provided in the bound arrays. Drivers may
provide more optimized implementations using whatever bulk operation
-support the database API provides. The default driver behaviour should
+support the database API provides. The default driver behaviour should
match the default DBI behaviour, but always consult your driver
documentation as there may be driver specific issues to consider.
@@ -6746,7 +6747,7 @@
The two most common uses of signals in relation to the DBI are for
canceling operations when the user types Ctrl-C (interrupt), and for
-implementing a timeout using C<alarm()> and C<$SIG{ALRM}>.
+implementing a timeout using C<alarm()> and C<$SIG{ALRM}>.
=over 4
@@ -6801,7 +6802,7 @@
use POSIX ':signal_h';
my $mask = POSIX::SigSet->new( SIGALRM ); # signals to mask in the handler
- my $action = POSIX::SigAction->new(
+ my $action = POSIX::SigAction->new(
sub { die "connect timeout" }, # the handler code ref
$mask,
# not using (perl 5.8.2 and later) 'safe' switch or sa_flags
@@ -6820,8 +6821,8 @@
Similar techniques can be used for canceling statement execution.
-Unfortunately, this solution is somewhat messy, and it does I<not> work with
-perl versions less than perl 5.8 where C<POSIX::sigaction()> appears to be
broken.
+Unfortunately, this solution is somewhat messy, and it does I<not> work with
+perl versions less than perl 5.8 where C<POSIX::sigaction()> appears to be
broken.
For a cleaner implementation that works across perl versions, see Lincoln
Baxter's
Sys::SigAction module at L<http://search.cpan.org/~lbaxter/Sys-SigAction/>.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Thu Nov 30 16:47:22 2006
@@ -182,7 +182,7 @@
static PERINTERP_t Interp;
# define dPERINTERP typedef int _interp_DBI_dummy
# define PERINTERP (&Interp)
-# define INIT_PERINTERP
+# define INIT_PERINTERP
#endif
#define g_dbi_last_h (PERINTERP->dbi_last_h)
@@ -211,7 +211,7 @@
/* --- */
static void
-check_version(const char *name, int dbis_cv, int dbis_cs, int need_dbixs_cv,
int drc_s,
+check_version(const char *name, int dbis_cv, int dbis_cs, int need_dbixs_cv,
int drc_s,
int dbc_s, int stc_s, int fdc_s)
{
dTHX;
@@ -234,7 +234,7 @@
static void
dbi_bootinit(dbistate_t * parent_dbis)
{
- dTHX;
+ dTHX;
INIT_PERINTERP;
DBIS = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st));
@@ -1034,7 +1034,7 @@
strcpy(imp_mem_name, imp_class);
strcat(imp_mem_name, "_mem");
- if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL)
+ if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL)
croak(errmsg, neatsvpv(orv,0), imp_mem_name, "unknown _mem package");
if ((svp = hv_fetch((HV*)SvRV(h), "dbi_imp_data", 12, 0))) {
@@ -1095,7 +1095,7 @@
SV *sv = av_shift(av);
if (SvOK(sv))
av_push(av, sv);
- else
+ else
sv_free(sv); /* keep it leak-free by Doru
Petrescu [EMAIL PROTECTED] */
}
}
@@ -1227,7 +1227,7 @@
static void
dbih_clearcom(imp_xxh_t *imp_xxh)
{
-
+
dTHX;
dPERINTERP;
dTHR;
@@ -1244,7 +1244,7 @@
#ifdef DBI_USE_THREADS
if (DBIc_THR_USER(imp_xxh) != my_perl) { /* don't clear handle that
belongs to another thread */
if (debug >= 3) {
- PerlIO_printf(DBILOGFP," skipped dbih_clearcom: DBI handle
(type=%d, %s) is owned by thread %p not current thread %p\n",
+ PerlIO_printf(DBILOGFP," skipped dbih_clearcom: DBI handle
(type=%d, %s) is owned by thread %p not current thread %p\n",
DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)),
DBIc_THR_USER(imp_xxh), my_perl) ;
PerlIO_flush(DBILOGFP);
}
@@ -1849,7 +1849,7 @@
valuesv = &sv_undef;
break;
}
-
+
}
else
if (htype == DBIt_DB) {
@@ -1885,7 +1885,7 @@
valuesv = newSViv(DBIc_ACTIVE_KIDS(imp_xxh));
}
break;
-
+
case 'B':
if (keylen==9 && strEQ(key, "BegunWork")) {
valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_BegunWork));
@@ -2029,7 +2029,7 @@
))
warn("Can't get %s->{%s}: unrecognised attribute
name",neatsvpv(h,0),key);
}
-
+
if (cacheit) {
hv_store((HV*)SvRV(h), key, keylen, newSVsv(valuesv), 0);
}
@@ -2118,7 +2118,7 @@
continue;
if (!(stashname[0] == 'D' && stashname[1] == 'B'
&& strchr("DI", stashname[2])
- && (!stashname[3] || (stashname[3] == ':' && stashname[4]
== ':'))))
+ && (!stashname[3] || (stashname[3] == ':' && stashname[4]
== ':'))))
{
return cx->blk_oldcop;
}
@@ -3003,7 +3003,7 @@
SPAGAIN;
if (trace_level) { /* XXX restore local vars so ST(n) works below
*/
- sp -= outitems; ax = (sp - stack_base) + 1;
+ sp -= outitems; ax = (sp - stack_base) + 1;
}
#ifdef DBI_save_hv_fetch_ent
@@ -3334,7 +3334,7 @@
#define DBIpp_cm_br 0x000008 /* {} */
#define DBIpp_cm_dw 0x000010 /* '-- ' dash dash whitespace */
#define DBIpp_cm_XX 0x00001F /* any of the above */
-
+
#define DBIpp_ph_qm 0x000100 /* ? */
#define DBIpp_ph_cn 0x000200 /* :1 */
#define DBIpp_ph_cs 0x000400 /* :name */
@@ -3408,14 +3408,14 @@
src = statement;
dest = SvPVX(new_stmt_sv);
- while( *src )
+ while( *src )
{
if (*src == '%' && PS_return(DBIpp_ph_sp))
*dest++ = '%';
if (in_comment)
{
- if ( (in_comment == '-' && (*src == '\n' || *(src+1) ==
'\0'))
+ if ( (in_comment == '-' && (*src == '\n' || *(src+1) ==
'\0'))
|| (in_comment == '#' && (*src == '\n' || *(src+1) ==
'\0'))
|| (in_comment == DBIpp_L_BRACE && *src == DBIpp_R_BRACE)
/* XXX nesting? */
|| (in_comment == '/' && *src == '*' && *(src+1) == '/')
@@ -3436,7 +3436,7 @@
in_comment = '\0';
rt_comment = '\0';
}
- else
+ else
if (rt_comment)
*dest++ = *src++;
else
@@ -3489,7 +3489,7 @@
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
*dest++ = rt_comment = '-';
*dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
+ if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
}
else if (PS_return(DBIpp_cm_hs)) {
*dest++ = rt_comment = '#';
@@ -3509,7 +3509,7 @@
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
*dest++ = rt_comment = '-';
*dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
+ if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
}
else if (PS_return(DBIpp_cm_cs)) {
*dest++ = rt_comment = '/';
@@ -3530,7 +3530,7 @@
else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
*dest++ = rt_comment = '-';
*dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
+ if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
}
else if (PS_return(DBIpp_cm_cs)) {
*dest++ = rt_comment = '/';
@@ -3553,7 +3553,7 @@
/* only here for : or ? outside of a comment or literal */
- start = dest; /* save name inc colon */
+ start = dest; /* save name inc colon */
*dest++ = *src++; /* copy and move past first char */
if (*start == '?') /* X/Open Standard */
@@ -3570,8 +3570,8 @@
*start = '%';
*dest++ = 's';
}
- }
- else if (isDIGIT(*src)) { /* :1 */
+ }
+ else if (isDIGIT(*src)) { /* :1 */
const int pln = atoi(src);
style = ":1";
@@ -3595,8 +3595,8 @@
while(isDIGIT(*src)) src++;
idx++;
}
- }
- else if (isALNUM(*src)) /* :name */
+ }
+ else if (isALNUM(*src)) /* :name */
{
style = ":name";
@@ -3676,6 +3676,7 @@
SQL_ALL_TYPES = SQL_ALL_TYPES
SQL_ARRAY = SQL_ARRAY
SQL_ARRAY_LOCATOR = SQL_ARRAY_LOCATOR
+ SQL_BIGINT = SQL_BIGINT
SQL_BINARY = SQL_BINARY
SQL_BIT = SQL_BIT
SQL_BLOB = SQL_BLOB
@@ -3832,7 +3833,7 @@
else
PUSHs(&sv_no);
}
-
+
void
_install_method(dbi_class, meth_name, file, attribs=Nullsv)
@@ -4163,7 +4164,7 @@
sv_unmagic(SvRV(*hp), 'P'); /* untie */
sv_bless(*hp, zombie_stash); /* neutralise */
}
- }
+ }
}
/* The above measures may not be sufficient if weakrefs aren't available
* or something has a reference to the inner-handle of an sth.
@@ -4440,7 +4441,7 @@
if (!dbih_set_attr_k(h, keysv, 0, valuesv))
ST(0) = &sv_no;
(void)cv;
-
+
void
FETCH(h, keysv)
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Thu Nov 30 16:47:22 2006
@@ -497,7 +497,7 @@
=over 4
-=item *
+=item *
Listing B<Bundle::DBI> as the main pre-requisite simplifies life.
@@ -887,7 +887,7 @@
=head4 The statement handle constructor
-There's nothing much new in the statement handle constructor, which
+There's nothing much new in the statement handle constructor, which
is the C<prepare()> method:
sub prepare
@@ -1054,7 +1054,7 @@
=head4 The execute() and bind_param() methods
This is perhaps the most difficult method because we have to consider
-parameter bindings here. In addition to that, there are a number of
+parameter bindings here. In addition to that, there are a number of
statement attributes which must be set for inherited B<DBI> methods to
function correctly (see L</Statement attributes> below).
@@ -1156,16 +1156,16 @@
The main difference between I<dbh> and I<sth> attributes is, that you
should implement a lot of attributes here that are required by
-the B<DBI>, such as I<NAME>, I<NULLABLE>, I<TYPE>, etc. See
+the B<DBI>, such as I<NAME>, I<NULLABLE>, I<TYPE>, etc. See
L<DBI/Statement Handle Attributes> for a complete list.
-Pay attention to attributes which are marked as read only, such as
+Pay attention to attributes which are marked as read only, such as
I<NUM_OF_FIELDS>. These attributes can only be set the first time
-a statement is executed. If a statement is prepared, then executed
+a statement is executed. If a statement is prepared, then executed
multiple times, warnings may be generated.
You can protect against these warnings, and prevent the recalculation
-of attributes which might be expensive to calculate (such as the
+of attributes which might be expensive to calculate (such as the
I<NAME> and I<NAME_*> attributes):
my $storedNumFields = $sth->FETCH('NUM_OF_FIELDS');
@@ -2424,7 +2424,7 @@
analogous job for the B<DBI> C<type_info_all()> metadata method. The
C<write_typeinfo_pm()> method was added to B<DBI> v1.33.
-You examine the documentation for C<write_typeinfo_pm() using:
+You examine the documentation for C<write_typeinfo_pm()> using:
perldoc DBI::DBD::Metadata
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Thu Nov 30 16:47:22 2006
@@ -39,10 +39,10 @@
select( (select($DBI::tfh), $| = 1)[0] ); # autoflush
# check for weaken support, used by ChildHandles
-my $HAS_WEAKEN = eval {
+my $HAS_WEAKEN = eval {
require Scalar::Util;
# this will croak() if this Scalar::Util doesn't have a working weaken().
- Scalar::Util::weaken( my $test = [] );
+ Scalar::Util::weaken( my $test = [] );
1;
};
@@ -51,6 +51,7 @@
use constant SQL_ALL_TYPES => 0;
use constant SQL_ARRAY => 50;
use constant SQL_ARRAY_LOCATOR => 51;
+use constant SQL_BIGINT => (-5);
use constant SQL_BINARY => (-2);
use constant SQL_BIT => (-7);
use constant SQL_BLOB => 30;
@@ -463,7 +464,7 @@
@$handles = grep { defined } @$handles;
Scalar::Util::weaken($_) for @$handles; # re-weaken after grep
}
- }
+ }
}
else { # setting up a driver handle
$h_inner->{Warn} = 1;
Modified: dbi/trunk/t/01basics.t
==============================================================================
--- dbi/trunk/t/01basics.t (original)
+++ dbi/trunk/t/01basics.t Thu Nov 30 16:47:22 2006
@@ -2,15 +2,15 @@
use strict;
-use Test::More tests => 131;
+use Test::More tests => 132;
use File::Spec;
$|=1;
## ----------------------------------------------------------------------------
-## 01basic.t - test of some basic DBI functions
+## 01basic.t - test of some basic DBI functions
## ----------------------------------------------------------------------------
-# Mostly this script takes care of testing the items exported by the 3
+# Mostly this script takes care of testing the items exported by the 3
# tags below (in this order):
# - :sql_types
# - :squl_cursor_types
@@ -38,7 +38,7 @@
## load DBI and export some symbols
BEGIN {
use_ok('DBI', qw(
- :sql_types
+ :sql_types
:sql_cursor_types
:utils
));
@@ -53,6 +53,7 @@
cmp_ok(SQL_WCHAR , '==', -8, '... testing sql_type');
cmp_ok(SQL_BIT , '==', -7, '... testing sql_type');
cmp_ok(SQL_TINYINT , '==', -6, '... testing sql_type');
+cmp_ok(SQL_BIGINT , '==', -5, '... testing sql_type');
cmp_ok(SQL_LONGVARBINARY , '==', -4, '... testing sql_type');
cmp_ok(SQL_VARBINARY , '==', -3, '... testing sql_type');
cmp_ok(SQL_BINARY , '==', -2, '... testing sql_type');
@@ -172,7 +173,7 @@
# NOTE:
# check too see if this covers all the attributes or not
-# TO DO:
+# TO DO:
# these three can be improved
$switch->debug(0);
pass('... test debug');
@@ -216,7 +217,7 @@
cmp_ok($warn, 'eq', "", '... we should get no warnings here');
}
-# is this here for a reason? Are we testing anything?
+# is this here for a reason? Are we testing anything?
$switch->trace_msg("Test \$h->trace_msg text.\n", 1);
DBI->trace_msg("Test DBI->trace_msg text.\n", 1);
@@ -226,11 +227,11 @@
my @drivers = DBI->available_drivers();
cmp_ok(scalar(@drivers), '>', 0, '... we at least have one driver installed');
-# NOTE:
+# NOTE:
# we lowercase the interpolated @drivers array
# so that our reg-exp will match on VMS & Win32
-like(lc("@drivers"), qr/examplep/, '... we should at least have ExampleP
installed');
+like(lc("@drivers"), qr/examplep/, '... we should at least have ExampleP
installed');
# call available_drivers in scalar context
@@ -290,7 +291,7 @@
SKIP: {
skip 'developer tests', 4 unless -d ".svn";
-
+
print "Test DBI->installed_versions (for @drivers)\n";
print "(If one of those drivers, or the configuration for it, is bad\n";
print "then these tests can kill or freeze the process here. That's not
the DBI's fault.)\n";
@@ -299,10 +300,10 @@
." (almost certainly NOT a DBI problem)";
};
alarm(20);
-
+
##
----------------------------------------------------------------------------
## test installed_versions
-
+
# scalar context
my $installed_versions = DBI->installed_versions;
