Author: timbo
Date: Fri Jun 15 04:40:30 2007
New Revision: 9655
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/Profile.pm
dbi/trunk/lib/DBI/ProfileDumper.pm
dbi/trunk/t/19fhtrace.t
Log:
Don't warn if $h->{Profile} is undef.
Move empty() method from ProfileDumper to Profile base class.
Add filename and flush_to_disk methods to Profile base class.
Added more docs for private_attribute_info() method.
Avoid undef warning with old perls in t/19fhtrace.t
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Fri Jun 15 04:40:30 2007
@@ -54,6 +54,7 @@
Added extra trace info to connect_cached thanks to Walery Studennikov.
Added non-random (deterministic) mode to DBI_GOFER_RANDOM mechanism.
Added DBIXS_REVISION macro that drivers can use.
+ Added more docs for private_attribute_info() method.
DBI::Profile changes:
dbi_profile() now returns ref to relevant leaf node.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Fri Jun 15 04:40:30 2007
@@ -3234,8 +3234,27 @@
$hash_ref = $h->private_attribute_info();
Returns a reference to a hash whose keys are the names of driver-private
-attributes available for that kind of handle (driver, database, statement).
-(The values should be undef. Meanings may be assigned to particular values in
future.)
+attributes available for the kind of handle (driver, database, statement)
+that the method was called on.
+
+For example, the return value when called with a DBD::Sybase $dbh could look
like this:
+
+ {
+ syb_dynamic_supported => undef,
+ syb_oc_version => undef,
+ syb_server_version => undef,
+ syb_server_version_string => undef,
+ }
+
+and when called with a DBD::Sybase $sth they could look like this:
+
+ {
+ syb_types => undef,
+ syb_proc_status => undef,
+ syb_result_type => undef,
+ }
+
+The values should be undef. Meanings may be assigned to particular values in
future.
=head3 C<swap_inner_handle>
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Fri Jun 15 04:40:30 2007
@@ -2344,7 +2344,7 @@
mg_get(profile); /* FETCH */
if (!profile || !SvROK(profile)) {
DBIc_set(imp_xxh, DBIcf_Profile, 0); /* disable */
- if (!dirty)
+ if (SvOK(profile) && !dirty)
warn("Profile attribute isn't a hash ref (%s,%ld)",
neatsvpv(profile,0), (long)SvTYPE(profile));
return &sv_undef;
}
@@ -4396,7 +4396,7 @@
dbih_getcom2(aTHX_ h, &mg); /* get the MAGIC so we can change it
*/
imp_xxh_sv = mg->mg_obj; /* take local copy of the imp_data pointer */
mg->mg_obj = Nullsv; /* sever the link from handle to imp_xxh */
- if (DBIc_TRACE_LEVEL(imp_xxh))
+ if (DBIc_TRACE_LEVEL(imp_xxh) >= 9)
sv_dump(imp_xxh_sv);
/* --- housekeeping */
DBIc_ACTIVE_off(imp_xxh); /* silence warning from dbih_clearcom */
Modified: dbi/trunk/lib/DBI/Profile.pm
==============================================================================
--- dbi/trunk/lib/DBI/Profile.pm (original)
+++ dbi/trunk/lib/DBI/Profile.pm Fri Jun 15 04:40:30 2007
@@ -757,6 +757,21 @@
}
+sub empty { # empty out profile data
+ my $self = shift;
+ DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
+ $self->{Data} = undef;
+}
+
+sub filename { # baseclass method, see DBI::ProfileDumper
+ return undef;
+}
+
+sub flush_to_disk { # baseclass method, see DBI::ProfileDumper
+ return undef;
+}
+
+
sub as_node_path_list {
my ($self, $node, $path) = @_;
# convert the tree into an array of arrays
Modified: dbi/trunk/lib/DBI/ProfileDumper.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProfileDumper.pm (original)
+++ dbi/trunk/lib/DBI/ProfileDumper.pm Fri Jun 15 04:40:30 2007
@@ -256,14 +256,6 @@
}
-# empty out profile data
-sub empty {
- my $self = shift;
- DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
- $self->{Data} = undef;
-}
-
-
# write header to a filehandle
sub write_header {
my ($self, $fh) = @_;
Modified: dbi/trunk/t/19fhtrace.t
==============================================================================
--- dbi/trunk/t/19fhtrace.t (original)
+++ dbi/trunk/t/19fhtrace.t Fri Jun 15 04:40:30 2007
@@ -106,10 +106,12 @@
package MyFancyLogger;
+use Symbol qw(gensym);
+
sub new
{
my $self = {};
- my $fh;
+ my $fh = gensym();
open $fh, '>', 'fancylog.log';
$self->{_fh} = $fh;
$self->{_buf} = '';
