File Coverage

blib/lib/SmokeRunner/Multi/TestSet.pm

Criterion	Covered	Total	%
statement	99	99	100.0
branch	11	14	78.5
condition	6	8	75.0
subroutine	29	29	100.0
pod	11	11	100.0
total	156	161	96.8

package SmokeRunner::Multi::TestSet;
BEGIN {
  $SmokeRunner::Multi::TestSet::AUTHORITY = 'cpan:YANICK';
}
{
  $SmokeRunner::Multi::TestSet::VERSION = '0.19';
}
#ABSTRACT: Represents a set of tests

use strict;
use warnings;

use base 'Class::Accessor::Fast';
__PACKAGE__->mk_ro_accessors( qw( name set_dir test_dir last_run_time is_prioritized ) );

use Class::Factory::Util;
use File::Basename qw( basename );
use File::Find::Rule;
use File::Path qw( rmtree );
use File::Spec;
use List::Util qw( max );
use SmokeRunner::Multi::DBI;
use SmokeRunner::Multi::Validate qw( validate DIR_TYPE );


BEGIN
{
    for my $subclass ( map { __PACKAGE__ . '::' . $_ } __PACKAGE__->subclasses() )
    {
        eval "require $subclass" or die $@;
    }
}

{
    my $spec = { set_dir => DIR_TYPE };
    sub new
    {
        my $class = shift;
        my %p     = validate( @_, $spec );

        my $test_dir = File::Spec->catdir( $p{set_dir}, 't' );
        die "A test set's directory must have a 't' subdirectory"
            unless -d $test_dir;

        my %subclass_p = ( %p,
                           name     => basename( $p{set_dir} ),
                           test_dir => $test_dir,
                           dbh      => SmokeRunner::Multi::DBI::handle(),
                         );

        my $self;
        for my $subclass ( map { __PACKAGE__ . '::' . $_ } $class->subclasses() )
        {
            $self = $subclass->_new(%subclass_p);
        }

        $self ||= __PACKAGE__->_new(%subclass_p);

        $self->_instantiate_in_db();
        $self->_get_db_data();

        return $self;
    }
}

sub _new
{
    my $class = shift;

    return bless { @_ }, $class;
}

sub _instantiate_in_db
{
    my $self = shift;

    my $insert_sql = 'INSERT OR IGNORE INTO TestSet (name) VALUES (?)';

    $self->{dbh}->do( $insert_sql, {}, $self->name() );
}

sub _get_db_data
{
    my $self = shift;

    my $select_sql = 'SELECT last_run_time, is_prioritized FROM TestSet WHERE name = ?';

    @{ $self }{ qw( last_run_time is_prioritized ) } =
        $self->{dbh}->selectrow_array( $select_sql, {}, $self->name() );
}

sub test_files
{
    my $self = shift;

    return sort File::Find::Rule->file()->name( '*.t' )->in( $self->test_dir() );
}

sub last_mod_time
{
    my $self = shift;

    return $self->{last_mod_time} if exists $self->{last_mod_time};

    $self->{last_mod_time} = $self->_last_mod_time() || 0;

    return $self->{last_mod_time};
}

sub _last_mod_time
{
    my $self = shift;

    return max map { ( stat $_ )[9] } $self->test_files();
}

sub is_out_of_date
{
    my $self = shift;

    return $self->seconds_out_of_date() > 0 ? 1 : 0;
}

sub seconds_out_of_date
{
    my $self = shift;

    return $self->last_mod_time() - $self->last_run_time();
}

sub update_last_run_time
{
    my $self = shift;
    my $time = shift;

    my $update_sql = 'UPDATE TestSet SET last_run_time = ? WHERE name = ?';

    $self->{dbh}->do( $update_sql, {}, $time, $self->name() );

    $self->_get_db_data();
}

sub prioritize
{
    my $self = shift;

    my $update_sql = 'UPDATE TestSet SET is_prioritized = ? WHERE name = ?';

    $self->{dbh}->do( $update_sql, {}, 1, $self->name() );

    $self->_get_db_data();
}

sub unprioritize
{
    my $self = shift;

    my $update_sql = 'UPDATE TestSet SET is_prioritized = ? WHERE name = ?';

    $self->{dbh}->do( $update_sql, {}, 0, $self->name() );

    $self->_get_db_data();
}

sub update_files
{
    return;
}

sub remove
{
    my $self = shift;

    my $delete_sql = 'DELETE FROM TestSet WHERE name = ?';

    $self->{dbh}->do( $delete_sql, {}, $self->name() );

    rmtree( $self->set_dir(), 0, 0 )
        or die "Cannot rmtree " . $self->set_dir() . "\n";
}

sub All
{
    my $class = shift;

    my $root_dir = SmokeRunner::Multi::Config->instance()->root_dir();

    opendir my $dh, $root_dir
        or die "Cannot read $root_dir: $!";

    return
        ( sort _sort_sets
          map { eval { $class->new( set_dir => $_ ) } || () }
          grep { -d }
          map { File::Spec->catdir( $root_dir, $_ ) }
          File::Spec->no_upwards( readdir $dh )
        );
}

sub _sort_sets
{
    return
        ( $b->is_prioritized() <=> $a->is_prioritized()
          or
          $b->seconds_out_of_date() <=> $a->seconds_out_of_date()
          or
          # This last clause simply ensures that the sort order is
          # unique and repeatable.
          $a->name() cmp $b->name()
        );
}


1;

__END__