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

Last change on this file since 203 was 203, checked in by nanardon, 15 years ago
  • if EPOLL_NO_COMMIT is set, we don't rollback neither, tests should pass all in one transaction
  • Property svn:keywords set to Id Rev
File size: 3.0 KB
Line 
1package Vote::DB::common;
2
3# $Id$
4
5use strict;
6use warnings;
7use DBI;
8use vars qw(@EXPORT);
9use base 'Exporter';
10@EXPORT = qw(gen_uid);
11
12=head1 NAME
13
14Vote::Model::Vote - Catalyst Model
15
16=head1 DESCRIPTION
17
18Catalyst Model.
19
20=cut
21
22sub _newdb {
23    my ($dbstring) = @_;
24    my $db = DBI->connect_cached(
25        'dbi:Pg:' . $dbstring,
26        undef, undef,
27        {
28            RaiseError => 0,
29            AutoCommit => 0,
30            PrintWarn => 0,
31            PrintError => 1,
32        }
33    ) or return;
34    $db->do(q{set DATESTYLE to 'DMY'});
35    return $db;
36}
37
38sub db {
39    my ($self) = @_;
40    return $_[0]->{db} && $_[0]->{db}->ping
41        ? $_[0]->{db}
42        : ($self->{db} = $_[0]->_newdb($self->{dbstring}));
43}
44
45sub commit {
46    my ($self) = @_;
47    $self->{db} or return;
48    # If EPOLL_NO_COMMIT is true, we never commit, use for test
49    if ($ENV{EPOLL_NO_COMMIT}) { return 1 }
50    $self->{db}->commit;
51}
52
53sub rollback {
54    my ($self) = @_;
55    $self->{db} or return;
56    if ($ENV{EPOLL_NO_COMMIT}) { return 1 }
57    $self->{db}->rollback;
58}
59
60sub mail_header {
61    return(
62        'Content-Type' => 'text/plain; charset=UTF-8; format=flowed',
63        'Content-Transfer-Encoding' => '8bit',
64        'X-Epoll-version' => $Vote::VERSION,
65    );
66}
67
68sub random_string {
69    my $lenght = $_[-1] || 8;
70
71    return join('', map { ('a'..'z', 'A'..'Z', 0..9)[rand 62] } (1..$lenght));
72}
73
74sub gen_enc_passwd {
75    my ($self, $passwd) = @_;
76
77    $passwd ||= random_string(8);
78    return(crypt($passwd, '$1$' . random_string(8) . '$'));
79}
80
81sub dbtime {
82    my ($self) = @_;
83    my $sth = $self->db->prepare(
84        q{select to_char(now(), 'DD/MM/YYYY HH24:MI:SS') as d}
85    );
86
87    $sth->execute();
88    my $res = $sth->fetchrow_hashref;
89    $sth->finish;
90    $res->{d};
91}
92
93sub valid_date {
94    my ($self, $date) = @_;
95    my $res = $self->db->do(
96        sprintf(
97            q{ select %s::timestamp },
98            $self->db->quote($date),
99        )
100    );
101    $res or $self->rollback;
102}
103
104sub check_date_max {
105    my ($self, $maxdate, $mindate) = @_;
106    my $sth = $self->db->prepare(
107        sprintf(
108            q{ select %s::timestamp > %s::timestamp as res },
109            $self->db->quote($maxdate),
110            $mindate ? $self->db->quote($mindate) : 'now()',
111        )
112    );
113    $sth->execute or do {
114        $self->rollback;
115        return;
116    };
117    my $res = $sth->fetchrow_hashref;
118    $sth->finish;
119    $res->{res}
120}
121
122sub poll_id_from_uid {
123    my ($self, $uid) = @_;
124    if (length($uid) == 32) {
125        my $sth = $self->db->prepare_cached(
126            q{ select poll from settings where var = 'uid' and val = ?
127                order by poll }
128        );
129        $sth->execute($uid);
130        my $res = $sth->fetchrow_hasref;
131        $sth->finish;
132        return $res->{poll} || $uid;
133    }
134    $uid
135}
136
137sub gen_uid {
138    unpack("H*", join("", map { chr(rand(256)) } (0..15)))
139}
140
141=head1 AUTHOR
142
143Thauvin Olivier
144
145=head1 LICENSE
146
147This library is free software, you can redistribute it and/or modify
148it under the same terms as Perl itself or CeCILL.
149
150=cut
151
1521;
Note: See TracBrowser for help on using the repository browser.