diff --git a/lib/WebGUI/Upgrade/File/pl.pm b/lib/WebGUI/Upgrade/File/pl.pm index afb704cd7..f50f6e64d 100644 --- a/lib/WebGUI/Upgrade/File/pl.pm +++ b/lib/WebGUI/Upgrade/File/pl.pm @@ -19,6 +19,8 @@ WebGUI::Upgrade::File::pl - Upgrade class for Perl scripts package WebGUI::Upgrade::File::pl; use Moose; use Class::MOP::Class; +use File::Spec::Functions qw(devnull); +use Scope::Guard; use namespace::autoclean -also => qr/^_/; with 'WebGUI::Upgrade::File'; @@ -29,7 +31,15 @@ sub run { local $ENV{WEBGUI_CONFIG} = $configFile; local $ENV{WEBGUI_UPGRADE_VERSION} = $self->version; - local $ENV{WEBGUI_UPGRADE_QUIET} = $self->quiet; + my $io_guard; + if ($self->quiet) { + open my $stdout_old, '>&=', \*STDOUT; + open \*STDOUT, '>', devnull; + $io_guard = Scope::Guard->new(sub { + close STDOUT; + open STDOUT, '>&=', $stdout_old; + }); + } return _runScript($self->file); } diff --git a/lib/WebGUI/Upgrade/Script.pm b/lib/WebGUI/Upgrade/Script.pm index cae2a485d..f54398f02 100644 --- a/lib/WebGUI/Upgrade/Script.pm +++ b/lib/WebGUI/Upgrade/Script.pm @@ -43,7 +43,6 @@ sub _build_exports { or die 'WEBGUI_CONFIG environment variable must be specified'; my $version = $ENV{WEBGUI_UPGRADE_VERSION} or die 'WEBGUI_UPGRADE_VERSION must be set'; - my $quiet = $ENV{WEBGUI_UPGRADE_QUIET}; my $upgrade_file = $caller_upgrade_file; (my $vol, my $dir, my $shortname) = File::Spec->splitpath( $upgrade_file ); $shortname =~ s/\.[^.]*$//; @@ -122,6 +121,9 @@ sub _build_exports { push @cleanups, $cleanup; weaken $cleanups[-1]; + my $indent = 0; + my $just_started; + my $subs = { # this closes over the guard, keeping it alive until the sub is either # run or deleted. WebGUI::Upgrade::File::pl will end up deleting @@ -134,16 +136,25 @@ sub _build_exports { version_tag => $version_tag_sub, dbh => $dbh_sub, collateral => $collateral_sub, - quiet => sub () { - return $quiet; + start_step => sub (@) { + print "\n" + if $just_started; + print "\t" x $indent, @_, '... '; + $just_started = 1; + $indent++; }, report => sub (@) { - print @_ - unless $quiet; + print "\n" + if $just_started; + print "\t" x $indent, @_, "\n"; + $just_started = 0; }, done => sub () { - print "Done.\n" - unless $quiet; + $indent--; + print "\t" x $indent + unless $just_started; + print "Done.\n"; + $just_started = 0; }, sql => sub (@) { my $sql = shift; @@ -273,7 +284,7 @@ They cannot be called directly. =head2 report ( $message ) -Outputs $message unless quiet mode has been enabled. +Outputs $message. =head2 done diff --git a/var/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl b/var/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl index d611cbf9c..5d681a5eb 100644 --- a/var/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl +++ b/var/upgrades/7.9.8-8.0.0/addMaintenancePageToConfig.pl @@ -5,7 +5,7 @@ use Cwd qw(realpath); use File::Spec::Functions; use WebGUI::Paths; -report "\tMoving preload files ... "; +start_step "Moving preload files"; my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) ); diff --git a/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl b/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl index a47634e92..5241484e0 100644 --- a/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl +++ b/var/upgrades/7.9.8-8.0.0/migrateToNewCache.pl @@ -1,7 +1,7 @@ use WebGUI::Upgrade::Script; use Module::Find; -report "\tMigrating to new cache ... "; +start_step "Migrating to new cache"; rm_lib findallmod('WebGUI::Cache'), diff --git a/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl b/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl index b39ead701..f468869c7 100644 --- a/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl +++ b/var/upgrades/7.9.8-8.0.0/moveFileLocations.pl @@ -5,7 +5,7 @@ use Cwd qw(realpath); use File::Spec::Functions; use WebGUI::Paths; -report "\tMoving preload files ... "; +start_step "Moving preload files"; my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) ); diff --git a/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl b/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl index d16cbc5d9..0c9fdc26a 100644 --- a/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl +++ b/var/upgrades/7.9.8-8.0.0/moveMaintenance.pl @@ -6,7 +6,7 @@ use Cwd qw(realpath); my $webgui_root = realpath( catdir( dirname( $INC{'WebGUI/Upgrade/Script.pm'} ), (updir) x 3 ) ); -report "\tMoving maintenance file ... "; +start_step "Moving maintenance file"; unlink catfile($webgui_root, 'docs', 'maintenance.html');