File Coverage

blib/lib/Dancer2/Plugin/Pg/Core.pm
Criterion Covered Total %
statement 6 178 3.3
branch 0 62 0.0
condition 0 27 0.0
subroutine 2 14 14.2
pod 0 10 0.0
total 8 291 2.7


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::Pg::Core;
2              
3 1     1   4 use Moo;
  1         0  
  1         7  
4 1     1   1515 use DBI;
  1         11028  
  1         1247  
5              
6             has 'dbh' => (
7             is => 'ro',
8             writer => 'set_dbh'
9             );
10              
11             has ['host', 'base', 'port', 'username', 'password'] => (
12             is => 'ro'
13             );
14              
15             has 'options' => (
16             is => 'ro',
17             default => sub {
18             {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}
19             }
20             );
21              
22             has ['table', 'returning'] => (
23             is => 'rw'
24             );
25              
26             has ['keys', 'values', 'type', 'reference'] => (
27             is => 'rw',
28             default => sub {
29             []
30             }
31             );
32              
33             sub BUILD {
34 0     0 0   my $self = shift;
35            
36 0           my $dsn = 'dbi:Pg:';
37 0 0         $dsn .= 'dbname=' . $self->base if $self->base;
38 0 0         $dsn .= ';host=' . $self->host if $self->host;
39 0 0         $dsn .= ';port=' . $self->port if $self->port;
40            
41 0   0       my $dbh = DBI->connect($dsn, $self->username, $self->password, $self->options) || die $DBI::errstr;
42 0           $self->set_dbh($dbh);
43 0           return $self;
44             }
45              
46             sub query {
47 0     0 0   my $self = shift;
48            
49 0           my $sql = shift;
50 0   0       my $sth = $self->dbh->prepare($sql) || die $self->dbh->errstr;
51 0           $sth->execute(@_);
52 0           return $sth;
53             }
54              
55             sub selectOne {
56 0     0 0   my $self = shift;
57            
58 0   0       my $result = $self->dbh->selectrow_arrayref(shift, undef, @_) || die $self->dbh->errstr;
59 0           return $result->[0];
60             }
61              
62             sub selectRow {
63 0     0 0   my $self = shift;
64            
65 0   0       my $result = $self->dbh->selectrow_hashref(shift, undef, @_) || die $self->dbh->errstr;
66 0           return $result;
67             }
68              
69             sub selectAll {
70 0     0 0   my $self = shift;
71            
72 0   0       my $result = $self->dbh->selectall_arrayref(shift, {Slice=>{}}, @_) || die $self->dbh->errstr;
73 0 0         return [] unless $result;
74 0 0         return [$result] unless ref($result) eq 'ARRAY';
75 0           return $result;
76             }
77              
78             sub column {
79 0     0 0   my ($self, $key, $value) = @_;
80            
81 0           push(@{$self->keys}, $key);
  0            
82 0 0         if (ref($value) eq 'HASH') {
83 0           push(@{$self->type}, keys %{$value});
  0            
  0            
84 0           push(@{$self->values}, values %{$value});
  0            
  0            
85             }else{
86 0           push(@{$self->type}, undef);
  0            
87 0           push(@{$self->values}, $value);
  0            
88             }
89 0           push(@{$self->reference}, '?');
  0            
90             }
91              
92             sub insert {
93 0     0 0   my $self = shift;
94            
95 0           my $sql = 'INSERT INTO ' . $self->table . ' (';
96 0           $sql .= join(',',@{$self->keys});
  0            
97 0           $sql .= ') VALUES (';
98 0           $sql .= join(',', @{$self->reference});
  0            
99 0           $sql .= ')';
100 0 0         $sql .= ' RETURNING ' . $self->returning if $self->returning;
101 0           my $sth = $self->query($sql, @{$self->values});
  0            
102 0 0         $self->_clean unless $self->returning;
103 0 0         return 0 unless $sth;
104 0 0 0       if ($self->returning && $sth->rows > 0) {
105 0           return $self->_getReturning($sth, $self->returning);
106             }else{
107 0           $self->_clean;
108             }
109 0   0       return $sth || 1;
110             }
111              
112             sub update {
113 0     0 0   my ($self, %wheres) = @_;
114            
115 0           my $sql = undef;
116 0           for(my $i=0; $ikeys}); $i++){
  0            
117 0 0         unless($sql){
118 0           $sql = 'UPDATE ' . $self->table . ' SET ';
119 0 0         if (${$self->type}[$i]) {
  0            
120 0           $sql .= ${$self->keys}[$i] . ' ' . ${$self->type}[$i] . ' ?';
  0            
  0            
121             }else{
122 0           $sql .= ${$self->keys}[$i] . ' = ?';
  0            
123             }
124             }else{
125 0 0         if (${$self->type}[$i]) {
  0            
126 0           $sql .= ', ' . ${$self->keys}[$i] . ' ' . ${$self->type}[$i] . ' ?';
  0            
  0            
127             }else{
128 0           $sql .= ', ' . ${$self->keys}[$i] . ' = ?';
  0            
129             }
130             }
131             }
132 0           my $where = '';
133 0           foreach(keys %wheres){
134 0 0         if ($_ =~ /and|or/i) {
135 0           foreach my $key (keys %{$wheres{$_}}){
  0            
136 0 0         $where .= ' ' . uc($_) if $where;
137 0 0         if (ref($wheres{$_}{$key}) eq 'HASH') {
138 0           $where .= ' ' . $key;
139 0           $where .= ' ' . $_ . ' ?' for(keys %{$wheres{$_}{$key}});
  0            
140 0           push(@{$self->values}, values %{$wheres{$_}{$key}});
  0            
  0            
141             }else{
142 0           $where .= ' ' . $key . ' = ?';
143 0           push(@{$self->values}, $wheres{$_}{$key});
  0            
144             }
145             }
146             }else{
147 0 0         $where .= ' AND' if $where;
148 0 0         if (ref($wheres{$_}) eq 'HASH') {
149 0           $where .= ' ' . $_;
150 0           $where .= ' ' . $_ . ' ?' for(keys %{$wheres{$_}});
  0            
151 0           push(@{$self->values}, values %{$wheres{$_}});
  0            
  0            
152             }else{
153 0           $where .= ' ' . $_ . ' = ?';
154 0           push(@{$self->values}, $wheres{$_});
  0            
155             }
156             }
157             }
158 0           $sql .= ' WHERE' . $where;
159 0 0         $sql .= ' RETURNING ' . $self->returning if $self->returning;
160 0           my $sth = $self->query($sql, @{$self->values});
  0            
161 0 0         $self->_clean unless $self->returning;
162 0 0         return 0 unless $sth;
163 0 0 0       if ($self->returning && $sth->rows > 0) {
164 0           return $self->_getReturning($sth, $self->returning);
165             }else{
166 0           $self->_clean;
167             }
168 0   0       return $sth || 1;
169             }
170              
171             sub delete {
172 0     0 0   my ($self, %wheres) = @_;
173            
174 0           my $sql = 'DELETE FROM ' . $self->table;
175 0           my $where = '';
176 0           foreach(keys %wheres){
177 0 0         if ($_ =~ /and|or/i) {
178 0           foreach my $key (keys %{$wheres{$_}}){
  0            
179 0 0         $where .= ' ' . uc($_) if $where;
180 0 0         if (ref($wheres{$_}{$key}) eq 'HASH') {
181 0           $where .= ' ' . $key;
182 0           $where .= ' ' . $_ . ' ?' for(keys %{$wheres{$_}{$key}});
  0            
183 0           push(@{$self->values}, values %{$wheres{$_}{$key}});
  0            
  0            
184             }else{
185 0           $where .= ' ' . $key . ' = ?';
186 0           push(@{$self->values}, $wheres{$_}{$key});
  0            
187             }
188             }
189             }else{
190 0 0         $where .= ' AND' if $where;
191 0 0         if (ref($wheres{$_}) eq 'HASH') {
192 0           $where .= ' ' . $_;
193 0           $where .= ' ' . $_ . ' ?' for(keys %{$wheres{$_}});
  0            
194 0           push(@{$self->values}, values %{$wheres{$_}});
  0            
  0            
195             }else{
196 0           $where .= ' ' . $_ . ' = ?';
197 0           push(@{$self->values}, $wheres{$_});
  0            
198             }
199             }
200             }
201 0           $sql .= ' WHERE' . $where;
202 0 0         $sql .= ' RETURNING ' . $self->returning if $self->returning;
203 0           my $sth = $self->query($sql, @{$self->values});
  0            
204 0 0         $self->_clean unless $self->returning;
205 0 0         return 0 unless $sth;
206 0 0 0       if ($self->returning && $sth->rows > 0) {
207 0           return $self->_getReturning($sth, $self->returning);
208             }else{
209 0           $self->_clean;
210             }
211 0   0       return $sth || 1;
212             }
213              
214             sub lastInsertID {
215 0     0 0   my $self = shift;
216            
217 0   0       return $self->dbh->last_insert_id(undef, undef, shift||undef, shift||undef) || die $self->dbh->errstr;
218             }
219              
220             sub _getReturning {
221 0     0     my ($self, $sth, $columns) = @_;
222            
223 0           my @keys = split(/\,/, $columns);
224 0           my @values = @{$sth->fetch};
  0            
225 0           my %hash;
226 0           for(my $i=0; $i
227 0           $keys[$i] =~ s/\s//g;
228 0           $hash{$keys[$i]} = $values[$i];
229             }
230 0           $self->_clean;
231 0           return \%hash;
232             }
233              
234             sub _clean {
235 0     0     my $self = shift;
236            
237 0           $self->table('');
238 0           $self->returning('');
239 0           $self->keys([]);
240 0           $self->values([]);
241 0           $self->type([]);
242 0           $self->reference([]);
243             }
244              
245             1;
246              
247             __END__