source: trunk/lib/Vote/DB/common.pm @ 199

package Vote::DB::common;

# $Id$

use strict;
use warnings;
use DBI;
use vars qw(@EXPORT);
use base 'Exporter';
@EXPORT = qw(gen_uid);

=head1 NAME

Vote::Model::Vote - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=cut

sub _newdb {
    my ($dbstring) = @_;
    my $db = DBI->connect_cached(
        'dbi:Pg:' . $dbstring,
        undef, undef,
        {
            RaiseError => 0,
            AutoCommit => 0,
            PrintWarn => 0,
            PrintError => 1,
        }
    ) or return;
    $db->do(q{set DATESTYLE to 'DMY'});
    return $db;
}

sub db {
    my ($self) = @_;
    return $_[0]->{db} && $_[0]->{db}->ping
        ? $_[0]->{db}
        : ($self->{db} = $_[0]->_newdb($self->{dbstring}));
}

sub commit {
    my ($self) = @_;
    $self->{db} or return;
    # If EPOLL_NO_COMMIT is true, we never commit, use for test
    if ($ENV{EPOLL_NO_COMMIT}) { return 1 }
    $self->{db}->commit;
}

sub rollback {
    my ($self) = @_;
    $self->{db} or return;
    $self->{db}->rollback;
}

sub mail_header {
    return(
        'Content-Type' => 'text/plain; charset=UTF-8; format=flowed',
        'Content-Transfer-Encoding' => '8bit',
        'X-Epoll-version' => $Vote::VERSION,
    );
}

sub random_string {
    my $lenght = $_[-1] || 8;

    return join('', map { ('a'..'z', 'A'..'Z', 0..9)[rand 62] } (1..$lenght));
}

sub gen_enc_passwd {
    my ($self, $passwd) = @_;

    $passwd ||= random_string(8);
    return(crypt($passwd, '$1$' . random_string(8) . '$'));
}

sub dbtime {
    my ($self) = @_;
    my $sth = $self->db->prepare(
        q{select to_char(now(), 'DD/MM/YYYY HH24:MI:SS') as d}
    );

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

sub valid_date {
    my ($self, $date) = @_;
    my $res = $self->db->do(
        sprintf(
            q{ select %s::timestamp },
            $self->db->quote($date),
        )
    );
    $res or $self->rollback;
}

sub check_date_max {
    my ($self, $maxdate, $mindate) = @_;
    my $sth = $self->db->prepare(
        sprintf(
            q{ select %s::timestamp > %s::timestamp as res },
            $self->db->quote($maxdate),
            $mindate ? $self->db->quote($mindate) : 'now()',
        )
    );
    $sth->execute or do {
        $self->rollback;
        return;
    };
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{res}
}

sub poll_id_from_uid {
    my ($self, $uid) = @_;
    if (length($uid) == 32) {
        my $sth = $self->db->prepare_cached(
            q{ select poll from settings where var = 'uid' and val = ?
                order by poll }
        );
        $sth->execute($uid);
        my $res = $sth->fetchrow_hasref;
        $sth->finish;
        return $res->{poll} || $uid;
    }
    $uid
}

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

=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 or CeCILL.

=cut

1;