# ABSTRACT: A class for testing a Pinto repository

package Pinto::Tester;

use Moose;
use MooseX::NonMoose;
use MooseX::Types::Moose qw(ScalarRef HashRef);

use Carp;
use IO::String;
use Path::Class;
use File::Temp qw(tempdir);
use Test::Log::Dispatch;
use Test::Exception;

use Pinto;
use Pinto::Util;
use Pinto::Globals;
use Pinto::Initializer;
use Pinto::Tester::Util qw(make_dist_struct make_dist_archive parse_reg_spec);
use Pinto::Types qw(Uri Dir);

#------------------------------------------------------------------------------

our $VERSION = '0.065_02'; # VERSION

#------------------------------------------------------------------------------

extends qw(Test::Builder::Module);

#------------------------------------------------------------------------------

BEGIN { 

    # So we don't prompt for commit messages
    $Pinto::Globals::is_interactive = 0; 

    # So the username/author is constant
    $Pinto::Globals::current_author_id = 'AUTHOR';
    $Pinto::Globals::current_username  = 'USERNAME';

    # So we can run `prove` without having the ddl installed
    no warnings 'redefine';
    my $ddl_file = file( qw(share pinto.ddl) );
    *Pinto::Database::ddl_file = sub { $ddl_file } if -e $ddl_file;
}

#------------------------------------------------------------------------------

has pinto_args => (
   isa        => HashRef,
   default    => sub { {} },
   traits     => ['Hash'],
   handles    => { pinto_args => 'elements' },
   lazy       => 1,
);


has init_args => (
   isa        => HashRef,
   default    => sub { {} },
   traits     => ['Hash'],
   handles    => { init_args => 'elements' },
   lazy       => 1,
);


has pinto => (
    is       => 'ro',
    isa      => 'Pinto',
    builder  => '_build_pinto',
    lazy     => 1,
);


has root => (
   is       => 'ro',
   isa      => Dir,
   default  => sub { dir( tempdir(CLEANUP => 1) ) },
   lazy     => 1,
);


has tb => (
   is       => 'ro',
   isa      => 'Test::Builder',
   handles  => [ qw(ok is_eq isnt_eq diag) ],
   default  => sub { my $tb = __PACKAGE__->builder; $tb->level(2); return $tb },
   init_arg => undef,
);

#------------------------------------------------------------------------------
# This force the repository to be constructed immediately.  Just
# making the 'pinto' attribute non-lazy didn't work, probably due to
# dependencies on other attributes.

sub BUILD { $_[0]->pinto }

#------------------------------------------------------------------------------

sub _build_pinto {
    my ($self) = @_;

    my %defaults     = ( root => $self->root );
    my %log_defaults = ( log_handler => Test::Log::Dispatch->new, verbose => 3 );

    my $initializer = Pinto::Initializer->new;
    $initializer->init( %defaults, %log_defaults, $self->init_args );

    my $pinto = Pinto->new(%defaults, %log_defaults, $self->pinto_args);
    return $pinto;
}

#------------------------------------------------------------------------------

sub reset_log {
    my ($self) = @_;

    $self->pinto->logger->log_handler->clear;

    return $self;
}

#------------------------------------------------------------------------------

sub path_exists_ok {
    my ($self, $path, $name) = @_;

    $path = file( $self->root(), @{$path} );
    $name ||= "Path $path exists";

    $self->ok(-e $path, $name);

    return;
}

#------------------------------------------------------------------------------

sub path_not_exists_ok {
    my ($self, $path, $name) = @_;

    $path = file( $self->root(), @{$path} );
    $name ||= "Path $path should not exist";

    $self->ok(! -e $path, $name);

    return;
}

#------------------------------------------------------------------------------

sub run_ok {
    my ($self, $action_name, $args, $test_name) = @_;

    my $result = $self->pinto->run($action_name, %{ $args });
    local $Pinto::Globals::is_interactive = 0;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    $self->result_ok($result, $test_name);

    return $result;
}

#------------------------------------------------------------------------------

sub run_throws_ok {
    my ($self, $action_name, $args, $error_regex, $test_name) = @_;

    local $Pinto::Globals::is_interactive = 0;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $ok = throws_ok { $self->pinto->run($action_name, %{$args}) }
        $error_regex, $test_name;

    $self->diag_log_contents if not $ok;

    return $ok;
}

#------------------------------------------------------------------------------

sub registration_ok {
    my ($self, $reg_spec) = @_;

    my ($author, $dist_archive, $pkg_name, $pkg_ver, $stack_name, $is_pinned)
        = parse_reg_spec($reg_spec);

    my $author_dir = Pinto::Util::author_dir($author);
    my $dist_path  = $author_dir->file($dist_archive)->as_foreign('Unix');
    my $stack      = $self->pinto->repo->get_stack($stack_name);

    my $where = { revision => $stack->head->id, 'package.name' => $pkg_name };
    my $attrs = { prefetch => {package => 'distribution' }};
    my $reg = $self->pinto->repo->db->schema->find_registration($where, $attrs);

    return $self->ok(0, "Package $pkg_name is not on stack $stack_name")
        if not $reg;


    # Test package object...
    my $pkg = $reg->package;
    $self->is_eq($pkg->name,    $pkg_name, "Package has correct name");
    $self->is_eq($pkg->version, $pkg_ver,  "Package has correct version");

    # Test distribution object...
    my $dist = $reg->distribution;
    $self->is_eq($dist->path,  $dist_path, "Distribution has correct dist path");

    # Test pins...
    $self->ok($reg->is_pinned,  "Registration $reg should be pinned") 
        if $is_pinned;

    $self->ok(!$reg->is_pinned, "Registration $reg should not be pinned") 
        if not $is_pinned;


    # Test file paths...
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    $self->path_exists_ok( [qw(authors id), $author_dir, 'CHECKSUMS'] );
    $self->path_exists_ok( ['stacks', $stack_name, qw(authors id), $dist->native_path] );
    $self->path_exists_ok( [ qw(authors id), $dist->native_path ] );

    return;
}

#------------------------------------------------------------------------------

sub registration_not_ok {
   my ($self, $reg_spec) = @_;

    my ($author, $archive, $pkg_name, $pkg_ver, $stack_name, $is_pinned)
        = parse_reg_spec($reg_spec);

    my $author_dir = Pinto::Util::author_dir($author);
    my $dist_path  = $author_dir->file($archive)->as_foreign('Unix');
    my $stack      = $self->pinto->repo->get_stack($stack_name);

    my $where = { stack                 => $stack->id, 
                 'package.name'         => $pkg_name, 
                 'distribution.author'  => $author, 
                 'distribution.archive' => $archive };

    my $reg = $self->pinto->repo->db->schema->search_registration($where);

    return $self->ok(1, "Registration $reg_spec should not exist")
        if not $reg;
}

#------------------------------------------------------------------------------

sub result_ok {
    my ($self, $result, $test_name) = @_;

    $test_name ||= 'Result indicates action was succesful';
    my $ok = $self->ok($result->was_successful, $test_name);
    $self->diag_log_contents if not $ok;

    return $ok;
}

#------------------------------------------------------------------------------

sub result_not_ok {
    my ($self, $result, $test_name) = @_;

    $test_name ||= 'Result indicates action was not succesful';
    my $ok = $self->ok(!$result->was_successful, $test_name);
    $self->diag_log_contents if not $ok;

    return;
}

#------------------------------------------------------------------------------

sub result_changed_ok {
    my ($self, $result, $test_name) = @_;

    $test_name ||= 'Result indicates changes were made';
    my $ok = $self->ok( $result->made_changes, $test_name );
    $self->diag_log_contents if not $ok;

    return $ok;
}

#------------------------------------------------------------------------------

sub result_not_changed_ok {
    my ($self, $result, $test_name) = @_;

    $test_name ||= 'Result indicates changes were not made';
    my $ok = $self->ok( !$result->made_changes, $test_name );
    $self->diag_log_contents if not $ok;

    return $ok;
}

#------------------------------------------------------------------------------

sub repository_clean_ok {
    my ($self) = @_;

    my $dists = $self->pinto->repo->distribution_count;
    $self->is_eq($dists, 0, 'Repo has no distributions');

    my $pkgs = $self->pinto->repo->package_count;
    $self->is_eq($pkgs, 0, 'Repo has no packages');

    my @stacks = $self->pinto->repo->get_all_stacks;
    $self->is_eq(scalar @stacks, 1, 'Repo has only one stack');

    my $stack = $stacks[0];
    $self->is_eq($stack->name, 'master',  'The stack is called "master"');
    $self->is_eq($stack->is_default, 1,  'The stack is marked as default');

    my $authors_id_dir = $self->pinto->config->authors_id_dir;
    $self->ok(! -e $authors_id_dir, 'The authors/id dir should be gone');

    return;
}

#------------------------------------------------------------------------------

sub diag_log_contents {
    my ($self) = @_;
    my $msgs = $self->pinto->logger->log_handler->msgs;
    $self->diag('Log messages are...');
    $self->diag($_->{message}) for @$msgs;
    $self->diag('No log messages seen') if not @$msgs;
}

#------------------------------------------------------------------------------

sub log_like {
    my ($self, $rx, $name) = @_;

    $name ||= 'Log output matches';

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    $self->pinto->logger->log_handler->contains_ok($rx, $name);

    return;
}

#------------------------------------------------------------------------------

sub log_unlike {
    my ($self, $rx, $name) = @_;

    $name ||= 'Log output does not match';

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    $self->pinto->logger->log_handler->does_not_contain_ok($rx, $name);

    return;
}

#------------------------------------------------------------------------------

sub stack_is_default_ok {
    my ($self, $stack_name, $test_name) = @_;

    $test_name ||= '';

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $stack = $self->pinto->repo->get_stack($stack_name);
    $self->ok($stack->is_default, "Stack $stack is marked as default $test_name");

    my $stack_modules_dir = $stack->modules_dir;
    my $repo_modules_dir  = $self->pinto->repo->config->modules_dir;

    $self->ok(-e $repo_modules_dir, "The modules dir exists $test_name") or return;

    my $inode1 = $repo_modules_dir->stat->ino;
    my $inode2 = $stack_modules_dir->stat->ino;

    $self->is_eq($inode1, $inode2, "The modules dir is linked to $stack $test_name");

    return;
}

#------------------------------------------------------------------------------

sub stack_is_not_default_ok {
    my ($self, $stack_name, $test_name) = @_;

    my $stack = $self->pinto->repo->get_stack($stack_name);
    $self->ok(!$stack->is_default, "Stack $stack not marked as default");

    my $stack_modules_dir = $stack->modules_dir;
    my $repo_modules_dir  = $self->pinto->repo->config->modules_dir;

    -l $repo_modules_dir or return; # Might not be any default

    my $inode1 = $repo_modules_dir->stat->ino;
    my $inode2 = $stack_modules_dir->stat->ino;

    $test_name ||= "The modules dir is not linked to stack $stack";
    $self->isnt_eq($inode1, $inode2, $test_name);

    return;
}

#------------------------------------------------------------------------------

sub no_default_stack_ok {
    my ($self, $test_name) = @_;

    $test_name ||= '';

    my $stack = eval { $self->pinto->repo->get_stack };
    $self->ok(!$stack, "No stack is marked as default $test_name");

    my $modules_dir = $self->pinto->repo->config->modules_dir; 
    $self->ok(! -l $modules_dir, "The modules dir is not linked anywhere $test_name");

    return;
}

#------------------------------------------------------------------------------

sub stack_exists_ok {
    my ($self, $stack_name, $test_name) = @_;

    $test_name ||= '';

    my $stack = $self->pinto->repo->get_stack($stack_name);
    $self->ok($stack, "Stack $stack_name exists in DB $test_name");

    my $stack_dir = $self->pinto->repo->config->stacks_dir->subdir($stack_name);
    $self->ok(-e $stack_dir, "Directory for $stack_name exists $test_name");

    return $stack;
}

#------------------------------------------------------------------------------

sub stack_not_exists_ok {
    my ($self, $stack_name, $test_name) = @_;

    $test_name ||= '';

    my $stack = eval { $self->pinto->repo->get_stack($stack_name) };
    $self->ok(!$stack, "Stack $stack_name does not exist in DB $test_name");

    my $stack_dir = $self->pinto->repo->config->stacks_dir->subdir($stack_name);
    $self->ok(!-e $stack_dir, "Directory for $stack_name does not exist $test_name");

    return;
}

#------------------------------------------------------------------------------

sub stack_is_locked_ok {
    my ($self, $stack_name, $test_name) = @_;

    $test_name ||= '';

    my $stack = eval { $self->pinto->repo->get_stack($stack_name) };
    $self->ok($stack, "Stack $stack_name exists in DB $test_name") or return;
    $self->ok($stack->is_locked, "Stack $stack_name is locked");

    return;
}

#------------------------------------------------------------------------------

sub stack_is_not_locked_ok {
    my ($self, $stack_name, $test_name) = @_;

    $test_name ||= '';

    my $stack = eval { $self->pinto->repo->get_stack($stack_name) };
    $self->ok($stack, "Stack $stack_name exists in DB $test_name") or return;
    $self->ok(!$stack->is_locked, "Stack $stack_name is not locked");

    return;
}

#------------------------------------------------------------------------------

sub populate {
    my ($self, @specs) = @_;

    for my $spec (@specs) {
        my $struct  = make_dist_struct($spec);
        my $archive = make_dist_archive($struct);
        my $message = "Populated repository with $spec";

        my $args = { no_recurse => 1,
                     archives   => $archive,
                     author     => $struct->{cpan_author},
                     message    => $message };

        my $r = $self->run_ok('Add', $args, $message);
        croak 'Population failed. Aborting test' unless $r->was_successful;
    }

    return $self;
}

#------------------------------------------------------------------------------

sub clear_cache {
    my ($self) = @_;

    $self->pinto->repo->clear_cache;

    return $self;
}

#------------------------------------------------------------------------------

sub stack_url {
    my ($self, $stack_name) = @_;

    $stack_name ||= 'master';

    return URI->new('file://' . $self->root->resolve->absolute . "/stacks/$stack_name");
}

#------------------------------------------------------------------------------
1;

__END__

=pod

=for :stopwords Jeffrey Ryan Thalhammer Imaginative Software Systems

=head1 NAME

Pinto::Tester - A class for testing a Pinto repository

=head1 VERSION

version 0.065_02

=head1 AUTHOR

Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Imaginative Software Systems.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
