# -*- perl -*-
#
# Test::AutoBuild::Module by Daniel Berrange <dan@berrange.com>
#
# Copyright (C) 2002-2004 Daniel Berrange <dan@berrange.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id: Module.pm,v 1.38 2006/06/05 12:38:08 danpb Exp $

=pod

=head1 NAME

Test::AutoBuild::Module - represents a code module to be built

=head1 SYNOPSIS

  use Test::AutoBuild::Module;

  my $module = Test::AutoBuild::Module->new(name => $name,
                                            label => $label,
                                            sources => $sources,
                                            [dependencies => \@modules,]
                                            [env => \%env,]
                                            [options => \%options,]
                                            [groups => \@groups,]
                                            [dir => $directory]);

  $module->build();
  $module->install();


=head1 DESCRIPTION

The Test::AutoBuild::Module module provides a representation of
a single code module to be built / tested. 

=head1 OPTIONS

The valid configuration options for the C<modules> block are

=head1 METHODS

=over 4

=cut

package Test::AutoBuild::Module;

use strict;
use warnings;
use Carp qw(confess);
use File::Spec::Functions;
use Class::MethodMaker
    new_with_init => "new",
    get_set => [qw(
                   artifacts
                   depends
		   changed
		   changes
                   dir
                   env
                   groups
                   label
                   links
                   name
                   packages
		   installed
                   sources
                   use_archive
                   admin_email
                   admin_name
                   group_email
                   group_name
                   )];

use Cwd;
use Log::Log4perl;

=item my $module = Test::AutoBuild::Module->new(name => $name,
                                                label => $label,
                                                sources => $sources,
                                                [depends => \@modules,]
                                                [links => \%links,]
                                                [artifacts => \%artifacts,]
                                                [env => \%env,]
                                                [options => \%options,]
                                                [groups => \@groups,]
                                                [dir => $directory]);

Creates a new code module object. C<name> is a alphanumeric
token for the name of the module. C<label> is a short human
friendly title for the module. C<depends> is an array
ref containing a list of dependant module names. C<env> is
a hash ref of environment variables to define when building
the module. C<groups> is the optional list of groups to
which the module belongs. C<dir> is the directory in which
the module was checked out, if different from C<name>. The
C<controlfile> parameter is the name of the build control
file to run if different from the global default.

=cut

sub init {
    my $self = shift;
    my %params = @_;

    $self->name(exists $params{name} ? $params{name} : confess "name parameter is required");
    $self->label(exists $params{label} ? $params{label} : confess "label parameter is required");
    $self->links(exists $params{links} ? $params{links} : []);
    $self->artifacts(exists $params{artifacts} ? $params{artifacts} : []);
    $self->packages({});
    $self->installed({});
    $self->depends(exists $params{depends} ? $params{depends} : []);
    $self->env(exists $params{env} ? $params{env} : {});
    $self->groups(exists $params{groups} ? $params{groups} : ["global"]);
    $self->dir(exists $params{dir} ? $params{dir} : $self->{name});

    $self->sources(exists $params{sources} ? $params{sources} : confess "sources parameter is required");

    $self->admin_email(exists $params{admin_email} ? $params{admin_email} : undef);
    $self->admin_name(exists $params{admin_name} ? $params{admin_name} : $self->label . " administrator");
    $self->group_email(exists $params{group_email} ? $params{group_email} : undef);
    $self->group_name(exists $params{group_name} ? $params{group_name} : $self->label . " developers");

    $self->use_archive(exists $params{'use-archive'} ? $params{'use-archive'} : 1);
    $self->{options} = exists $params{options} ? $params{options} : {};
    $self->{is_installed} = {};
    $self->{results} = {
	build => {
	    status => "pending",
	},
    };
}

=item my $label = $module->label([$newlabel]);

Returns the label of this module, a short
human friendly title. If the C<newlabel>
parameter is supplied the label is also updated.

=item my $name = $module->name([$newname]);

Returns the name of this module, a short
alphanumeric token. If the C<newname>
parameter is supplied the name is also updated.

=item my $sources = $module->sources($newsources)

Returns an array references, where each element is as
hash with two keys. The value associated with the key 
C<repository> is the name of the soruce repository. The
value associated with the key C<path> is the path within
the source repository to checkout. If the C<$newsources>
parameter is supplied, the list of sources is updated

=item my $path = $module->dir($newpath);

Returns the path for the directory checked
out of source control. Typically this is
the same as the module name. If the C<newpath>
parameter is supplied the dir is updated.

=item my \@modules = $module->depends([\@modules]);

Returns an array ref of dependant module names. If the
C<modules> parameter is supplied then the list of
dependants is updated.

=item my $value = $module->option($name[, $newvalue]);

Returns the value of the option referenced by C<name>.
If the C<newvalue> parameter is supplied, then the
option is also updated. Options are arbitrary key +
value pairs intended for stages to use for configuring
module specific options. For example the 
L<Test::AutoBuild::Stage::Build> module uses the
C<control-file> option key to allow override of the
shell script used to perform a build. To avoid clashes
between multiple different stages, try to use reasonably
description option key names, preferrably at least 2
words long.

=cut

sub option {
   my $self = shift;
   my $name = shift;

   $self->{options}->{$name} = shift if @_;
   
   # XXX fixme
   if (0) {
   if (! exists $self->{options}->{$name}) {
       my $groups = $self->runtime->groups;
       foreach (@{$self->groups()}) {
           my $value = $groups->{$_}->option($name);
           return $value if defined $value;
       }
   }
   }

   return $self->{options}->{$name};
}


=item my $bool = $module->is_installed($dir);

Returns a true value if this modules files are installed
into the directory C<$dir>.

=cut

sub is_installed {
    my $self = shift;
    my $dir = shift;
    $self->{is_installed}->{$dir} = shift if @_;
    return $self->{is_installed}->{$dir};
}

=item $module->install($runtime, $dir);

Installs all this module's files from a previously populated build 
cache, into the directory C<$dir>. If any dependant modules have 
not yet been installed, they will be installed first.

=cut

sub install {
    my $self = shift;
    my $runtime = shift;
    my $dir = shift;

    my $log = Log::Log4perl->get_logger();

    if ($self->is_installed($dir)) {
        $log->debug("Module " . $self->name . " is already installed into '$dir'");
        return;
    }

    foreach my $depend (@{$self->depends}) {
        $runtime->module($depend)->install($runtime, $dir);
    }
    
    my $archive = $runtime->archive;
    if (!defined $archive) {
	die "cannot install files with an archive";
    }
    $log->debug("Installing module " . $self->name . " into '$dir'");
    $archive->extract_files($self->name, "installed", $dir, { link => 1});
    $self->is_installed($dir, 1);
}


=item $module->test_status($name);

Retrieves the status of the test called C<$name>. The status
will be one of the C<success>, C<failed>, C<cached>. If there
is no test called C<$name>, an error will be thrown.

=cut

sub test_status {
    my $self = shift;
    my $name = shift;
    
    die "no test with name $name" unless exists $self->{results}->{"test-" . $name};
    
    return $self->{results}->{"test-" . $name}->{status};
}


=item $module->test_output_log_file($name);

Retrieves the name of the logfile into which console output
for the test called C<$name> should be saved. The logfile name
will be relative to the runtime's log root directory.

=cut

sub test_output_log_file {
    my $self = shift;
    my $name = shift;

    return $self->_result_log_file("test-$name", "output"); 
}

=item $module->test_result_log_file($name);

Retrieves the name of the logfile into which formal results
for the test called C<$name> should be saved. The logfile name
will be relative to the runtime's log root directory.

=cut

sub test_result_log_file {
    my $self = shift;
    my $name = shift;

    return $self->_result_log_file("test-$name", "result"); 
}


=item my $seconds = $module->test_start_date($name);

Retrieves the timestamp at which the test called C<$name> began
execution. If no test called C<$name> has been run yet, an error 
will be thrown.

=cut


sub test_start_date {
    my $self = shift;
    my $name = shift;
    
    die "no test with name $name" unless exists $self->{results}->{"test-" . $name};
    
    return $self->{results}->{"test-" . $name}->{start_date};
}


=item my $seconds = $module->test_end_date($name);

Retrieves the timestamp at which the test called C<$name> completed
execution. If no test called C<$name> has been run yet, an error 
will be thrown.

=cut


sub test_end_date {
    my $self = shift;
    my $name = shift;
    
    die "no test with name $name" unless exists $self->{results}->{"test-" . $name};
    
    return $self->{results}->{"test-" . $name}->{end_date};
}


=item my @names = $module->tests

Retrieves the list of all known test names which have been executed
for this module.

=cut

sub tests {
    my $self = shift;
    
    return map { /^test-(.*)$/ ; $1 } 
      sort { $self->{results}->{$a}->{order} <=> $self->{results}->{$b}->{order} } 
      grep { /^test-/ } keys %{$self->{results}};
}

=item my $status = $module->build_status;

Retrieves the status of the module build. If the module has not
yet been built, it will return 'pending'; if the build has been
run it will return one of 'success', 'failed', or 'cached'; if
the module's build was skipped due to a dependant module failing,
the status will be 'skipped'.

=cut

sub build_status {
    my $self = shift;
    return $self->{results}->{build}->{status};
}


=item $module->build_output_log_file();

Retrieves the name of the logfile into which console output
for the build process should be saved. The logfile name
will be relative to the runtime's log root directory.

=cut


sub build_output_log_file {
    my $self = shift;
    return $self->_result_log_file("build", "output"); 
}

=item $module->build_result_log_file();

Retrieves the name of the logfile into which results
for the build process unittests should be saved. The 
logfile name will be relative to the runtime's log 
root directory.

=cut


sub build_result_log_file {
    my $self = shift;
    return $self->_result_log_file("build", "result"); 
}

=item my $seconds = $module->test_start_date();

Retrieves the timestamp at which the build process began
execution. If the build has not run yet, an undefined value
will be returned.

=cut

sub build_start_date {
    my $self = shift;
    return $self->{results}->{build}->{start_date};
}


=item my $seconds = $module->test_end_date();

Retrieves the timestamp at which the build process completed
execution. If the build has not run yet, an undefined value
will be returned.

=cut


sub build_end_date {
    my $self = shift;
    return $self->{results}->{build}->{end_date};
}

# Internal method, may disappear at any time!
sub _result_log_file {
    my $self = shift;
    my $cmdname = shift;
    my $type = shift;
    
    return $self->name . "-" . $cmdname . "-" . $type . ".log";
}

# Internal method, may disappear at any time!
sub _add_result {
    my $self = shift;
    my $action = shift;
    my $status = shift;
    my $start = shift || time;
    my $end = shift || $start;
    
    die "already got a result for action $action"
      if exists $self->{results}->{$action} &&
        !($action eq "build" && $self->{results}->{$action}->{status} eq "pending");

    my @results = keys %{$self->{results}};

    $self->{results}->{$action} = {
      order => $#results+1,
      status => $status,
      start_date => $start,
      end_date => $end,
    };
}


=item my $stauts = $module->status

Retrieves the overall status of this module. If the
module build failed, is pending, or was skipped, then
this returns 'failed', 'pending', or 'skipped' 
respectively; If any test script failed, this returns 
'failed'; otherwise it returns 'success'.

=cut

sub status {
    my $self = shift;
    
    if ($self->build_status() eq "cached" ||
	$self->build_status() eq "success") {
	foreach my $name ($self->tests) {
	    if ($self->{results}->{"test-" . $name}->{status} eq "failed") {
		return "failed";
	    }
	}
	return "success";
    } else {
	return $self->build_status();
    }
}

=item my @paths = $module->paths($repository)

Returns the list of source paths to be checked
out from the repository C<$repository>. If there
are no paths associated with that repository,
returns an empty list.

=cut

sub paths {
    my $self = shift;
    my $repository = shift or die;

    my $sources = $self->sources();
    my @paths;
    foreach my $entry (@{$sources}) {
	if ($entry->{repository} eq $repository->name) {
	    push @paths, $entry->{path};
	}
    }
    return @paths;
}


# Internal method liable to disappear!
sub _save_log {
    my $self = shift;
    my $logfile = shift;
    my $data = shift;
    
    open LOG, ">$logfile"
	or die "cannot create $logfile: $!";
    print LOG $data;
    close LOG
	or die "cannot save $logfile: $!";
}

=item my $status = $module->invoke_shell($runtime, $controlfile, $logfile, \@args);

This method spawns a shell, and executes the command C<$controlfile> saving its
combined stdout/stderr output to the file C<$logfile>. The command will have
C<@args> passed as command line arguments, and will be run in the context
of the environment returned by the C<get_shell_env> method. The return value
of this method will be zero upon success, otherwise it will return the exit
status of the command. Before invoking the command C<$controlfile> the current
directory will be changed to the directory returned by the C<dir> method
beneath the runtime's source root. Any errors encountered while trying to
spawn the shell, or invoke the command will also be logged in the file given
by the C<$logfile> parameter.

=cut

sub invoke_shell {
    my $self = shift;
    my $runtime = shift;
    my $controlfile = shift;
    my $logfile = shift;
    my $args = shift;

    my $log = Log::Log4perl->get_logger();
    $log->debug("Running $controlfile with output to $logfile args (". join(", ", @{$args}) . ")");

    my $cwd = getcwd;
    my $wkdir = catdir($runtime->source_root, $self->dir);

    unless (chdir $wkdir) {
	$self->_save_log($logfile, "cannot change into directory '$wkdir'");
	return 1;
    }

    local %ENV = %ENV;
    my %env = $runtime->get_shell_environment($self);
    foreach (keys %env) {
        $log->debug("Setting module global environment '$_' to '" . $env{$_} . "'");
        $ENV{$_} = $env{$_};
    }
    my $env = $self->env;
    foreach (keys %{$env}) {
        $log->debug("Setting module specified environment '$_' to '" . $env->{$_} . "'");
        $ENV{$_} = $env->{$_};
    }

    $controlfile = "./" . $controlfile unless $controlfile =~ m,^(\.)?/,;
    if (!-e $controlfile) {
	$self->_save_log($logfile, "cannot find control file '" . 
			 $controlfile . "' from working directory '" . $wkdir . "'");
        unless (chdir $cwd) {
            die "could not change back to directory: '$cwd'";
        }
	return 1;
    }
    if (!-x _) {
	$self->_save_log($logfile, "control file '$controlfile' is not executable " .
			 "from working directory '" . $wkdir . "'");
	unless (chdir $cwd) {
            die "could not change back to directory: '$cwd'";
        }
        return 1;
    }
    
    my $argv = join(" ", @{$args});
    `$controlfile $argv </dev/null 1>$logfile 2>&1`;
    
    my $res = $?;
    
    unless (chdir $cwd) {
        die "could not change back to directory: '$cwd'";
    }
    
    return $res;
}


=item $module->run_task($runtime, $taskname, $controlfile);

This method runs a task named C<$taskname> by invoking the
shell command C<$controlfile> in the source directory for
this module. The taskname must either be C<build> or be
prefixed by the string C<test->. If the taskname is L<build> 
then after execution any files created in the install root 
will be recorded as installed files - later available by 
invoking the C<installed> method. Likewise any files created 
in the package root, matching known package types will be 
recorded as generated packages - later available by invoking 
the C<packags> method. The start and end times of the task,
along with its success/failure status will be record and
later available from the corresponding C<build_XXX> or
C<test_XXX> methods matching the C<$taskname>. The controfile
will be invoked with a single command line argument, which
is the full path to a file into which formal test results
should be saved. Regular, free format, build / test output
will automatically be captured to an alternate log file.

=cut

sub run_task {
    my $self = shift;
    my $runtime = shift;
    my $taskname = shift;
    my $controlfile = shift;

    

    my $log = Log::Log4perl->get_logger();
    foreach my $depend (@{$self->depends}) {
        $runtime->module($depend)->install($runtime, $runtime->install_root);
    }
    my $before_packages;
    my $before_installed;
    if ($taskname eq "build") {
	$before_packages = $runtime->package_snapshot();
	$before_installed = $runtime->installed_snapshot();
    }

    my $resultlog = catfile($runtime->log_root, $self->_result_log_file($taskname, "result"));
    my $outputlog = catfile($runtime->log_root, $self->_result_log_file($taskname, "output"));

    unlink($outputlog) if -f $outputlog;
    unlink($resultlog) if -f $resultlog;

    my $start = time;
    my $res = $self->invoke_shell($runtime, $controlfile, $outputlog, [$resultlog]);
    my $end = time;
    my $status = $res ? "failed" : "success";
    if ($res) {
	$log->debug("Failed with status $res");
    }
    $self->_add_result($taskname, $status, $start, $end);

    if ($taskname eq "build") {
	if ($self->build_status() eq 'success') {
	    my $after_packages = $runtime->package_snapshot ();
	    my $after_installed = $runtime->installed_snapshot();

	    $self->packages(Test::AutoBuild::Lib::new_packages ($before_packages, $after_packages));
	    $self->installed(Test::AutoBuild::Lib::new_packages ($before_installed, $after_installed));
	    $self->is_installed($runtime->install_root, 1);
	}
    }
}


=item $module->cachable_run_task

This is a wrapper around the C<run_task> method which makes use
of the currently configured L<Test::AutoBuild::ArchiveManager> to
cache successfull invocations of a task. On subsequent invocations,
provided there have been no source code checkout changes since the 
previous archive, and no dependant modules have been re-built, the
archived result will be restored, rather than invoking the task
again. From the caller's POV, there should be no functional difference
between C<cachable_run_task> and C<run_task>, with the exception that
the former will be alot faster if the archive is used.

=cut

sub cachable_run_task {
    my $self = shift;
    my $runtime = shift;
    my $taskname = shift;
    my $controlfile = shift;
    
    my $log = Log::Log4perl->get_logger();
    my $arcman = $runtime->archive_manager();

    if ($self->should_skip($runtime)) {
	$self->_add_result($taskname, "skipped");
        $log->info("skipping " . $taskname);
        return;
    }

    if ($self->{use_archive} && 
	defined $arcman) {
	my $cache = $arcman->get_previous_archive($runtime);
	if ($self->archive_usable($runtime, $cache, $taskname)) {
	    $self->unarchive_result($runtime, $cache, $taskname);
	} else {
	    $self->run_task($runtime, $taskname, $controlfile);
	}

	my $archive = $arcman->get_current_archive($runtime);
	$self->archive_result($runtime, $archive, $taskname);
    } else {
        $log->info("skipping cache entirely");
	$self->run_task($runtime, $taskname, $controlfile);
    }
}


=item $module->unarchive_result($runtime, $cache, $taskname)

This method restores the result of the task C<$taskname>
from an old archive C<$cache>. C<$cache> will be a subclass
of the C<Test::AutoBuild::Archive> module. If the taskname
is C<build>, then the log files, build results, intalled
files, generated packages, and source changelogs will all
be restored. If the taskname is prefixed by C<test->, then
the log files and test results will be restored.

=cut

sub unarchive_result {
    my $self = shift;
    my $runtime = shift;
    my $cache = shift;
    my $taskname = shift;

    my $log = Log::Log4perl->get_logger();
    $log->debug("Restoring result for $taskname");

    $self->_add_result($taskname, 
		       "cache", 
		       $cache->get_data($self->name, $taskname)->{start_date},
		       $cache->get_data($self->name, $taskname)->{end_date},
		       );
    
    $cache->extract_files($self->name, $taskname, $runtime->log_root, { link => 1 });

    if ($taskname eq "build") {
	$log->debug("Unarchiving build packages and changes");

	# Changes from source repository
        # Don't toggle 'changed' flag because this is a cached build
	#$self->changed($cache->get_data($self->name, "changes")->{changed});
	$self->changes($cache->get_data($self->name, "changes")->{changes});
	
	# Installed files
	$self->installed($cache->extract_files($self->name, "installed", $runtime->install_root, { link => 1 }));
	
	# Generated packages
	$self->packages($cache->extract_files($self->name, "packages", $runtime->package_root, { link => 1}));
    }
}

=item my $bool = $module->archive_usable($runtime, $archive, $taskname)

Returns a true value, if the archive C<$archive> contains a usable saved
entry for the task C<$taskname>. An archive for a module's task is defined 
to be usable if all dependant modules are also usable; if the archive 
contains a bucket with the name C<$taskname>; if the status of the save
task is C<success> or C<cached>; and if no source code changes have been
made.

=cut

sub archive_usable {
    my $self = shift;
    my $runtime = shift;
    my $archive = shift;
    my $taskname = shift;

    my $log = Log::Log4perl->get_logger();

    if (!defined $archive) {
	$log->info("archive does not exist");
	return 0;
    }

    $log->debug("Checking usability of " . $self->name, " for $taskname in cache " . $archive->key);

    my $all_deps_ok = 1;
    foreach my $depend (@{$self->depends}) {
	if (!$runtime->module($depend)->archive_usable($runtime, $archive, $taskname)) {
	    $log->info("Archive is not usable because module $depend was not a success");
	    return 0;
	}
    }

    if (!$archive->has_data($self->name, $taskname)) {
	$log->info("no cached data for command $taskname");
	return 0;
    }

    my $data = $archive->get_data($self->name, $taskname);
    if ($data->{status} ne "success" &&
	$data->{status} ne "cache") {
	$log->info("archive was not a success");
	return 0;
    }
    
    if ($self->changed) {
	$log->info("Not using archive because code changes have been made");
	return 0;
    }

    $log->info("using archive for " . $taskname);
    return 1;
}

=item $module->archive_result($runtime, $archive, $taskname)

This method saves the result of the task C<$taskname>
to a new archive C<$archive>. C<$archive> will be a subclass
of the C<Test::AutoBuild::Archive> module. If the taskname
is C<build>, then the log files, build results, intalled
files, generated packages, and source changelogs will all
be saved. If the taskname is prefixed by C<test->, then
the log files and test results will be saved.

=cut


sub archive_result {
    my $self = shift;
    my $runtime = shift;
    my $archive = shift;
    my $taskname = shift;

    my $log = Log::Log4perl->get_logger();
    $log->debug("Saving result for $taskname " . $self->{results}->{$taskname}->{status});
    $archive->save_data($self->name,
			$taskname,
			$self->{results}->{$taskname});

    my $stdout_log = catfile($runtime->log_root, $self->_result_log_file($taskname, "stdout"));
    my $result_log = catfile($runtime->log_root, $self->_result_log_file($taskname, "result"));
    
    my $stdout_log_stat = stat $stdout_log;
    my $result_log_stat = stat $result_log;

    my $logs = {};
    $logs->{$stdout_log} = $stdout_log_stat if $stdout_log_stat;
    $logs->{$result_log} = $result_log_stat if $stdout_log_stat;

    $archive->save_files($self->name,
			 $taskname,
			 $logs,
			 { link => 1, base => $runtime->log_root });

    if ($taskname eq "build") {
	$log->debug("Saving build install fils, packages and changes");
	
	$archive->save_files($self->name,
			     "installed",
			     $self->installed,
			     { 
				 link => 1, 
				 base => $runtime->install_root,
			     });
	$archive->save_files($self->name,
			     "packages",
			     $self->packages(),
			     { 
				 link => 1,
				 base => $runtime->package_root,
			     });
	$archive->save_data($self->name,
			    "changes",
			    { 
				changed => $self->changed, 
				changes => $self->changes(),
			    });
    }
}


=item $module->build($runtime, $controlfile);

Runs the build task, by invoking the shell command C<$controlfile>
in the source directory of this module. Refer to the C<run_task>
and C<invoke_shell> methods for further details of the context of
execution. Results and information about the task can later be 
invoking the various C<build_XXX> methods.

=cut

sub build {
    my $self = shift;
    my $runtime = shift;
    my $controlfile = shift;
    
    $self->cachable_run_task($runtime, "build", $controlfile);
}

=item $module->test($runtime, $testname, $controlfile);

Runs a test task with the name C<$testname>, by invoking the shell 
command C<$controlfile> in the source directory of this module. Refer 
to the C<run_task> and C<invoke_shell> methods for further details 
of the context of execution. Results and information about the
task can later be retrieved passing the C<$testname> to the various
C<test_XXX> methods.

=cut

sub test {
    my $self = shift;
    my $runtime = shift;
    my $testname = shift;
    my $controlfile = shift;

    $self->cachable_run_task($runtime, "test-$testname", $controlfile); 
}

=item my $bool = $module->should_skip($runtime);

Determines if execution of tasks for this module should be
skipped. A module should be skipped, if any of its dependant
modules have a value returned by their C<build_status>
methods of 'failed', 'pending' or 'skipped'.

=cut

sub should_skip {
    my $self = shift;
    my $runtime = shift;
    my $log = Log::Log4perl->get_logger();
    my $depends = $self->depends();

    my $skip = 0;
    foreach my $depend (@{$depends}) {
	my $module = $runtime->module($depend);
        if ($module->build_status() eq 'pending') {
            $log->warn("Skipping " . $self->label() . " because " . $module->label() . " has not run");
            $skip = 1;
        }

        if ($module->build_status() ne 'success' &&
            $module->build_status() ne 'cache' ) {
            $log->debug("Skipping " . $self->label() . " because " . $module->label() . " failed");
            $skip = 1;
        }
    }

    return $skip;
}


1 # So that the require or use succeeds.

__END__

=back

=head1 AUTHORS

Daniel Berrange <dan@berrange.com>

=head1 COPYRIGHT

Copyright (C) 2002-2004 Daniel Berrange <dan@berrange.com>

=head1 SEE ALSO

C<perl(1)>, L<Test::AutoBuild::Runtime>, L<Test::AutoBuild::Repository>,
L<Test::AutoBuild::Stage>

=cut
