X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=34c3eac3f25f96cd9468dc4b4edb214bd07acfc6;hb=b6cd6478;hp=9f7ed6834eefa971c8af5b1ae79309aae7d8e18a;hpb=eec182b6efc0f565751f2c81ce25ee419ebb133e;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index 9f7ed68..34c3eac 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -63,9 +63,22 @@ sub new {
   bless $new, $self;
 
   $new->set_schema($schema);
-  $new->debugobj(new DBIx::Class::Storage::Statistics());
-
-  #my $fh;
+  my $debugobj;
+  if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
+    require DBIx::Class::Storage::Debug::PrettyPrint;
+    if ($profile =~ /^\.?\//) {
+      require Config::Any;
+      my $cfg = Config::Any->load_files({ files => [$profile], use_ext => 1 });
+
+      my ($filename, $config) = %{$cfg->[0]};
+      $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new($config)
+    } else {
+      $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile })
+    }
+  } else {
+    $debugobj = DBIx::Class::Storage::Statistics->new
+  }
+  $new->debugobj($debugobj);
 
   my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
                   || $ENV{DBIC_TRACE};
@@ -487,6 +500,16 @@ created (when you call connect on your schema).  So, run-time changes
 to this environment variable will not take effect unless you also
 re-connect on your schema.
 
+=head2 DBIC_TRACE_PROFILE
+
+If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint>
+will be used to format the output from C<DBIC_TRACE>.  The value it
+is set to is the C<profile> that it will be used.  If the value is a
+filename the file is read with L<Config::Any> and the results are
+used as the configuration for tracing.  See L<SQL::Abstract::Tree/new>
+for what that structure should look like.
+
+
 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
 
 Old name for DBIC_TRACE