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 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;