source: trunk/t/10Vote_DB.t @ 216

use strict;
use warnings;
use Test::More;

# $Id$

# Tpoll Structure:
#    {
#        poll => { var => $val },
#        choices => [ qw() ],
#        voting => [ qw(mail) ],
#        ballot => {
#        # signing from voting list
#            signing => { sbal => [], fsbal => [] } # list of items
#        },
#        map => { from => to },
#        results => { var => $val }, # wanted results 
#    }
my $test_polls = [
    { # an empty poll
        poll => { label => 'empty poll' },
        choices => [ qw(ch1 ch2) ],
        test_count => 4,
        tests => sub {
            my ($r) = @_;
            is($r->absolute_majority, 1, "Can get absolute_majority");
            is($r->ballot_count, 0, "can get ballot count");
            is($r->voting_count, 0, "can get voting count");
            is($r->signing_count, 0, "can get signing count");
        }
    },
    {
        poll => { label => 'some vals' },
        choices => [ qw(ch1 ch2) ],
        voting => [ qw(a b c d e f) ],
        ballot => {
            a => { sbal => [ 'ch1' ] },
            b => { sbal => [ 'ch1', 'ch10' ] },
            d => { sbal => [ 'ch1', 'ch2' ] },
            f => {},
        },
        test_count => 7,
        tests => sub {
            my ($r) = @_;
            is($r->absolute_majority, 2, "Can get absolute_majority");
            is($r->ballot_count, 4, "can get ballot count");
            is($r->ballot_count_nonull, 3, "can get ballot count");
            is($r->voting_count, 6, "can get voting count");
            is($r->signing_count, 4, "can get signing count");
            my $res = $r->results;
            is($res->[0]->{value}, 'ch1', "winner is ch1");
            is($res->[0]->{count}, 3, "winner has 3 voices");
        }
    },
    {
        poll => { label => 'some vals with mapped values' },
        choices => [ qw(ch1 ch2 ch3) ],
        voting => [ qw(a b c d e f) ],
        ballot => {
            a => { sbal => [ 'ch1' ] },
            b => { sbal => [ 'ch1', 'ch10' ] },
            d => { sbal => [ 'ch1', 'ch2', 'ch4' ] },
            f => {},
        },
        test_count => 14,
        tests => sub {
            my ($r) = @_;
            $r->map_value('ch10', 'ch1');
            is($r->absolute_majority, 2, "Can get absolute_majority");
            is($r->ballot_count, 4, "can get ballot count");
            is($r->not_empty_ballot_count, 3, "can get ballot count");
            is($r->empty_ballot_count, 1, "can get empty ballot count");
            is($r->voting_count, 6, "can get voting count");
            is($r->signing_count, 4, "can get signing count");
            my $res = $r->results;
            is($res->[0]->{value}, 'ch1', "winner is ch1");
            is($res->[0]->{count}, 3, "winner has 3 voices");
            ok($res->[0]->{abs_maj}, "winner has absolute majority");
            ok($res->[0]->{elected}, "winner is set as elected");
            is(@$res, 4, "count of winners");
            is($res->[3]->{count}, 0, "last has 0 voices");
            ok(!$res->[3]->{abs_maj}, "last has not absolute majority");
            ok(!$res->[3]->{elected}, "last is not set as elected");
        }
    },
    {
        poll => {
            label => 'empty ballot count',
            empty_ballot_has_voice => 1,
        },
        choices => [ qw(ch1 ch2 ch3) ],
        voting => [ qw(a b c d e f) ],
        ballot => {
            a => { sbal => [ 'ch1' ] },
            b => { sbal => [ 'ch1', 'ch2' ] },
            d => { sbal => [ 'ch1', 'ch2' ] },
            e => {},
            f => {},
        },
        test_count => 10,
        tests => sub {
            my ($r) = @_;
            is($r->absolute_majority, 3, "Can get absolute_majority");
            is($r->ballot_count, 5, "can get ballot count");
            is($r->not_empty_ballot_count, 3, "can get ballot count");
            is($r->empty_ballot_count, 2, "can get empty ballot count");
            is($r->voting_count, 6, "can get voting count");
            is($r->signing_count, 5, "can get signing count");
            my $res = $r->results;
            is($res->[0]->{value}, 'ch1', "winner is ch1");
            is($res->[0]->{count}, 3, "winner has 3 voices");
            is(@$res, 4, "count of winners");
            is($res->[3]->{count}, 0, "last has 0 voices");
        }
    },
];

my $poll_test_count = 0;
$poll_test_count += ($_->{test_count} || 0) foreach(@$test_polls);

plan tests => 
    3                          # Fixed test 
    + scalar(@$test_polls) * 4 # number of tested polls scenario
    + $poll_test_count;        # poll test

use_ok 'Vote', 'Vote';
use_ok 'Vote::DB';
$ENV{EPOLL_NO_COMMIT} = 1;
isa_ok(my $vote = Vote::DB->new(Vote->config->{db}), 'Vote::DB');

my $count = 0;
foreach my $tpoll (@$test_polls) {
    $count++;
    diag("Testing vote #$count: " . ($tpoll->{poll}{label} || 'No name'));
    ok(my $pollid = $vote->create_poll('test@', "Vote test $count", "password"),
        "can create a new poll");

    isa_ok(my $poll = $vote->poll($pollid), 'Vote::DB::Poll');

    foreach (keys %{ $tpoll->{poll} || {}}) {
        $poll->param($_ => $tpoll->{poll}{$_});
    }

    $poll->addupd_voting($_) foreach (@{ $tpoll->{voting} || [] });

    foreach (@{ $tpoll->{choices} || [] }) {
        $poll->add_choice($_);
    }

    ok(eq_set(
            [ map { $poll->choice($_)->info->{label} } $poll->choices ],
            $tpoll->{choices} || []), "choices were added");

    foreach my $name (keys %{ $tpoll->{ballot} || {} }) {
        $poll->register_ballot(
            $name, $tpoll->{ballot}{$name}{sbal}, $tpoll->{ballot}{$name}{fsbal}, 'localhost'
        );
    }
    
    isa_ok(my $results = $vote->results($pollid), 'Vote::DB::Poll');

    $tpoll->{tests}->($results);

    $vote->db->rollback; # really rollback
}