From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Wed, 19 May 2010 00:41:38 +0000 (-0500)
Subject: Add logging
X-Git-Tag: v0.001000_11~7^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=commitdiff_plain;h=0df68524a051e42f1a7f8606aee56e7c6b70b302

Add logging
---

diff --git a/Changes b/Changes
index cd094cb..faa9be8 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for {{$dist->name}}
 
 {{$NEXT}}
+       - Add logging with Log::Contextual
 
 0.001000_10 2010-05-18 00:07:31 CST6CDT
        - upgrade_directory is wrong and vague, instead we use script_directory
diff --git a/dist.ini b/dist.ini
index 7292efd..785118d 100644
--- a/dist.ini
+++ b/dist.ini
@@ -21,6 +21,7 @@ remove = MetaYAML
 [Prereq]
 autodie                     = 0
 namespace::autoclean        = 0
+Log::Contextual             = 0.00201
 File::Path                  = 2.08
 File::Touch                 = 0.08
 DBIx::Class                 = 0.08121
diff --git a/lib/DBIx/Class/DeploymentHandler/Dad.pm b/lib/DBIx/Class/DeploymentHandler/Dad.pm
index d816acd..c5523f8 100644
--- a/lib/DBIx/Class/DeploymentHandler/Dad.pm
+++ b/lib/DBIx/Class/DeploymentHandler/Dad.pm
@@ -6,6 +6,10 @@ use Moose;
 use Method::Signatures::Simple;
 require DBIx::Class::Schema;    # loaded for type constraint
 use Carp::Clan '^DBIx::Class::DeploymentHandler';
+use Log::Contextual::WarnLogger;
+use Log::Contextual ':log', -default_logger => Log::Contextual::WarnLogger->new({
+	env_prefix => 'DBICDH'
+});
 
 has schema => (
   isa      => 'DBIx::Class::Schema',
@@ -36,6 +40,7 @@ has schema_version => (
 sub _build_schema_version { $_[0]->schema->schema_version }
 
 method install {
+  log_info { '[DBICDH] installing version ' . $self->to_version };
   croak 'Install not possible as versions table already exists in database'
     if $self->version_storage_is_installed;
 
@@ -48,6 +53,7 @@ method install {
 }
 
 sub upgrade {
+  log_info { '[DBICDH] upgrading' };
   my $self = shift;
   while ( my $version_list = $self->next_version_set ) {
     my ($ddl, $upgrade_sql) = @{
@@ -63,6 +69,7 @@ sub upgrade {
 }
 
 sub downgrade {
+  log_info { '[DBICDH] upgrading' };
   my $self = shift;
   while ( my $version_list = $self->previous_version_set ) {
     $self->downgrade_single_step({ version_set => $version_list });
@@ -72,7 +79,10 @@ sub downgrade {
   }
 }
 
-method backup { $self->storage->backup($self->backup_directory) }
+method backup {
+  log_info { '[DBICDH] backing up' };
+  $self->storage->backup($self->backup_directory)
+}
 
 __PACKAGE__->meta->make_immutable;
 
diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index d3b787a..6f183fc 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -5,6 +5,11 @@ use Moose;
 
 use autodie;
 use Carp qw( carp croak );
+use Log::Contextual::WarnLogger;
+use Log::Contextual qw(:log :dlog), -default_logger => Log::Contextual::WarnLogger->new({
+   env_prefix => 'DBICDH'
+});
+use Data::Dumper::Concise;
 
 use Method::Signatures::Simple;
 use Try::Tiny;
@@ -158,8 +163,10 @@ method _run_sql_and_perl($filenames) {
   my $sql;
   for my $filename (@files) {
     if ($filename =~ /\.sql$/) {
+      log_debug { "[DBICDH] Running SQL from $filename" };
       my @sql = @{$self->_read_sql_file($filename)};
       $sql .= join "\n", @sql;
+      log_trace { "[DBICDH] Running SQL $sql" };
 
       foreach my $line (@sql) {
         $storage->_query_start($line);
@@ -174,11 +181,13 @@ method _run_sql_and_perl($filenames) {
         $storage->_query_end($line);
       }
     } elsif ( $filename =~ /^(.+)\.pl$/ ) {
+      log_debug { "[DBICDH] Running Perl from $filename" };
       my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 
       no warnings 'redefine';
       my $fn = eval "$filedata";
       use warnings;
+      log_trace { '[DBICDH] Running Perl ' . Dumper($fn) };
 
       if ($@) {
         carp "$filename failed to compile: $@";
@@ -200,6 +209,7 @@ method _run_sql_and_perl($filenames) {
 sub deploy {
   my $self = shift;
   my $version = (shift @_ || {})->{version} || $self->schema_version;
+  log_info { "[DBICDH] deploying version $version" };
 
   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
     $self->storage->sqlt_type,
@@ -211,6 +221,7 @@ sub preinstall {
   my $self         = shift;
   my $args         = shift;
   my $version      = $args->{version}      || $self->schema_version;
+  log_info { "[DBICDH] preinstalling version $version" };
   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 
   my @files = @{$self->_ddl_preinstall_consume_filenames(
@@ -297,6 +308,7 @@ sub install_resultsource {
   my ($self, $args) = @_;
   my $source          = $args->{result_source};
   my $version         = $args->{version};
+  log_info { '[DBICDH] installing_resultsource ' . $source->source_name . ", version $version" };
   my $rs_install_file =
     $self->_resultsource_install_filename($source->source_name);
 
@@ -312,6 +324,7 @@ sub install_resultsource {
 sub prepare_resultsource_install {
   my $self = shift;
   my $source = (shift @_)->{result_source};
+  log_info { '[DBICDH] preparing install for resultsource ' . $source->source_name };
 
   my $filename = $self->_resultsource_install_filename($source->source_name);
   $self->_prepare_install({
@@ -320,12 +333,17 @@ sub prepare_resultsource_install {
 }
 
 sub prepare_deploy {
+  log_info { '[DBICDH] preparing deploy' };
   my $self = shift;
   $self->_prepare_install({}, '_ddl_schema_produce_filename');
 }
 
 sub prepare_upgrade {
   my ($self, $args) = @_;
+  log_info {
+     '[DBICDH] preparing upgrade ' .
+     "from $args->{from_version} to $args->{to_version}"
+  };
   $self->_prepare_changegrade(
     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
   );
@@ -333,6 +351,10 @@ sub prepare_upgrade {
 
 sub prepare_downgrade {
   my ($self, $args) = @_;
+  log_info {
+     '[DBICDH] preparing downgrade ' .
+     "from $args->{from_version} to $args->{to_version}"
+  };
   $self->_prepare_changegrade(
     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
   );
@@ -453,6 +475,7 @@ method _read_sql_file($file) {
 sub downgrade_single_step {
   my $self = shift;
   my $version_set = (shift @_)->{version_set};
+  log_info { qq([DBICDH] downgrade_single_step'ing ) . Dumper($version_set) };
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
     $self->storage->sqlt_type,
@@ -465,6 +488,7 @@ sub downgrade_single_step {
 sub upgrade_single_step {
   my $self = shift;
   my $version_set = (shift @_)->{version_set};
+  log_info { qq([DBICDH] upgrade_single_step'ing ) . Dumper($version_set) };
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
     $self->storage->sqlt_type,
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
index 6bce014..31471a8 100644
--- a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Deprecated.pm
@@ -1,5 +1,10 @@
 package DBIx::Class::DeploymentHandler::VersionStorage::Deprecated;
 use Moose;
+use Log::Contextual::WarnLogger;
+use Log::Contextual ':log', -default_logger => Log::Contextual::WarnLogger->new({
+	env_prefix => 'DBICDH'
+});
+
 
 # ABSTRACT: (DEPRECATED) Use this if you are stuck in the past
 
@@ -31,11 +36,15 @@ sub _build_version_rs {
 
 sub add_database_version {
   # deprecated doesn't support ddl or upgrade_ddl
-  $_[0]->version_rs->create({ version => $_[1]->{version} })
+  my $version = $_[1]->{version};
+  log_debug { "[DBICDH] Adding database version $version" };
+  $_[0]->version_rs->create({ version => $version })
 }
 
 sub delete_database_version {
-  $_[0]->version_rs->search({ version => $_[1]->{version}})->delete
+  my $version = $_[1]->{version};
+  log_debug { "[DBICDH] Deleting database version $version" };
+  $_[0]->version_rs->search({ version => $version})->delete
 }
 
 __PACKAGE__->meta->make_immutable;
diff --git a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
index 908ba07..ca6a606 100644
--- a/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
+++ b/lib/DBIx/Class/DeploymentHandler/VersionStorage/Standard.pm
@@ -1,5 +1,9 @@
 package DBIx::Class::DeploymentHandler::VersionStorage::Standard;
 use Moose;
+use Log::Contextual::WarnLogger;
+use Log::Contextual ':log', -default_logger => Log::Contextual::WarnLogger->new({
+  env_prefix => 'DBICDH'
+});
 
 # ABSTRACT: Version storage that does the normal stuff
 
@@ -29,10 +33,16 @@ sub _build_version_rs {
   $_[0]->schema->resultset('__VERSION')
 }
 
-sub add_database_version { $_[0]->version_rs->create($_[1]) }
+sub add_database_version {
+  my $version = $_[1]->{version};
+  log_debug { "[DBICDH] Adding database version $version" };
+  $_[0]->version_rs->create($_[1])
+}
 
 sub delete_database_version {
-  $_[0]->version_rs->search({ version => $_[1]->{version}})->delete
+  my $version = $_[1]->{version};
+  log_debug { "[DBICDH] Deleting database version $version" };
+  $_[0]->version_rs->search({ version => $version})->delete
 }
 
 __PACKAGE__->meta->make_immutable;