line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Yancy::Backend::MojoDB; |
2
|
|
|
|
|
|
|
our $VERSION = '1.087'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Abstract base class for drivers based on Mojo DB drivers |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
6
|
|
|
|
|
|
|
#pod |
7
|
|
|
|
|
|
|
#pod package Yancy::Backend::RDBMS; |
8
|
|
|
|
|
|
|
#pod use Mojo::Base 'Yancy::Backend::MojoDB'; |
9
|
|
|
|
|
|
|
#pod |
10
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
11
|
|
|
|
|
|
|
#pod |
12
|
|
|
|
|
|
|
#pod This is an abstract base class for the Mojo database drivers: |
13
|
|
|
|
|
|
|
#pod |
14
|
|
|
|
|
|
|
#pod =over |
15
|
|
|
|
|
|
|
#pod =item L (L) |
16
|
|
|
|
|
|
|
#pod =item L (L) |
17
|
|
|
|
|
|
|
#pod =item L (L) |
18
|
|
|
|
|
|
|
#pod =back |
19
|
|
|
|
|
|
|
#pod |
20
|
|
|
|
|
|
|
#pod =head1 SEE ALSO |
21
|
|
|
|
|
|
|
#pod |
22
|
|
|
|
|
|
|
#pod L, L |
23
|
|
|
|
|
|
|
#pod |
24
|
|
|
|
|
|
|
#pod =cut |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
839
|
use Mojo::Base 'Yancy::Backend'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
27
|
1
|
|
|
1
|
|
77
|
use Role::Tiny 'with'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
28
|
1
|
|
|
1
|
|
191
|
use Scalar::Util qw( blessed looks_like_number ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
29
|
1
|
|
|
1
|
|
7
|
use Mojo::JSON qw( true encode_json ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
30
|
1
|
|
|
1
|
|
6
|
use Carp qw( croak ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
67
|
|
31
|
1
|
|
|
1
|
|
7
|
use Yancy::Util qw( is_type is_format ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4270
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
with 'Yancy::Backend::Role::DBI'; |
34
|
|
|
|
|
|
|
has driver =>; |
35
|
0
|
|
|
0
|
|
|
sub sql_abstract { shift->driver->abstract } |
36
|
0
|
|
|
0
|
|
|
sub dbh { shift->driver->db->dbh } |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub create { |
39
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $params ) = @_; |
40
|
0
|
|
|
|
|
|
$params = $self->normalize( $schema_name, $params ); |
41
|
0
|
|
|
|
|
|
my $id_field = $self->id_field( $schema_name ); |
42
|
|
|
|
|
|
|
# For databases that do not have a 'RETURNING' syntax, we must pass in all |
43
|
|
|
|
|
|
|
# parts of a composite key. In the future, we could add a surrogate |
44
|
|
|
|
|
|
|
# key which is auto-increment that could be used to find the |
45
|
|
|
|
|
|
|
# newly-created row so that we can return the correct key fields |
46
|
|
|
|
|
|
|
# here. For now, assume id field is correct if passed, created |
47
|
|
|
|
|
|
|
# otherwise. |
48
|
|
|
|
|
|
|
die "Missing composite ID parts: " . join( ', ', grep !exists $params->{$_}, @$id_field ) |
49
|
0
|
0
|
0
|
|
|
|
if ref $id_field eq 'ARRAY' && @$id_field > grep exists $params->{$_}, @$id_field; |
50
|
0
|
|
|
|
|
|
my $res = $self->driver->db->insert( $schema_name, $params ); |
51
|
0
|
|
|
|
|
|
my $inserted_id = $res->last_insert_id; |
52
|
|
|
|
|
|
|
return ref $id_field eq 'ARRAY' |
53
|
0
|
|
0
|
|
|
|
? { map { $_ => $params->{$_} // $inserted_id } @$id_field } |
54
|
0
|
0
|
0
|
|
|
|
: $params->{ $id_field } // $inserted_id |
55
|
|
|
|
|
|
|
; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub delete { |
59
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id ) = @_; |
60
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
61
|
0
|
|
|
|
|
|
my $res = eval { $self->driver->db->delete( $schema_name, \%where ) }; |
|
0
|
|
|
|
|
|
|
62
|
0
|
0
|
|
|
|
|
if ( $@ ) { |
63
|
0
|
|
|
|
|
|
croak "Error on delete '$schema_name'=$id: $@"; |
64
|
|
|
|
|
|
|
} |
65
|
0
|
|
|
|
|
|
return !!$res->rows; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub set { |
69
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id, $params ) = @_; |
70
|
0
|
|
|
|
|
|
$params = $self->normalize( $schema_name, $params ); |
71
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
72
|
0
|
|
|
|
|
|
my $res = eval { $self->driver->db->update( $schema_name, $params, \%where ) }; |
|
0
|
|
|
|
|
|
|
73
|
0
|
0
|
|
|
|
|
if ( $@ ) { |
74
|
0
|
|
|
|
|
|
croak "Error on set '$schema_name'=$id: $@"; |
75
|
|
|
|
|
|
|
} |
76
|
0
|
|
|
|
|
|
return !!$res->rows; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub _sql_select { |
80
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $where, $opt ) = @_; |
81
|
0
|
|
|
|
|
|
my $schema = $self->schema->{ $schema_name }; |
82
|
0
|
|
0
|
|
|
|
my $from = ( $schema->{'x-view'} || {} )->{schema} // $schema_name; |
|
|
|
0
|
|
|
|
|
83
|
0
|
0
|
|
|
|
|
my %props = %{ $schema->{properties} || $self->schema->{ $from }{properties} }; |
|
0
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
|
my @cols = keys %props; |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
if ( my $join = $opt->{join} ) { |
87
|
|
|
|
|
|
|
# Make sure everything is fully-qualified |
88
|
0
|
|
|
|
|
|
@cols = map { "$schema_name.$_" } @cols; |
|
0
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
$where->{ "$schema_name.$_" } = delete $where->{ $_ } for grep !/\./, keys %$where; |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
$from = [ $from ]; |
92
|
0
|
0
|
|
|
|
|
my @joins = ref $join eq 'ARRAY' ? @$join : ( $join ); |
93
|
0
|
|
|
|
|
|
for my $j ( @joins ) { |
94
|
0
|
0
|
|
|
|
|
if ( exists $props{ $j } ) { |
|
|
0
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# XXX: We should probably deprecate this one, since it |
96
|
|
|
|
|
|
|
# makes no sense to "join" a property field. |
97
|
0
|
|
|
|
|
|
my $join_prop = $props{ $j }; |
98
|
0
|
|
|
|
|
|
my ( $join_schema_name, $join_key_field ) = split /\./, $join_prop->{'x-foreign-key'}; |
99
|
0
|
|
|
|
|
|
my $join_schema = $self->schema->{ $join_schema_name }; |
100
|
0
|
|
|
|
|
|
my $join_props = $join_schema->{properties}; |
101
|
0
|
|
0
|
|
|
|
$join_key_field //= $join_schema->{'x-id-field'} // 'id'; |
|
|
|
0
|
|
|
|
|
102
|
0
|
|
|
|
|
|
push @{ $from }, [ -left => \("$join_schema_name AS $j"), "$j.$j", $join_key_field ]; |
|
0
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
push @cols, map { [ "${j}.$_", "${j}_$_" ] } keys %{ $join_props }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
elsif ( exists $self->schema->{ $j } ) { |
106
|
0
|
|
|
|
|
|
my $join_schema_name = $j; |
107
|
0
|
|
|
|
|
|
my $join_schema = $self->schema->{ $j }; |
108
|
0
|
|
|
|
|
|
my $join_props = $join_schema->{properties}; |
109
|
|
|
|
|
|
|
# First try to find the foreign key on the local schema |
110
|
0
|
0
|
0
|
|
|
|
if ( my ( $join_prop_name ) = grep { ($props{ $_ }{ 'x-foreign-key' }//'') =~ /^$join_schema_name(\.|$)/ } keys %props ) { |
|
0
|
0
|
|
|
|
|
|
111
|
0
|
|
|
|
|
|
my $join_prop = $props{ $join_prop_name }; |
112
|
0
|
|
|
|
|
|
my ( undef, $join_key_field ) = split /\./, $join_prop->{'x-foreign-key'}; |
113
|
0
|
|
0
|
|
|
|
$join_key_field //= $join_schema->{'x-id-field'} // 'id'; |
|
|
|
0
|
|
|
|
|
114
|
0
|
|
|
|
|
|
push @{ $from }, [ -left => $join_schema_name, $join_key_field, $join_prop_name ]; |
|
0
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
push @cols, map { [ "$join_schema_name.$_", "${j}_$_" ] } keys %{ $join_props }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
# Otherwise, try to find the foreign key on the foreign schema |
118
|
0
|
|
0
|
|
|
|
elsif ( ( $join_prop_name ) = grep { ($join_props->{ $_ }{ 'x-foreign-key' }//'') =~ /^$schema_name(\.|$)/ } keys %$join_props ) { |
119
|
0
|
|
|
|
|
|
my $join_prop = $join_props->{ $join_prop_name }; |
120
|
0
|
|
|
|
|
|
my $join_key_field; |
121
|
0
|
0
|
|
|
|
|
if ( $join_prop->{'x-foreign-key'} =~ /\.(.+)$/ ) { |
122
|
0
|
|
|
|
|
|
$join_key_field = $1; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
else { |
125
|
0
|
|
0
|
|
|
|
$join_key_field = $schema->{'x-id-field'} // 'id'; |
126
|
|
|
|
|
|
|
} |
127
|
0
|
|
|
|
|
|
push @{ $from }, [ -left => $join_schema_name, $join_key_field, $join_prop_name ]; |
|
0
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
push @cols, map { [ "$join_schema_name.$_", "${j}_$_" ] } keys %{ $join_props }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
else { |
131
|
0
|
|
|
|
|
|
die "Could not join $schema_name to $j: No x-foreign-key property found"; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
else { |
135
|
0
|
|
|
|
|
|
die "Could not join $schema_name to $j: No x-foreign-key property found"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
|
|
|
return $from, \@cols, $where; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub _expand_join { |
143
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $res, $joins ) = @_; |
144
|
0
|
0
|
|
|
|
|
my @joins = ref $joins eq 'ARRAY' ? @$joins : ( $joins ); |
145
|
0
|
|
|
|
|
|
my $id_field = $self->id_field( $schema_name ); |
146
|
0
|
|
|
|
|
|
my %props = %{ $self->schema->{ $schema_name }{properties} }; |
|
0
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
my ( @rows, %rows ); |
148
|
0
|
|
|
|
|
|
while ( my $r = $res->hash ) { |
149
|
0
|
|
|
|
|
|
my $row = $rows{ $r->{$id_field} }; |
150
|
0
|
0
|
|
|
|
|
if ( !$row ) { |
151
|
0
|
|
|
|
|
|
$row = $r; |
152
|
0
|
|
|
|
|
|
push @rows, $row; |
153
|
0
|
|
|
|
|
|
$rows{ $r->{ $id_field } } = $row; |
154
|
|
|
|
|
|
|
# First instance of the row fills in all one-to-one |
155
|
|
|
|
|
|
|
# relationships |
156
|
0
|
|
|
|
|
|
for my $j ( @joins ) { |
157
|
0
|
0
|
0
|
|
|
|
my $j_id = $self->schema->{ $j } ? ($self->schema->{$j}{'x-id-field'}//'id') : $j; |
158
|
|
|
|
|
|
|
# If the ID field isn't defined, then there was no row |
159
|
|
|
|
|
|
|
# to join. So just remove the columns for the join |
160
|
0
|
0
|
|
|
|
|
if ( !defined $row->{ "${j}_${j_id}" } ) { |
161
|
|
|
|
|
|
|
%$row = ( |
162
|
|
|
|
|
|
|
# Keys not in the join |
163
|
0
|
|
|
|
|
|
( map { $_ => $row->{$_} } grep !/^${j}_/, keys %$row ), |
164
|
|
|
|
|
|
|
# Empty array, if needed |
165
|
0
|
|
|
|
|
|
( $j => [] )x!!$self->schema->{ $j }, |
166
|
|
|
|
|
|
|
); |
167
|
0
|
|
|
|
|
|
next; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
%$row = ( |
170
|
|
|
|
|
|
|
# Keys not in the join |
171
|
0
|
|
|
|
|
|
( map { $_ => $row->{$_} } grep !/^${j}_/, keys %$row ), |
172
|
|
|
|
|
|
|
# Keys in the join |
173
|
|
|
|
|
|
|
$j => exists $props{ $j } |
174
|
|
|
|
|
|
|
# One-to-one relationship |
175
|
0
|
|
|
|
|
|
? { map { s/^${j}_//r => $row->{$_} } grep /^${j}_/, keys %$row } |
176
|
|
|
|
|
|
|
# One-to-many relationship |
177
|
0
|
0
|
|
|
|
|
: [{ map { s/^${j}_//r => $row->{$_} } grep /^${j}_/, keys %$row }] |
|
0
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
); |
179
|
|
|
|
|
|
|
} |
180
|
0
|
|
|
|
|
|
next; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
# Subsequent rows add to one-to-many relationship |
183
|
0
|
|
|
|
|
|
for my $j ( grep !exists $props{ $_ }, @joins ) { |
184
|
0
|
|
0
|
|
|
|
my $j_id = $self->schema->{$j}{'x-id-field'}//'id'; |
185
|
|
|
|
|
|
|
# If the ID field isn't defined, then there was no row |
186
|
|
|
|
|
|
|
# to join. So just skip this. |
187
|
0
|
0
|
|
|
|
|
next if !defined $r->{ "${j}_${j_id}" }; |
188
|
0
|
|
|
|
|
|
push @{ $row->{ $j } }, { map { s/^${j}_//r => $r->{$_} } grep /^${j}_/, keys %$r }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
0
|
0
|
|
|
|
|
return wantarray ? @rows : $rows[-1]; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub get { |
195
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id, %opt ) = @_; |
196
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
197
|
0
|
|
|
|
|
|
my ( $from, $cols, $where ) = $self->_sql_select( $schema_name, \%where, \%opt ); |
198
|
0
|
|
|
|
|
|
my ( $sql, @params ) = $self->driver->abstract->select( $from, $cols, $where ); |
199
|
0
|
|
|
|
|
|
my $res = $self->driver->db->query( $sql, @params ); |
200
|
0
|
0
|
|
|
|
|
my $row = $opt{join} ? $self->_expand_join( $schema_name, $res, $opt{join} ) : $res->hash; |
201
|
0
|
0
|
|
|
|
|
return $row if !$row; |
202
|
0
|
|
|
|
|
|
return $self->normalize( $schema_name, $row ); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub get_p { |
206
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id, %opt ) = @_; |
207
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
208
|
0
|
|
|
|
|
|
my ( $from, $cols, $where ) = $self->_sql_select( $schema_name, \%where, \%opt ); |
209
|
0
|
|
|
|
|
|
my ( $sql, @params ) = $self->driver->abstract->select( $from, $cols, $where ); |
210
|
0
|
|
|
|
|
|
my $p = $self->driver->db->query_p( $sql, @params ); |
211
|
|
|
|
|
|
|
return $p->then( sub { |
212
|
0
|
|
|
0
|
|
|
my ( $res ) = @_; |
213
|
0
|
0
|
|
|
|
|
my $row = $opt{join} ? $self->_expand_join( $schema_name, $res, $opt{join} ) : $res->hash; |
214
|
0
|
|
|
|
|
|
return $self->normalize( $schema_name, $row ); |
215
|
0
|
|
|
|
|
|
}); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub list { |
219
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $params, @opt ) = @_; |
220
|
0
|
0
|
|
|
|
|
my $opt = @opt % 2 == 0 ? {@opt} : $opt[0]; |
221
|
0
|
|
0
|
|
|
|
$params ||= {}; $opt ||= {}; |
|
0
|
|
0
|
|
|
|
|
222
|
0
|
|
|
|
|
|
my $driver = $self->driver; |
223
|
0
|
|
|
|
|
|
my ( $query, $total_query, @params ) = $self->list_sqls( $schema_name, $params, $opt ); |
224
|
0
|
|
|
|
|
|
my $res = $driver->db->query( $query, @params ); |
225
|
0
|
0
|
|
|
|
|
my @items = $opt->{join} ? $self->_expand_join( $schema_name, $res, $opt->{join} ) : @{$res->hashes}; |
|
0
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
return { |
227
|
|
|
|
|
|
|
items => [ map $self->normalize( $schema_name, $_ ), @items ], |
228
|
|
|
|
|
|
|
total => $driver->db->query( $total_query, @params )->hash->{total}, |
229
|
0
|
|
|
|
|
|
}; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub create_p { |
233
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $params ) = @_; |
234
|
0
|
|
|
|
|
|
$params = $self->normalize( $schema_name, $params ); |
235
|
0
|
|
|
|
|
|
my $id_field = $self->id_field( $schema_name ); |
236
|
|
|
|
|
|
|
# For databases that do not have a 'RETURNING' syntax, we must pass in all |
237
|
|
|
|
|
|
|
# parts of a composite key. In the future, we could add a surrogate |
238
|
|
|
|
|
|
|
# key which is auto-increment that could be used to find the |
239
|
|
|
|
|
|
|
# newly-created row so that we can return the correct key fields |
240
|
|
|
|
|
|
|
# here. For now, assume id field is correct if passed, created |
241
|
|
|
|
|
|
|
# otherwise. |
242
|
|
|
|
|
|
|
die "Missing composite ID parts: " . join( ', ', grep !exists $params->{$_}, @$id_field ) |
243
|
0
|
0
|
0
|
|
|
|
if ref $id_field eq 'ARRAY' && @$id_field > grep exists $params->{$_}, @$id_field; |
244
|
|
|
|
|
|
|
return $self->driver->db->insert_p( $schema_name, $params ) |
245
|
|
|
|
|
|
|
->then( sub { |
246
|
0
|
|
|
0
|
|
|
my $inserted_id = shift->last_insert_id; |
247
|
|
|
|
|
|
|
return ref $id_field eq 'ARRAY' |
248
|
0
|
|
0
|
|
|
|
? { map { $_ => $params->{$_} // $inserted_id } @$id_field } |
249
|
0
|
0
|
0
|
|
|
|
: $params->{ $id_field } // $inserted_id |
250
|
|
|
|
|
|
|
; |
251
|
0
|
|
|
|
|
|
} ); |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub delete_p { |
255
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id ) = @_; |
256
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
257
|
|
|
|
|
|
|
$self->driver->db->delete_p( $schema_name, \%where ) |
258
|
0
|
|
|
0
|
|
|
->catch(sub { croak "Error on delete '$schema_name'=$id: $_[0]" }) |
259
|
0
|
|
|
0
|
|
|
->then(sub { !!shift->rows } ); |
|
0
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub set_p { |
263
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $id, $params ) = @_; |
264
|
0
|
|
|
|
|
|
$params = $self->normalize( $schema_name, $params ); |
265
|
0
|
|
|
|
|
|
my %where = $self->id_where( $schema_name, $id ); |
266
|
|
|
|
|
|
|
$self->driver->db->update_p( $schema_name, $params, \%where ) |
267
|
0
|
|
|
0
|
|
|
->catch(sub { croak "Error on set '$schema_name'=$id: $_[0]" }) |
268
|
0
|
|
|
0
|
|
|
->then(sub { !!shift->rows } ); |
|
0
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# XXX: If needed, this can be broken out into its own role based on |
272
|
|
|
|
|
|
|
# SQL::Abstract. |
273
|
|
|
|
|
|
|
sub list_sqls { |
274
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $where, $opt ) = @_; |
275
|
0
|
|
|
|
|
|
my $schema = $self->schema->{ $schema_name }; |
276
|
0
|
|
0
|
|
|
|
my $id_field = $schema->{'x-id-field'} // 'id'; |
277
|
0
|
|
0
|
|
|
|
my $real_schema_name = ( $schema->{'x-view'} || {} )->{schema} // $schema_name; |
|
|
|
0
|
|
|
|
|
278
|
0
|
|
|
|
|
|
my $sqla = $self->sql_abstract; |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
|
( my $from, my $cols, $where ) = $self->_sql_select( $schema_name, $where, $opt ); |
281
|
|
|
|
|
|
|
#; use Data::Dumper; |
282
|
|
|
|
|
|
|
#; say "From: " . Dumper( $from ) . " Cols: " . Dumper( $cols ) . " Where: " . Dumper( $where ); |
283
|
|
|
|
|
|
|
my ( $query, @params ) = $sqla->select( |
284
|
|
|
|
|
|
|
$from, $cols, $where, |
285
|
|
|
|
|
|
|
{ |
286
|
|
|
|
|
|
|
order_by => $opt->{order_by}, |
287
|
|
|
|
|
|
|
}, |
288
|
0
|
|
|
|
|
|
); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# XXX: SQL::Abstract::mysql destroys the $from joined table arrays |
291
|
0
|
|
|
|
|
|
( $from, $cols, $where ) = $self->_sql_select( $schema_name, $where, $opt ); |
292
|
|
|
|
|
|
|
my ( $total_query, @total_params ) = $sqla->select( |
293
|
|
|
|
|
|
|
$from, |
294
|
0
|
0
|
0
|
|
|
|
[ grep { !ref && ( /^$schema_name\./ || !/\./ ) } @$cols ], |
|
0
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
$where, |
296
|
|
|
|
|
|
|
); |
297
|
0
|
|
|
|
|
|
$total_query =~ s/SELECT/SELECT DISTINCT/i; |
298
|
0
|
|
|
|
|
|
$total_query = 'SELECT COUNT(*) AS total FROM (' . $total_query . ') total_query'; |
299
|
|
|
|
|
|
|
|
300
|
0
|
0
|
|
|
|
|
if ( scalar grep defined, @{ $opt }{qw( limit offset )} ) { |
|
0
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# XXX: SQL::Abstract now handles this, so we should move this. |
302
|
0
|
0
|
0
|
|
|
|
die "Limit must be number" if $opt->{limit} && !looks_like_number $opt->{limit}; |
303
|
0
|
|
0
|
|
|
|
$query .= ' LIMIT ' . ( $opt->{limit} // 2**32 ); |
304
|
0
|
0
|
|
|
|
|
if ( $opt->{offset} ) { |
305
|
0
|
0
|
|
|
|
|
die "Offset must be number" if !looks_like_number $opt->{offset}; |
306
|
0
|
|
|
|
|
|
$query .= ' OFFSET ' . $opt->{offset}; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
#; say $query; |
310
|
|
|
|
|
|
|
#; say $total_query; |
311
|
0
|
|
|
|
|
|
return ( $query, $total_query, @params ); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub list_p { |
315
|
0
|
|
|
0
|
|
|
my ( $self, $schema_name, $params, @opt ) = @_; |
316
|
0
|
0
|
|
|
|
|
my $opt = @opt % 2 == 0 ? {@opt} : $opt[0]; |
317
|
0
|
|
0
|
|
|
|
$params ||= {}; |
318
|
0
|
|
|
|
|
|
my $driver = $self->driver; |
319
|
0
|
|
|
|
|
|
my ( $query, $total_query, @params ) = $self->list_sqls( $schema_name, $params, $opt ); |
320
|
|
|
|
|
|
|
$driver->db->query_p( $query, @params )->then( |
321
|
|
|
|
|
|
|
sub { |
322
|
0
|
|
|
0
|
|
|
my ( $res ) = @_; |
323
|
0
|
|
|
|
|
|
my $items = $res->hashes; |
324
|
|
|
|
|
|
|
return { |
325
|
|
|
|
|
|
|
items => [ map $self->normalize( $schema_name, $_ ), @$items ], |
326
|
|
|
|
|
|
|
total => $driver->db->query( $total_query, @params )->hash->{total}, |
327
|
0
|
|
|
|
|
|
}; |
328
|
|
|
|
|
|
|
}, |
329
|
0
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
sub query { |
333
|
0
|
|
|
0
|
|
|
my ( $self, @params ) = @_; |
334
|
0
|
|
|
|
|
|
return $self->driver->db->query( @params )->hashes->each; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub query_p { |
338
|
0
|
|
|
0
|
|
|
my ( $self, @params ) = @_; |
339
|
0
|
|
|
0
|
|
|
return $self->driver->db->query_p( @params )->then( sub { my ( $res ) = @_; return $res->hashes->each } ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
1; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
__END__ |