Author: jkeenan
Date: Wed Sep 19 18:29:09 2007
New Revision: 21413
Modified:
branches/reconfigure/lib/Parrot/Configure.pm
Log:
1. To prepare for work on --abort-step option and more informative message at
conclusion of configuration, do some refactoring within
Parrot::Configure::_run_this_step to make program flow (returns) more explicit
(if less idiomatic and elegant) and refactor some code to internal
subroutines.
2. Eliminate the 'for' loop inside Parrot::Configure::run_single_step(). The
list of items over which we were looping consists of a single element.
Modified: branches/reconfigure/lib/Parrot/Configure.pm
==============================================================================
--- branches/reconfigure/lib/Parrot/Configure.pm (original)
+++ branches/reconfigure/lib/Parrot/Configure.pm Wed Sep 19 18:29:09 2007
@@ -226,16 +226,18 @@
my ( $verbose, $verbose_step, $ask ) =
$conf->options->get( qw( verbose verbose-step ask ) );
- for my $task ( $conf->steps() ) {
- if ( $task->{"Parrot::Configure::Task::step"} eq $taskname ) {
- $conf->_run_this_step( {
- task => $task,
- verbose => $verbose,
- verbose_step => $verbose_step,
- ask => $ask,
- n => 1,
- } );
- }
+ my $task = ( $conf->steps() )[0];
+ if ( $task->{"Parrot::Configure::Task::step"} eq $taskname ) {
+ $conf->_run_this_step( {
+ task => $task,
+ verbose => $verbose,
+ verbose_step => $verbose_step,
+ ask => $ask,
+ n => 1,
+ } );
+ }
+ else {
+ die "Mangled task in run_single_step";
}
}
@@ -293,7 +295,9 @@
print "\n", $description, '...';
print "\n" if $args->{verbose} && $args->{verbose} == 2;
- my $ret; # step return value
+ my $ret;
+ # When successful, a Parrot configuration step returns itself,
+ # i.e., returns its own object.
eval {
if (@step_params)
{
@@ -306,41 +310,81 @@
if ($@) {
carp "\nstep $step_name died during execution: [EMAIL PROTECTED]";
return;
+ } else {
+ # A Parrot configuration step can run successfully, but if it fails to
+ # achieve its objective it is supposed to return an undefined status.
+ if ( ! defined($ret) ) {
+ _failure_message($step, $step_name);
+ return;
+ } else {
+ # The Parrot configuration step returned a defined value -- but is
+ # that value an object with a 'result' method?
+ # (This is rather bizarre, IMHO.)
+ eval { $ret->can('result'); };
+
+ # if not, report the result and return
+ if ($@) {
+ _failure_message($step, $step_name);
+ return;
+ } else {
+ _finish_printing_result( {
+ step => $step,
+ args => $args,
+ description => $description,
+ } );
+ # reset verbose value for the next step
+ $conf->options->set( verbose => $args->{verbose} );
+
+ if ($conf->options->get(q{configure_trace}) ) {
+ _update_conftrace( {
+ conftrace => $conftrace,
+ step_name => $step_name,
+ conf => $conf,
+ sto => $sto,
+ } );
+ }
+ return 1;
+ }
+ }
}
+}
- # did the step return itself?
- eval { $ret->can('result'); };
+sub _failure_message {
+ my ($step, $step_name) = @_;
+ my $result = $step->result || 'no result returned';
+ carp "\nstep $step_name failed: " . $result;
+}
- # if not, report the result and return
- if ($@) {
- my $result = $step->result || 'no result returned';
- carp "\nstep $step_name failed: " . $result;
- return;
- }
- my $result = $step->result || 'done';
+sub _finish_printing_result {
+ my $argsref = shift;
+ my $result = $argsref->{step}->result || 'done';
+ if ($argsref->{args}->{verbose} && $argsref->{args}->{verbose} == 2) {
+ print "...";
+ }
+ print "." x ( 71 - length($argsref->{description}) - length($result) );
+ unless ($argsref->{step} =~ m{^inter/} && $argsref->{args}->{ask}) {
+ print "$result.";
+ }
+ return 1;
+}
- print "..." if $args->{verbose} && $args->{verbose} == 2;
- print "." x ( 71 - length($description) - length($result) );
- print "$result." unless $step =~ m{^inter/} && $args->{ask};
- # reset verbose value for the next step
- $conf->options->set( verbose => $args->{verbose} );
-
- if ($conf->options->get(q{configure_trace}) ) {
- if (! defined $conftrace->[0]) {
- $conftrace->[0] = [];
- }
- push @{$conftrace->[0]}, $step_name;
- my $evolved_data = {
- options => $conf->{options},
- data => $conf->{data},
- };
- push @{$conftrace}, $evolved_data;
- {
- local $Storable::Deparse = 1;
- nstore($conftrace, $sto);
- }
+sub _update_conftrace {
+ my $argsref = shift;
+ if (! defined $argsref->{conftrace}->[0]) {
+ $argsref->{conftrace}->[0] = [];
+ }
+ push @{$argsref->{conftrace}->[0]}, $argsref->{step_name};
+ my $evolved_data = {
+ options => $argsref->{conf}->{options},
+ data => $argsref->{conf}->{data},
+ };
+ push @{$argsref->{conftrace}}, $evolved_data;
+ {
+ local $Storable::Deparse = 1;
+ nstore($argsref->{conftrace}, $argsref->{sto});
}
+ return 1;
}
=item * C<option_or_data($arg)>
