Add logging
[dbsrgits/DBIx-Class-DeploymentHandler.git] / lib / DBIx / Class / DeploymentHandler / DeployMethod / SQL / Translator.pm
index c45dafd..6f183fc 100644 (file)
@@ -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;
@@ -69,6 +74,9 @@ has schema_version => (
   lazy_build => 1,
 );
 
+# this will probably never get called as the DBICDH
+# will be passing down a schema_version normally, which
+# is built the same way
 method _build_schema_version { $self->schema->schema_version }
 
 method __ddl_consume_with_prefix($type, $versions, $prefix) {
@@ -155,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);
@@ -171,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: $@";
@@ -197,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,
@@ -208,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(
@@ -294,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);
 
@@ -309,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({
@@ -317,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'
   );
@@ -330,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'
   );
@@ -450,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,
@@ -462,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,
@@ -622,7 +649,9 @@ transaction.
 The version the schema on your harddrive is at.  Defaults to
 C<< $self->schema->schema_version >>.
 
-=method __ddl_consume_with_prefix
+=begin comment
+
+=head2 __ddl_consume_with_prefix
 
  $dm->__ddl_consume_with_prefix( 'SQLite', [qw( 1.00 1.01 )], 'up' )
 
@@ -630,48 +659,48 @@ This is the meat of the multi-file upgrade/deploy stuff.  It returns a list of
 files in the order that they should be run for a generic "type" of upgrade.
 You should not be calling this in user code.
 
-=method _ddl_schema_consume_filenames
+=head2 _ddl_schema_consume_filenames
 
  $dm->__ddl_schema_consume_filenames( 'SQLite', [qw( 1.00 )] )
 
 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 initial deploy.
 
-=method _ddl_schema_produce_filename
+=head2 _ddl_schema_produce_filename
 
  $dm->__ddl_schema_produce_filename( 'SQLite', [qw( 1.00 )] )
 
 Returns a single file in which an initial schema will be stored.
 
-=method _ddl_schema_up_consume_filenames
+=head2 _ddl_schema_up_consume_filenames
 
  $dm->_ddl_schema_up_consume_filenames( 'SQLite', [qw( 1.00 )] )
 
 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for an
 upgrade.
 
-=method _ddl_schema_down_consume_filenames
+=head2 _ddl_schema_down_consume_filenames
 
  $dm->_ddl_schema_down_consume_filenames( 'SQLite', [qw( 1.00 )] )
 
 Just a curried L</__ddl_consume_with_prefix>.  Get's a list of files for a
 downgrade.
 
-=method _ddl_schema_up_produce_filenames
+=head2 _ddl_schema_up_produce_filenames
 
  $dm->_ddl_schema_up_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 
 Returns a single file in which the sql to upgrade from one schema to another
 will be stored.
 
-=method _ddl_schema_down_produce_filename
+=head2 _ddl_schema_down_produce_filename
 
  $dm->_ddl_schema_down_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
 
 Returns a single file in which the sql to downgrade from one schema to another
 will be stored.
 
-=method _resultsource_install_filename
+=head2 _resultsource_install_filename
 
  my $filename_fn = $dm->_resultsource_install_filename('User');
  $dm->$filename_fn('SQLite', '1.00')
@@ -679,7 +708,7 @@ will be stored.
 Returns a function which in turn returns a single filename used to install a
 single resultsource.  Weird interface is convenient for me.  Deal with it.
 
-=method _run_sql_and_perl
+=head2 _run_sql_and_perl
 
  $dm->_run_sql_and_perl([qw( list of filenames )])
 
@@ -689,7 +718,7 @@ C<.sql> it runs it as sql and if it ends in C<.pl> it runs it as a perl file.
 Depending on L</txn_wrap> all of the files run will be wrapped in a single
 transaction.
 
-=method _prepare_install
+=head2 _prepare_install
 
  $dm->_prepare_install({ add_drop_table => 0 }, sub { 'file_to_create' })
 
@@ -697,7 +726,7 @@ Generates the sql file for installing the database.  First arg is simply
 L<SQL::Translator> args and the second is a coderef that returns the filename
 to store the sql in.
 
-=method _prepare_changegrade
+=head2 _prepare_changegrade
 
  $dm->_prepare_changegrade('1.00', '1.01', [qw( 1.00 1.01)], 'up')
 
@@ -706,10 +735,11 @@ arg is the version to start from, second is the version to go to, third is the
 L<version set|DBIx::Class::DeploymentHandler/VERSION SET>, and last is the
 direction of the changegrade, be it 'up' or 'down'.
 
-=method _read_sql_file
+=head2 _read_sql_file
 
  $dm->_read_sql_file('foo.sql')
 
 Reads a sql file and returns lines in an C<ArrayRef>.  Strips out comments,
 transactions, and blank lines.
 
+=end comment