Daizu::Test - functions for use by the test suite

package Daizu::Test;
use warnings;
use strict;

use base 'Exporter';
our @EXPORT_OK = qw(
    $TEST_DBCONF_FILENAME $DB_SCHEMA_FILENAME
    $TEST_REPOS_DIR $TEST_REPOS_URL
    init_tests test_config
    create_database drop_database
    create_test_repos
    get_nav_menu_carefully test_menu_item
    test_cmp_guids test_cmp_urls
);

use Path::Class qw( file dir );
use DBI;
use File::Path qw( rmtree );
use SVN::Core;
use SVN::Ra;
use SVN::Repos;
use SVN::Delta;
use Carp qw( croak );
use Carp::Assert qw( assert );
use Test::More;
use Daizu::Util qw( db_select );

our $TEST_DBCONF_FILENAME = file('test.conf')->absolute->stringify;
our $DB_SCHEMA_FILENAME = 'db.sql';
our $TEST_REPOS_DIR = dir('.test-repos')->absolute->stringify;
our $TEST_REPOS_URL = "file://$TEST_REPOS_DIR";
our $TEST_REPOS_DUMP = file('test-repos.dump')->absolute->stringify;
our $TEST_OUTPUT_DIR = dir('.test-output')->absolute->stringify;
our $TEST_CONFIG = 'test-config.xml';

{
    my $test_config;

    sub init_tests
    {
        my ($num_tests, $show_errors) = @_;
        my $errors = '';

        open my $fh, '<', $TEST_DBCONF_FILENAME
            or die "$0: error opening 'TEST_DBCONF_FILENAME': $!\n";

        my %config;
        while (<$fh>) {
            next unless /\S/;
            next if /^\s*#/;
            chomp;
            my ($key, $value) = split ' ', $_, 2;
            $errors .= "$TEST_DBCONF_FILENAME:$.: duplicate value for '$key'\n"
                if exists $config{$key};
            $errors .= "$TEST_DBCONF_FILENAME:$.: value missing for '$key'\n"
                if !defined $value || $value eq '';
            $config{$key} = $value;
        }

        $errors .= "$0: you need to edit the file '$TEST_DBCONF_FILENAME'" .
                   " before you can run the test suite, to configure how the" .
                   " tests should access your PostgreSQL server.\n"
            if $config{'not-configured'};

        for (qw( template-dsn test-dsn )) {
            $errors .= "$0: configuration file '$TEST_DBCONF_FILENAME' must" .
                       " contain a value called '$_' for the test suite to" .
                       " work.\n"
                 unless $config{$_};
        }

        if ($errors ne '') {
            warn "\n\n$errors\n" if $show_errors;
            plan skip_all => "Tests not configured in '$TEST_DBCONF_FILENAME'";
        }
        else {
            plan tests => $num_tests
                if defined $num_tests;
        }

        $test_config = \%config;
    }

    sub test_config
    {
        croak "can't call 'test_config' until you've called 'init_tests'"
            unless defined $test_config;
        return $test_config;
    }
}

sub pg_template_dbh
{
    my $config = test_config();
    return DBI->connect(
        $config->{'template-dsn'}, $config->{'template-user'},
        $config->{'template-password'},
        { AutoCommit => 1, RaiseError => 1, PrintError => 0 },
    );
}

sub create_database
{
    # Drop the test DB if it already exists.
    my $config = test_config();
    my $db = DBI->connect(
        $config->{'test-dsn'}, $config->{'test-user'},
        $config->{'test-password'},
        { RaiseError => 0, PrintError => 0 },
    );
    if (defined $db) {
        undef $db;
        drop_database();
    }

    $db = pg_template_dbh();
    my $db_name = _test_db_name();
    $db->do(qq{
                create database $db_name
        });

    $db->disconnect;
    $db = DBI->connect(
        $config->{'test-dsn'}, $config->{'test-user'},
        $config->{'test-password'},
        { AutoCommit => 1, RaiseError => 1, PrintError => 0 },
    );

    # Turn off warnings while loading the schema.  This silences the 'NOTICE'
    # messages about which indexes PostgreSQL is creating, which aren't
    # very interesting.
    local $db->{PrintWarn};

    open my $schema, '<', $DB_SCHEMA_FILENAME
        or die "error opening DB schema '$DB_SCHEMA_FILENAME': $!";
    my $sql = '';
    while (<$schema>) {
        next unless /\S/;
        next if /^\s*--/;
        $sql .= $_;
        if (/;$/) {
            eval { $db->do($sql) };
            die "Error executing statement:\n$sql:\n$@"
                if $@;
            $sql = '';
        }
    }

    croak "error in '$DB_SCHEMA_FILENAME': last statement should end with ';'"
        if $sql ne '';

    return $db;
}

sub drop_database
{
    my $db = pg_template_dbh();
    sleep 1;    # Wait until we're properly disconnected.

    my $db_name = _test_db_name();
    $db->do(qq{
                drop database $db_name
        });
}

sub create_test_repos
{
    rmtree($TEST_REPOS_DIR)
        if -e $TEST_REPOS_DIR;
    SVN::Repos::create($TEST_REPOS_DIR, undef, undef, undef, undef);
    system("svnadmin load --quiet $TEST_REPOS_DIR <$TEST_REPOS_DUMP");
    my $ra = SVN::Ra->new(url => $TEST_REPOS_URL);
    assert($ra->get_latest_revnum > 0);     # confirm undump worked
    return $ra;
}

sub get_nav_menu_carefully
{
    my ($file) = @_;
    assert(ref $file);

    my $gen = $file->generator;
    my @urls = $gen->urls_info($file);
    assert(@urls >= 1);

    my $menu = $gen->navigation_menu($file, $urls[0]);

    my $num_undef_links = _nav_menu_check_children($menu);
    assert($num_undef_links == 0 || $num_undef_links == 1);

    return $menu;
}
 
# Check a an array of menu items for structural integrity.  The value
# should be suitable for being a 'children' item in a navigation menu.
sub _nav_menu_check_children
{
    my ($items) = @_;
    assert(defined $items);
    assert(ref $items eq 'ARRAY');

    my $num_undef_links = 0;
    for my $item (@$items) {
        assert(defined $item);
        assert(ref $item eq 'HASH');
        assert(defined $item->{title});
        ++$num_undef_links unless defined $item->{link};
        $num_undef_links += _nav_menu_check_children($item->{children});
    }

    return $num_undef_links;
}

sub test_menu_item
{
    my ($item, $desc, $num_children, $url, $title, $short_title) = @_;

    SKIP: {
        my $num_tests = @_ > 5 ? 4 : 3;
        skip "expected menu item '$desc' doesn't exist", $num_tests
            unless defined $item;
        is($item->{link}, $url, "navigation_menu: $desc: link");
        is($item->{title}, $title, "navigation_menu: $desc: title");
        is(scalar @{$item->{children}}, $num_children,
           "navigation_menu: $desc: num children");
        is($item->{short_title}, $short_title,
           "navigation_menu: $desc: short_title")
            if @_ > 5;
    }
}

sub test_cmp_guids
{
    my ($db, $wc_id, $desc, $got, @expected) = @_;
    assert(@expected > 0);

    for my $path (@expected) {
        my $guid_id = db_select($db, 'wc_file',
            { wc_id => $wc_id, path => $path },
            'guid_id',
        );
        assert(defined $guid_id);

        my $found;
        for (@$got) {
            next unless $_ == $guid_id;
            $found = 1;
            last;
        }
        ok($found, "$desc, update $path");
    }
}

sub test_cmp_urls
{
    my ($desc, $got, @expected) = @_;
    is(scalar @$got, scalar @expected, "$desc, num URLs");

    for my $exp_url (@expected) {
        $exp_url = URI->new($exp_url);

        my $found;
        for (@$got) {
            next unless $exp_url->eq($_);
            $found = 1;
            last;
        }
        ok($found, "$desc, pub $exp_url");
    }
}

sub _test_db_name
{
    my $config = test_config();
    my $test_dsn = $config->{'test-dsn'};
    die "$0: can't extract 'dbname' part from test DSN '$test_dsn' in order" .
        " to drop the test database\n"
        unless $test_dsn =~ /\bdbname=(\w+)\b/i;
    return "$1";
}

1;
# vi:ts=4 sw=4 expandtab