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

package Vote::DB::common;

# $Id$

use strict;
use warnings;
use Vote;
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}
        : $_[0]->_newdb($self->{dbstring});
}

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->db->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->db->rollback;
        return;
    };
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{res}
}

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;