Author: timbo
Date: Sun Feb 15 15:08:20 2004
New Revision: 62
Modified:
dbi/trunk/DBI.xs
dbi/trunk/Driver_xst.h
dbi/trunk/Perl.xs
dbi/trunk/dbd_xsh.h
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/06attrs.t
Log:
Assorted polish
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sun Feb 15 15:08:20 2004
@@ -415,6 +415,7 @@
static int
set_err_sv(SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method)
{
+ dPERINTERP;
SV *h_err;
SV *h_errstr;
SV *h_state;
@@ -433,7 +434,7 @@
if (SvREADONLY(state)) state = sv_mortalcopy(state);
if (SvREADONLY(method)) method = sv_mortalcopy(method);
if (DBIS->debug >= 2)
- PerlIO_printf(DBILOGFP," -> HandleSetErr(%s, err=%s, errstr=%s,
state=%s, %s)\n",
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -> HandleSetErr(%s, err=%s,
errstr=%s, state=%s, %s)\n",
neatsvpv(h,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0),
neatsvpv(method,0)
);
@@ -449,7 +450,7 @@
response_sv = (items) ? POPs : &sv_undef;
PUTBACK;
if (DBIS->debug >= 1)
- PerlIO_printf(DBILOGFP," <- HandleSetErr= %s (err=%s, errstr=%s,
state=%s, %s)\n",
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," <- HandleSetErr= %s (err=%s,
errstr=%s, state=%s, %s)\n",
neatsvpv(response_sv,0), neatsvpv(err,0), neatsvpv(errstr,0),
neatsvpv(state,0),
neatsvpv(method,0)
);
@@ -613,11 +614,11 @@
set_trace_file(file);
if (level != RETVAL) { /* set value */
if (level > 0) {
- PerlIO_printf(DBILOGFP," %s trace level set to %d in DBI %s%s (pid
%d)\n",
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," %s trace level set to %d in DBI
%s%s (pid %d)\n",
neatsvpv(h,0), level, XS_VERSION, dbi_build_opt,
(int)PerlProc_getpid());
if (!dowarn && level>0)
- PerlIO_printf(DBILOGFP," Note: perl is running without the
recommended perl -w option\n");
- PerlIO_flush(DBILOGFP);
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh)," Note: perl is running without
the recommended perl -w option\n");
+ PerlIO_flush(DBIc_LOGPIO(imp_xxh));
}
sv_setiv(dsv, level);
}
@@ -736,7 +737,7 @@
static SV *
-dbih_setup_attrib(SV *h, char *attrib, SV *parent, int read_only, int optional)
+dbih_setup_attrib(SV *h, imp_xxh_t *imp_xxh, char *attrib, SV *parent, int read_only,
int optional)
{
dPERINTERP;
STRLEN len = strlen(attrib);
@@ -764,14 +765,15 @@
}
}
if (DBIS->debug >= 5) {
- PerlIO_printf(DBILOGFP," dbih_setup_attrib(%s, %s, %s)",
+ PerlIO *logfp = DBIc_LOGPIO(imp_xxh);
+ PerlIO_printf(logfp," dbih_setup_attrib(%s, %s, %s)",
neatsvpv(h,0), attrib, neatsvpv(parent,0));
if (!asvp)
- PerlIO_printf(DBILOGFP," undef (not defined)\n");
+ PerlIO_printf(logfp," undef (not defined)\n");
else
if (SvOK(*asvp))
- PerlIO_printf(DBILOGFP," %s (already defined)\n", neatsvpv(*asvp,0));
- else PerlIO_printf(DBILOGFP," %s (copied from parent)\n", neatsvpv(*asvp,0));
+ PerlIO_printf(logfp," %s (already defined)\n", neatsvpv(*asvp,0));
+ else PerlIO_printf(logfp," %s (copied from parent)\n", neatsvpv(*asvp,0));
}
if (read_only && asvp)
SvREADONLY_on(*asvp);
@@ -947,7 +949,7 @@
/* Copy some attributes from parent if not defined locally and */
/* also take address of attributes for speed of direct access. */
/* parent is null for drh, in which case h must hold the values */
-#define COPY_PARENT(name,ro,opt)
SvREFCNT_inc(dbih_setup_attrib(h,(name),parent,ro,opt))
+#define COPY_PARENT(name,ro,opt)
SvREFCNT_inc(dbih_setup_attrib(h,imp,(name),parent,ro,opt))
#define DBIc_ATTR(imp, f) _imp2com(imp, attr.f)
/* XXX we should validate that these are the right type (refs etc) */
DBIc_ATTR(imp, Err) = COPY_PARENT("Err",1,0); /* scalar ref */
@@ -956,10 +958,10 @@
DBIc_ATTR(imp, TraceLevel)=COPY_PARENT("TraceLevel",0,0);/* scalar (int)*/
DBIc_ATTR(imp, FetchHashKeyName) = COPY_PARENT("FetchHashKeyName",0,0); /*
scalar ref */
if (parent) {
- dbih_setup_attrib(h,"HandleSetErr",parent,0,1);
- dbih_setup_attrib(h,"HandleError",parent,0,1);
+ dbih_setup_attrib(h,imp,"HandleSetErr",parent,0,1);
+ dbih_setup_attrib(h,imp,"HandleError",parent,0,1);
if (DBIc_has(parent_imp,DBIcf_Profile)) {
- dbih_setup_attrib(h,"Profile",parent,0,1);
+ dbih_setup_attrib(h,imp,"Profile",parent,0,1);
}
DBIc_LongReadLen(imp) = DBIc_LongReadLen(parent_imp);
}
@@ -1010,10 +1012,10 @@
char *pad = " ";
if (!msg)
msg = "dbih_dumpcom";
- PerlIO_printf(DBILOGFP," %s (%sh 0x%lx 0x%lx, com 0x%lx, imp %s):\n",
+ PerlIO_printf(DBILOGFP," %s (%sh 0x%lx, com 0x%lx, imp %s):\n",
msg, dbih_htype_name(DBIc_TYPE(imp_xxh)),
- (long)DBIc_MY_H(imp_xxh), (long)SvRVx(DBIc_MY_H(imp_xxh)),
- (long)imp_xxh, HvNAME(DBIc_IMP_STASH(imp_xxh)));
+ (long)DBIc_MY_H(imp_xxh), (long)imp_xxh,
+ (dirty) ? "global destruction" : HvNAME(DBIc_IMP_STASH(imp_xxh)));
if (DBIc_COMSET(imp_xxh)) sv_catpv(flags,"COMSET ");
if (DBIc_IMPSET(imp_xxh)) sv_catpv(flags,"IMPSET ");
if (DBIc_ACTIVE(imp_xxh)) sv_catpv(flags,"Active ");
Modified: dbi/trunk/Driver_xst.h
==============================================================================
--- dbi/trunk/Driver_xst.h (original)
+++ dbi/trunk/Driver_xst.h Sun Feb 15 15:08:20 2004
@@ -16,8 +16,10 @@
int i;
SV *sv;
int debug = 0;
+ D_imp_xxh(ST(0));
if (debug >= 3) {
- PerlIO_printf(DBILOGFP, " -> %s (trampoline call with %d (%ld) params)\n",
methname, params, (long)items);
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh),
+ " -> %s (trampoline call with %d (%ld) params)\n", methname, params,
(long)items);
xxx = xxx; /* avoid unused var warning */
}
EXTEND(SP, params);
@@ -32,7 +34,8 @@
sv = (i) ? POPs : &sv_undef;
PUTBACK;
if (debug >= 3)
- PerlIO_printf(DBILOGFP, " <- %s= %s (trampoline call return)\n", methname,
neatsvpv(sv,0));
+ PerlIO_printf(DBIc_LOGPIO(imp_xxh),
+ " <- %s= %s (trampoline call return)\n", methname, neatsvpv(sv,0));
return sv;
}
Modified: dbi/trunk/Perl.xs
==============================================================================
--- dbi/trunk/Perl.xs (original)
+++ dbi/trunk/Perl.xs Sun Feb 15 15:08:20 2004
@@ -38,8 +38,6 @@
return 1;
}
-DBISTATE_DECLARE;
-
MODULE = DBD::Perl PACKAGE = DBD::Perl
INCLUDE: Perl.xsi
Modified: dbi/trunk/dbd_xsh.h
==============================================================================
--- dbi/trunk/dbd_xsh.h (original)
+++ dbi/trunk/dbd_xsh.h Sun Feb 15 15:08:20 2004
@@ -14,6 +14,7 @@
void dbd_init _((dbistate_t *dbistate));
int dbd_discon_all _((SV *drh, imp_drh_t *imp_drh));
+SV *dbd_take_imp_data _((SV *h, imp_xxh_t *imp_xxh, void *foo));
/* Support for dbd_dr_data_sources and dbd_db_do added to Driver.xst in DBI v1.33 */
/* dbd_dr_data_sources: optional: defined by a driver that calls a C */
@@ -33,6 +34,7 @@
int dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv));
SV *dbd_db_FETCH_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv));
SV *dbd_db_last_insert_id _((SV *dbh, SV *imp_dbh, SV *catalog, SV *schema, SV
*table, SV *field, SV *attr));
+AV *dbd_db_data_sources _((SV *dbh, imp_dbh_t *imp_dbh, SV *attr));
int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, char *statement, SV
*attribs));
int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth));
@@ -45,6 +47,7 @@
int field, long offset, long len, SV *destrv, long destoffset));
int dbd_st_STORE_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv));
SV *dbd_st_FETCH_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv));
+SV *dbd_st_execute_for_fetch _((SV *sth, imp_sth_t *imp_sth, SV
*fetch_tuple_sub, SV *tuple_status));
int dbd_bind_ph _((SV *sth, imp_sth_t *imp_sth,
SV *param, SV *value, IV sql_type, SV *attribs,
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Sun Feb 15 15:08:20 2004
@@ -163,7 +163,7 @@
my $initial_setup;
sub initial_setup {
$initial_setup = 1;
- warn __FILE__ . " version " . $DBI::PurePerl::VERSION . "\n" if $DBI::dbi_debug;
+ print $DBI::tfh __FILE__ . " version " . $DBI::PurePerl::VERSION . "\n" if
$DBI::dbi_debug;
untie $DBI::err;
untie $DBI::errstr;
untie $DBI::state;
@@ -381,7 +381,10 @@
sub _setup_handle {
my($h, $imp_class, $parent, $imp_data) = @_;
my $h_inner = tied(%$h) || $h;
- warn("\n_setup_handle(@_)") if $DBI::dbi_debug >= 4;
+ if ($DBI::dbi_debug >= 4) {
+ local $^W;
+ print $DBI::tfh "_setup_handle(@_)";
+ }
$h_inner->{"imp_data"} = $imp_data;
$h_inner->{"ImplementorClass"} = $imp_class;
$h_inner->{"Kids"} = $h_inner->{"ActiveKids"} = 0; # XXX not maintained
Modified: dbi/trunk/t/06attrs.t
==============================================================================
--- dbi/trunk/t/06attrs.t (original)
+++ dbi/trunk/t/06attrs.t Sun Feb 15 15:08:20 2004
@@ -188,7 +188,6 @@
is( $scale->[0], 0 );
is( $scale->[1], 0 );
-
ok( my $params = $sth->{ParamValues} );
is( $params->{1}, 'foo' );
is( $sth->{Statement}, "select ctime, name from foo" );
