silverdirk's initial progress callback

diff --git a/Changes b/Changes
index 2e3ff02..e813c95 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for {{$dist->name}}
 
 {{$NEXT}}
+       - Add basic tool for showing progress
        - Stop warning all the time (ribasushi)
        - croak on a couple errors that should be fatal
        - Stop deleting the wrong version (for downgrades)

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index 1fbf933..f65cf70 100644 (file)
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -49,6 +49,11 @@ has storage => (
   lazy_build => 1,
 );
 
+has progress_callback => (
+  is => 'rw',
+  isa => 'Maybe[CodeRef]',
+);
+
 method _build_storage {
   my $s = $self->schema->storage;
   $s->_determine_driver;
@@ -280,14 +285,19 @@ method _run_sql_and_perl($filenames, $sql_to_run, $versions) {
   $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
 
   my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
+  my $i= -1;
   FILENAME:
   for my $filename (@files) {
+    $i++;
     if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
+      $self->progress_callback and $self->progress_callback->($i, scalar(@files), 'skip', $filename);
       next FILENAME
     } elsif ($filename =~ /\.sql$/) {
-       $sql .= $self->_run_sql($filename)
+      $self->progress_callback and $self->progress_callback->($i, scalar(@files), 'sql', $filename);
+      $sql .= $self->_run_sql($filename)
     } elsif ( $filename =~ /\.pl$/ ) {
-       $self->_run_perl($filename, $versions)
+      $self->progress_callback and $self->progress_callback->($i, scalar(@files), 'perl', $filename);
+      $self->_run_perl($filename, $versions)
     } else {
       croak "A file ($filename) got to deploy that wasn't sql or perl!";
     }