source: trunk/lib/Vote/Model/Vote.pm @ 13

package Vote::Model::Vote;

use strict;
use warnings;
use base 'Catalyst::Model';
use DBI;

=head1 NAME

Vote::Model::Vote - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=cut

sub new {
    my ($class) = @_;
    my $db = DBI->connect(
        'dbi:Pg:' . Vote->config->{db},
        undef, undef,
        {
            RaiseError => 0,
            AutoCommit => 0,
            PrintWarn => 0,
            PrintError => 1,
        }
    ) or return;
    
    bless {
        db => $db,
    }, $class;
}

sub db { $_[0]->{db} }

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

    my $sth = $self->db->prepare_cached(
        q{
        select id from poll where start < now() and "end" > now()
        }
    );

    $sth->execute;
    my @id;
    while(my $res = $sth->fetchrow_hashref) {
        push(@id, $res->{id});
    }

    @id
}

sub vote_status {
    my ($self, $id) = @_;
    
    my $sth = $self->db->prepare_cached(
        q{
        select start < now() as before
               "end"   > now() as after
        where id = ?
        }
    );
    $sth->execute($id);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res or return;
    if ($res->{before}) {
        return 'BEFORE';
    } elsif ($res->{after}) {
        return 'AFTER';
    } else {
        return 'RUNNING';
    }
}

sub vote_info {
    my ($self, $id) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select * from poll where id = ?
        }
    );

    $sth->execute($id);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res
}

sub vote_signing {
    my ($self, $id) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select * from voting left join signing
        on signing.key = voting.key
        where poll = ? order by voting.id
        }
    );
    $sth->execute($id);
    my @people;
    while (my $res = $sth->fetchrow_hashref) {
        push(@people, $res);
    }
    @people
}

sub vote_choices {
    my ($self, $id) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select * from choice where poll = ?
        order by label
        }
    );
    $sth->execute($id);
    my @ch;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ch, $res);
    }
    @ch
}

sub voting_info_id {
    my ($self, $id, $voteid) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select * from voting where id = ? and poll = ?
        }
    );
    $sth->execute($id, $voteid);
    my $res = $sth->fetchrow_hashref();
    $sth->finish;
    $res
}

sub _register_signing {
    my ($self, $vid, $voteid, $referal) = @_;

    my $vinfo = $self->voting_info_id($vid, $voteid) or return;

    my $sth = $self->db->prepare_cached(
        q{
        insert into signing (key, referal) values (?,?)
        }
    );
    $sth->execute($vinfo->{key}, $referal) or do {
        $self->db->rollback;
        return;
    };

    1;
}

sub gen_uid {
    unpack("H*", join("", map { chr(rand(256)) } (0..15)))
}

sub _register_ballot {
    my ($self, $voteid, $choice) = @_;

    my $addb = $self->db->prepare_cached(
        q{
        insert into ballot (id, poll) values (?,?)
        }
    );
    my $uid = gen_uid;
    $addb->execute($uid, $voteid) or do {
        self->db->rollback;
        return;
    };

    my $addbc = $self->db->prepare_cached(
        q{
        insert into ballot_item (id, value) values (?,?)
        }
    );
    foreach (@{ $choice || []}) {
        $addbc->execute($uid, $_) or do {
            $self->db->rollback;
            return;
        };
    }

    $uid;
}

sub register_ballot {
    my ($self, $vid, $voteid, $choice, $referal) = @_;

    # First we register voting has voted
    $self->_register_signing($vid, $voteid, $referal) or return; # TODO error ?

    # registring choices
    my $uid = $self->_register_ballot($voteid, $choice) or return;

    # everything went fine, saving!
    $self->db->commit;

    $uid
}

sub signing_count {
    my ($self, $voteid) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select count(*) from signing join voting
        on voting.key = signing.key where poll = ?
        }
    );

    $sth->execute($voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub ballot_count {
    my ($self, $voteid) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select count(*) from ballot where poll = ?
        }
    );

    $sth->execute($voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub auth_voting {
    my ($self, $poll, $user, $password) = @_;
    my $userinfo = $self->voting_info_id($user, $poll) or return;

    $userinfo->{passwd} or return;
    if (crypt($password, $userinfo->{passwd} || '') eq $userinfo->{passwd}) {
        return 1;
    } else {
        return 0;
    }
}

# Requete de decompte des voix:

# select count(ballot.id), value from ballot left join ballot_item
# on ballot.id = ballot_item.id where ballot.poll = 1 and invalid = 'false'
# group by value
# order by count

=head1 AUTHOR

Thauvin Olivier

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;