← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:11 2016

Filename/home/mickey/git_tree/PONAPI/Server/lib/Test/PONAPI/Repository/MockDB.pm
StatementsExecuted 14711333 statements in 77.0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1836551117.5s69.0sTest::PONAPI::Repository::MockDB::::_fetchall_relationshipsTest::PONAPI::Repository::MockDB::_fetchall_relationships
1836551112.3s361sTest::PONAPI::Repository::MockDB::::_add_resource_relationshipsTest::PONAPI::Repository::MockDB::_add_resource_relationships
1000011111.4s501sTest::PONAPI::Repository::MockDB::::_add_resourcesTest::PONAPI::Repository::MockDB::_add_resources
368116317.83s53.6sTest::PONAPI::Repository::MockDB::::_db_executeTest::PONAPI::Repository::MockDB::_db_execute
81060115.18s68.4sTest::PONAPI::Repository::MockDB::::_add_includedTest::PONAPI::Repository::MockDB::_add_included
158776113.20s4.17sTest::PONAPI::Repository::MockDB::::has_one_to_many_relationshipTest::PONAPI::Repository::MockDB::has_one_to_many_relationship
100001222.97s513sTest::PONAPI::Repository::MockDB::::retrieve_allTest::PONAPI::Repository::MockDB::retrieve_all
93936221.19s1.55sTest::PONAPI::Repository::MockDB::::has_relationshipTest::PONAPI::Repository::MockDB::has_relationship
130870221.18s1.68sTest::PONAPI::Repository::MockDB::::has_typeTest::PONAPI::Repository::MockDB::has_type
44255211.03s1.17sTest::PONAPI::Repository::MockDB::::type_has_fieldsTest::PONAPI::Repository::MockDB::type_has_fields
4975611848ms160sTest::PONAPI::Repository::MockDB::::retrieveTest::PONAPI::Repository::MockDB::retrieve
1115.58ms57.2msTest::PONAPI::Repository::MockDB::::BEGIN@12Test::PONAPI::Repository::MockDB::BEGIN@12
1113.62ms15.9msTest::PONAPI::Repository::MockDB::::BEGIN@7Test::PONAPI::Repository::MockDB::BEGIN@7
111677µs1.33msTest::PONAPI::Repository::MockDB::::BEGIN@8Test::PONAPI::Repository::MockDB::BEGIN@8
111446µs15.4msTest::PONAPI::Repository::MockDB::::BEGIN@10Test::PONAPI::Repository::MockDB::BEGIN@10
111313µs12.7msTest::PONAPI::Repository::MockDB::::BEGIN@13Test::PONAPI::Repository::MockDB::BEGIN@13
111296µs13.6msTest::PONAPI::Repository::MockDB::::BEGIN@14Test::PONAPI::Repository::MockDB::BEGIN@14
11145µs666msTest::PONAPI::Repository::MockDB::::BUILDTest::PONAPI::Repository::MockDB::BUILD
11132µs469µsTest::PONAPI::Repository::MockDB::::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37]Test::PONAPI::Repository::MockDB::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37]
11119µs8.13msTest::PONAPI::Repository::MockDB::::BEGIN@4Test::PONAPI::Repository::MockDB::BEGIN@4
11110µs110µsTest::PONAPI::Repository::MockDB::::BEGIN@16Test::PONAPI::Repository::MockDB::BEGIN@16
1119µs95µsTest::PONAPI::Repository::MockDB::::BEGIN@798Test::PONAPI::Repository::MockDB::BEGIN@798
1116µs6µsTest::PONAPI::Repository::MockDB::::BEGIN@17Test::PONAPI::Repository::MockDB::BEGIN@17
0000s0sTest::PONAPI::Repository::MockDB::::_add_pagination_linksTest::PONAPI::Repository::MockDB::_add_pagination_links
0000s0sTest::PONAPI::Repository::MockDB::::_createTest::PONAPI::Repository::MockDB::_create
0000s0sTest::PONAPI::Repository::MockDB::::_create_relationshipsTest::PONAPI::Repository::MockDB::_create_relationships
0000s0sTest::PONAPI::Repository::MockDB::::_delete_relationshipsTest::PONAPI::Repository::MockDB::_delete_relationships
0000s0sTest::PONAPI::Repository::MockDB::::_find_resource_relationshipsTest::PONAPI::Repository::MockDB::_find_resource_relationships
0000s0sTest::PONAPI::Repository::MockDB::::_updateTest::PONAPI::Repository::MockDB::_update
0000s0sTest::PONAPI::Repository::MockDB::::_update_relationshipsTest::PONAPI::Repository::MockDB::_update_relationships
0000s0sTest::PONAPI::Repository::MockDB::::_validate_pageTest::PONAPI::Repository::MockDB::_validate_page
0000s0sTest::PONAPI::Repository::MockDB::::createTest::PONAPI::Repository::MockDB::create
0000s0sTest::PONAPI::Repository::MockDB::::create_relationshipsTest::PONAPI::Repository::MockDB::create_relationships
0000s0sTest::PONAPI::Repository::MockDB::::deleteTest::PONAPI::Repository::MockDB::delete
0000s0sTest::PONAPI::Repository::MockDB::::delete_relationshipsTest::PONAPI::Repository::MockDB::delete_relationships
0000s0sTest::PONAPI::Repository::MockDB::::retrieve_by_relationshipTest::PONAPI::Repository::MockDB::retrieve_by_relationship
0000s0sTest::PONAPI::Repository::MockDB::::retrieve_relationshipsTest::PONAPI::Repository::MockDB::retrieve_relationships
0000s0sTest::PONAPI::Repository::MockDB::::updateTest::PONAPI::Repository::MockDB::update
0000s0sTest::PONAPI::Repository::MockDB::::update_relationshipsTest::PONAPI::Repository::MockDB::update_relationships
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# ABSTRACT: mock repository class
2package Test::PONAPI::Repository::MockDB;
3
4260µs216.2ms
# spent 8.13ms (19µs+8.11) within Test::PONAPI::Repository::MockDB::BEGIN@4 which was called: # once (19µs+8.11ms) by Module::Runtime::require_module at line 4
use Moose;
# spent 8.13ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@4 # spent 8.11ms making 1 call to Moose::import
5
6# We MUST use DBD::SQLite before ::Constants to get anything useful!
72148µs115.9ms
# spent 15.9ms (3.62+12.3) within Test::PONAPI::Repository::MockDB::BEGIN@7 which was called: # once (3.62ms+12.3ms) by Module::Runtime::require_module at line 7
use DBD::SQLite;
# spent 15.9ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@7
82136µs21.82ms
# spent 1.33ms (677µs+652µs) within Test::PONAPI::Repository::MockDB::BEGIN@8 which was called: # once (677µs+652µs) by Module::Runtime::require_module at line 8
use DBD::SQLite::Constants qw/:result_codes/;
# spent 1.33ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@8 # spent 492µs making 1 call to Exporter::import
9
102123µs115.4ms
# spent 15.4ms (446µs+15.0) within Test::PONAPI::Repository::MockDB::BEGIN@10 which was called: # once (446µs+15.0ms) by Module::Runtime::require_module at line 10
use Test::PONAPI::Repository::MockDB::Loader;
# spent 15.4ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@10
11
122158µs157.2ms
# spent 57.2ms (5.58+51.6) within Test::PONAPI::Repository::MockDB::BEGIN@12 which was called: # once (5.58ms+51.6ms) by Module::Runtime::require_module at line 12
use Test::PONAPI::Repository::MockDB::Table::Articles;
# spent 57.2ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@12
132137µs112.7ms
# spent 12.7ms (313µs+12.4) within Test::PONAPI::Repository::MockDB::BEGIN@13 which was called: # once (313µs+12.4ms) by Module::Runtime::require_module at line 13
use Test::PONAPI::Repository::MockDB::Table::People;
# spent 12.7ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@13
142138µs113.6ms
# spent 13.6ms (296µs+13.3) within Test::PONAPI::Repository::MockDB::BEGIN@14 which was called: # once (296µs+13.3ms) by Module::Runtime::require_module at line 14
use Test::PONAPI::Repository::MockDB::Table::Comments;
# spent 13.6ms making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@14
15
16226µs2210µs
# spent 110µs (10+100) within Test::PONAPI::Repository::MockDB::BEGIN@16 which was called: # once (10µs+100µs) by Module::Runtime::require_module at line 16
use PONAPI::Constants;
# spent 110µs making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@16 # spent 100µs making 1 call to Exporter::import
1722.68ms16µs
# spent 6µs within Test::PONAPI::Repository::MockDB::BEGIN@17 which was called: # once (6µs+0s) by Module::Runtime::require_module at line 17
use PONAPI::Exception;
# spent 6µs making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@17
18
1913µs14.35mswith 'PONAPI::Repository';
# spent 4.35ms making 1 call to Moose::with
20
2112µs12.52mshas dbh => (
# spent 2.52ms making 1 call to Moose::has
22 is => 'ro',
23 isa => 'DBI::db',
24 writer => '_set_dbh'
25);
26
27has tables => (
28 is => 'ro',
29 isa => 'HashRef',
30 lazy => 1,
31
# spent 469µs (32+437) within Test::PONAPI::Repository::MockDB::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37] which was called: # once (32µs+437µs) by Test::PONAPI::Repository::MockDB::tables at line 12 of (eval 45)[Eval/Closure.pm:144]
default => sub {
32 return +{
33129µs3437µs articles => Test::PONAPI::Repository::MockDB::Table::Articles->new,
34 people => Test::PONAPI::Repository::MockDB::Table::People->new,
35 comments => Test::PONAPI::Repository::MockDB::Table::Comments->new,
36 }
37 }
3816µs15.72ms);
# spent 5.72ms making 1 call to Moose::has
39
40
# spent 666ms (45µs+666) within Test::PONAPI::Repository::MockDB::BUILD which was called: # once (45µs+666ms) by Test::PONAPI::Repository::MockDB::new at line 51 of (eval 45)[Eval/Closure.pm:144]
sub BUILD {
411400ns my ($self, $params) = @_;
4213µs1375µs my $loader = Test::PONAPI::Repository::MockDB::Loader->new;
# spent 375µs making 1 call to Test::PONAPI::Repository::MockDB::Loader::new
4316µs1666ms $loader->load unless $params->{skip_data_load};
# spent 666ms making 1 call to Test::PONAPI::Repository::MockDB::Loader::load
44115µs243µs $self->_set_dbh( $loader->dbh );
# spent 35µs making 1 call to Test::PONAPI::Repository::MockDB::_set_dbh # spent 8µs making 1 call to Test::PONAPI::Repository::MockDB::Loader::dbh
45}
46
47
# spent 1.68s (1.18+505ms) within Test::PONAPI::Repository::MockDB::has_type which was called 130870 times, avg 13µs/call: # 100001 times (1.02s+465ms) by PONAPI::DAO::Request::BUILD at line 111 of lib/PONAPI/DAO/Request.pm, avg 15µs/call # 30869 times (158ms+40.7ms) by PONAPI::DAO::Request::Role::HasFields::_validate_fields at line 26 of lib/PONAPI/DAO/Request/Role/HasFields.pm, avg 6µs/call
sub has_type {
4813087080.0ms my ( $self, $type ) = @_;
49130870978ms130870505ms !! exists $self->tables->{$type};
# spent 505ms making 130870 calls to Test::PONAPI::Repository::MockDB::tables, avg 4µs/call
50}
51
52
# spent 1.55s (1.19+364ms) within Test::PONAPI::Repository::MockDB::has_relationship which was called 93936 times, avg 17µs/call: # 50100 times (748ms+271ms) by PONAPI::DAO::Request::Role::HasInclude::_validate_include at line 27 of lib/PONAPI/DAO/Request/Role/HasInclude.pm, avg 20µs/call # 43836 times (439ms+92.7ms) by PONAPI::DAO::Request::Role::HasFields::_validate_fields at line 43 of lib/PONAPI/DAO/Request/Role/HasFields.pm, avg 12µs/call
sub has_relationship {
539393651.6ms my ( $self, $type, $rel_name ) = @_;
5493936147ms93936112ms if ( my $table = $self->tables->{$type} ) {
# spent 112ms making 93936 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
5593936239ms93936253ms my $relations = $table->RELATIONS;
# spent 253ms making 93936 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 3µs/call
5693936534ms return !! exists $relations->{ $rel_name };
57 }
58 return 0;
59}
60
61
# spent 4.17s (3.20+978ms) within Test::PONAPI::Repository::MockDB::has_one_to_many_relationship which was called 158776 times, avg 26µs/call: # 158776 times (3.20s+978ms) by Test::PONAPI::Repository::MockDB::_add_resource_relationships at line 651, avg 26µs/call
sub has_one_to_many_relationship {
62158776109ms my ( $self, $type, $rel_name ) = @_;
63158776334ms158776305ms if ( my $table = $self->tables->{$type} ) {
# spent 305ms making 158776 calls to Test::PONAPI::Repository::MockDB::tables, avg 2µs/call
64158776302ms158776251ms my $relations = $table->RELATIONS;
# spent 251ms making 158776 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 2µs/call
6515877677.0ms return if !exists $relations->{ $rel_name };
661587761.18s158776421ms return !$relations->{ $rel_name }->ONE_TO_ONE;
# spent 421ms making 158776 calls to Test::PONAPI::Repository::MockDB::Table::Relationships::ONE_TO_ONE, avg 3µs/call
67 }
68 return;
69}
70
71
# spent 1.17s (1.03+143ms) within Test::PONAPI::Repository::MockDB::type_has_fields which was called 44255 times, avg 26µs/call: # 30869 times (822ms+116ms) by PONAPI::DAO::Request::Role::HasFields::_validate_fields at line 33 of lib/PONAPI/DAO/Request/Role/HasFields.pm, avg 30µs/call # 13386 times (207ms+26.3ms) by PONAPI::DAO::Request::Role::HasFields::_validate_fields at line 52 of lib/PONAPI/DAO/Request/Role/HasFields.pm, avg 17µs/call
sub type_has_fields {
724425525.0ms my ($self, $type, $fields) = @_;
73
74 # Check for invalid 'fields'
754425569.7ms4425555.6ms my $table_obj = $self->tables->{$type};
# spent 55.6ms making 44255 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
7644255567ms4425587.1ms my %columns = map +($_=>1), @{ $table_obj->COLUMNS };
# spent 64.6ms making 21859 calls to Test::PONAPI::Repository::MockDB::Table::COLUMNS, avg 3µs/call # spent 22.5ms making 22396 calls to Test::PONAPI::Repository::MockDB::Table::Articles::COLUMNS, avg 1µs/call
77
7844255208ms return 1 unless grep !exists $columns{$_}, @$fields;
791338680.0ms return;
80}
81
82
# spent 513s (2.97+510) within Test::PONAPI::Repository::MockDB::retrieve_all which was called 100001 times, avg 5.13ms/call: # 50245 times (1.53s+352s) by PONAPI::DAO::Request::RetrieveAll::execute at line 20 of lib/PONAPI/DAO/Request/RetrieveAll.pm, avg 7.04ms/call # 49756 times (1.44s+158s) by Test::PONAPI::Repository::MockDB::retrieve at line 95, avg 3.20ms/call
sub retrieve_all {
83100001328ms my ( $self, %args ) = @_;
8410000187.0ms my $type = $args{type};
85
8610000155.6ms $self->_validate_page($args{page}) if $args{page};
87
88100001695ms2000028.82s my $stmt = $self->tables->{$type}->select_stmt(%args);
# spent 8.64s making 100001 calls to Test::PONAPI::Repository::MockDB::Table::select_stmt, avg 86µs/call # spent 175ms making 100001 calls to Test::PONAPI::Repository::MockDB::tables, avg 2µs/call
891000011.23s400004502s $self->_add_resources( stmt => $stmt, %args );
# spent 501s making 100001 calls to Test::PONAPI::Repository::MockDB::_add_resources, avg 5.01ms/call # spent 498ms making 200002 calls to DBI::common::DESTROY, avg 2µs/call # spent 159ms making 100001 calls to DBD::_mem::common::DESTROY, avg 2µs/call
90}
91
92
# spent 160s (848ms+159) within Test::PONAPI::Repository::MockDB::retrieve which was called 49756 times, avg 3.22ms/call: # 49756 times (848ms+159s) by PONAPI::DAO::Request::Retrieve::execute at line 21 of lib/PONAPI/DAO/Request/Retrieve.pm, avg 3.22ms/call
sub retrieve {
9349756203ms my ( $self, %args ) = @_;
9449756117ms $args{filter}{id} = delete $args{id};
9549756509ms49756159s $self->retrieve_all(%args);
# spent 159s making 49756 calls to Test::PONAPI::Repository::MockDB::retrieve_all, avg 3.20ms/call
96}
97
98sub retrieve_relationships {
99 my ( $self, %args ) = @_;
100 my ($type, $rel_type, $doc) = @args{qw/type rel_type document/};
101
102 my $page = $args{page};
103 $self->_validate_page($page) if $page;
104
105 my $sort = $args{sort} || [];
106 if ( @$sort ) {
107 PONAPI::Exception->throw(
108 message => "You can only sort by id in retrieve_relationships"
109 ) if @$sort > 1 || $sort->[0] !~ /\A(-)?id\z/;
110
111 my $desc = !!$1;
112
113 my $table_obj = $self->tables->{$type};
114 my $relation_obj = $table_obj->RELATIONS->{$rel_type};
115 my $id_column = $relation_obj->REL_ID_COLUMN;
116
117 @$sort = ($desc ? '-' : '') . $id_column;
118 }
119
120 my $rels = $self->_find_resource_relationships(
121 %args,
122 # No need to fetch other relationship types
123 fields => { $type => [ $rel_type ] },
124 );
125
126 return unless @{ $rels || [] };
127
128 $doc->add_resource( %$_ ) for @$rels;
129
130 $self->_add_pagination_links(
131 page => $page,
132 document => $doc,
133 ) if $page;
134
135}
136
137sub retrieve_by_relationship {
138 my ( $self, %args ) = @_;
139 my ( $doc, $type, $rel_type, $fields, $include ) = @args{qw< document type rel_type fields include >};
140
141 my $sort = delete $args{sort} || [];
142 my $page = delete $args{page};
143 $self->_validate_page($page) if $page;
144
145 # We need to avoid passing sort and page here, since sort
146 # will have columns for the actual data, not the relationship
147 # table, and page needs to happen after sorting
148 my $rels = $self->_find_resource_relationships(
149 %args,
150 # No need to fetch other relationship types
151 fields => { $type => [ $rel_type ] },
152 );
153
154 return unless @$rels;
155
156 my $q_type = $rels->[0]{type};
157 my $q_ids = [ map { $_->{id} } @{$rels} ];
158
159 my $stmt = $self->tables->{$q_type}->select_stmt(
160 type => $q_type,
161 fields => $fields,
162 filter => { id => $q_ids },
163 sort => $sort,
164 page => $page,
165 );
166
167 $self->_add_resources(
168 document => $doc,
169 stmt => $stmt,
170 type => $q_type,
171 fields => $fields,
172 include => $include,
173 page => $page,
174 sort => $sort,
175 );
176}
177
178sub create {
179 my ( $self, %args ) = @_;
180
181 my $dbh = $self->dbh;
182 $dbh->begin_work;
183
184 my ($e, $failed);
185 {
186 local $@;
187 eval { $self->_create( %args ); 1; }
188 or do {
189 ($failed, $e) = (1, $@||'Unknown error');
190 };
191 }
192 if ( $failed ) {
193 $dbh->rollback;
194 die $e;
195 }
196
197 $dbh->commit;
198
199 return;
200}
201
202sub _create {
203 my ( $self, %args ) = @_;
204 my ( $doc, $type, $data ) = @args{qw< document type data >};
205
206 my $attributes = $data->{attributes} || {};
207 my $relationships = delete $data->{relationships} || {};
208
209 my $table_obj = $self->tables->{$type};
210 my ($stmt, $return, $extra) = $table_obj->insert_stmt(
211 table => $type,
212 values => $attributes,
213 );
214
215 $self->_db_execute( $stmt );
216
217 my $new_id = $self->dbh->last_insert_id("","","","");
218
219 foreach my $rel_type ( keys %$relationships ) {
220 my $rel_data = $relationships->{$rel_type};
221 $rel_data = [ $rel_data ] if ref($rel_data) ne 'ARRAY';
222 $self->_create_relationships(
223 %args,
224 id => $new_id,
225 rel_type => $rel_type,
226 data => $rel_data,
227 );
228 }
229
230 # Spec says we MUST return this, both here and in the Location header;
231 # the DAO takes care of the header, but we need to put it in the doc
232 $doc->add_resource( type => $type, id => $new_id );
233
234 return;
235}
236
237sub _create_relationships {
238 my ( $self, %args ) = @_;
239 my ( $type, $id, $rel_type, $data ) = @args{qw< type id rel_type data >};
240
241 my $table_obj = $self->tables->{$type};
242 my $relation_obj = $table_obj->RELATIONS->{$rel_type};
243
244 my $rel_table = $relation_obj->TABLE;
245 my $key_type = $relation_obj->TYPE;
246
247 my $id_column = $relation_obj->ID_COLUMN;
248 my $rel_id_column = $relation_obj->REL_ID_COLUMN;
249
250 my @all_values;
251 foreach my $orig ( @$data ) {
252 my $relationship = { %$orig };
253 my $data_type = delete $relationship->{type};
254
255 if ( $data_type ne $key_type ) {
256 PONAPI::Exception->throw(
257 message => "Data has type `$data_type`, but we were expecting `$key_type`",
258 bad_request_data => 1,
259 );
260 }
261
262 $relationship->{$id_column} = $id;
263 $relationship->{$rel_id_column} = delete $relationship->{id};
264
265 push @all_values, $relationship;
266 }
267
268 my $one_to_one = !$self->has_one_to_many_relationship($type, $rel_type);
269
270 foreach my $values ( @all_values ) {
271 my ($stmt, $return, $extra) = $relation_obj->insert_stmt(
272 table => $rel_table,
273 values => $values,
274 );
275
276 my ($failed, $e);
277 {
278 local $@;
279 eval { $self->_db_execute( $stmt ); 1; }
280 or do {
281 ($failed, $e) = (1, $@||'Unknown error');
282 };
283 }
284 if ( $failed ) {
285 if ( $one_to_one && do { local $@; eval { $e->sql_error } } ) {
286 # Can't quite do ::Upsert
287 $stmt = $relation_obj->update_stmt(
288 table => $rel_table,
289 values => [ %$values ],
290 where => { $id_column => $id },
291 driver => 'sqlite',
292 );
293 $self->_db_execute( $stmt );
294 }
295 else {
296 die $e;
297 }
298 };
299 }
300
301 return PONAPI_UPDATED_NORMAL;
302}
303
304sub create_relationships {
305 my ($self, %args) = @_;
306
307 my $dbh = $self->dbh;
308 $dbh->begin_work;
309
310 my ($ret, $e, $failed);
311 {
312 local $@;
313 eval { $ret = $self->_create_relationships( %args ); 1; }
314 or do {
315 ($failed, $e) = (1, $@||'Unknown error');
316 };
317 }
318 if ( $failed ) {
319 $dbh->rollback;
320 die $e;
321 }
322
323 $dbh->commit;
324 return $ret;
325}
326
327sub update {
328 my ( $self, %args ) = @_;
329
330 my $dbh = $self->dbh;
331 $dbh->begin_work;
332
333 my ($ret, $e, $failed);
334 {
335 local $@;
336 eval { $ret = $self->_update( %args ); 1 }
337 or do {
338 ($failed, $e) = (1, $@||'Unknown error');
339 };
340 }
341 if ( $failed ) {
342 $dbh->rollback;
343 die $e;
344 }
345
346 $dbh->commit;
347 return $ret;
348}
349
350sub _update {
351 my ( $self, %args ) = @_;
352 my ( $type, $id, $data ) = @args{qw< type id data >};
353 my ($attributes, $relationships) = map $_||{}, @{ $data }{qw/ attributes relationships /};
354
355 my $return = PONAPI_UPDATED_NORMAL;
356 if ( %$attributes ) {
357 my $table_obj = $self->tables->{$type};
358 # Per the spec, the api behaves *very* differently if ->update does extra things
359 # under the hood. Case point: the updated column in Articles
360 my ($stmt, $extra_return, $msg) = $table_obj->update_stmt(
361 table => $type,
362 where => { $table_obj->ID_COLUMN => $id },
363 values => $attributes,
364 );
365
366 $return = $extra_return if defined $extra_return;
367
368 my $sth = $self->_db_execute( $stmt );
369
370 # We had a successful update, but it updated nothing
371 if ( !$sth->rows ) {
372 $return = PONAPI_UPDATED_NOTHING;
373 }
374 }
375
376 foreach my $rel_type ( keys %$relationships ) {
377 my $update_rel_return = $self->_update_relationships(
378 type => $type,
379 id => $id,
380 rel_type => $rel_type,
381 data => $relationships->{$rel_type},
382 );
383
384 # We tried updating the attributes but
385 $return = $update_rel_return
386 if $return == PONAPI_UPDATED_NOTHING
387 && $update_rel_return != PONAPI_UPDATED_NOTHING;
388 }
389
390 return $return;
391}
392
393sub _update_relationships {
394 my ($self, %args) = @_;
395 my ( $type, $id, $rel_type, $data ) = @args{qw< type id rel_type data >};
396
397 my $table_obj = $self->tables->{$type};
398 my $relation_obj = $table_obj->RELATIONS->{$rel_type};
399
400 my $column_rel_type = $relation_obj->TYPE;
401 my $rel_table = $relation_obj->TABLE;
402
403 my $id_column = $relation_obj->ID_COLUMN;
404 my $rel_id_column = $relation_obj->REL_ID_COLUMN;
405
406 # Let's have an arrayref
407 $data = $data
408 ? ref($data) eq 'HASH' ? [ keys(%$data) ? $data : () ] : $data
409 : [];
410
411 # Let's start by clearing all relationships; this way
412 # we can implement the SQL below without adding special cases
413 # for ON DUPLICATE KEY UPDATE and sosuch.
414 my $stmt = $relation_obj->delete_stmt(
415 table => $rel_table,
416 where => { $id_column => $id },
417 );
418 $self->_db_execute( $stmt );
419
420 my $return = PONAPI_UPDATED_NORMAL;
421 foreach my $insert ( @$data ) {
422 my ($stmt, $insert_return, $extra) = $table_obj->insert_stmt(
423 table => $rel_table,
424 values => {
425 $id_column => $id,
426 $rel_id_column => $insert->{id},
427 },
428 );
429 $self->_db_execute( $stmt );
430
431 $return = $insert_return if $insert_return;
432 }
433
434 return $return;
435}
436
437sub update_relationships {
438 my ( $self, %args ) = @_;
439
440 my $dbh = $self->dbh;
441 $dbh->begin_work;
442
443 my ($ret, $e, $failed);
444 {
445 local $@;
446 eval { $ret = $self->_update_relationships( %args ); 1 }
447 or do {
448 ($failed, $e) = (1, $@||'Unknown error');
449 };
450 }
451 if ( $failed ) {
452 $dbh->rollback;
453 die $e;
454 }
455
456 $dbh->commit;
457
458 return $ret;
459}
460
461sub delete : method {
462 my ( $self, %args ) = @_;
463 my ( $type, $id ) = @args{qw< type id >};
464
465 my $table_obj = $self->tables->{$type};
466 my $stmt = $table_obj->delete_stmt(
467 table => $type,
468 where => { id => $id },
469 );
470
471 my $sth = $self->_db_execute( $stmt );
472
473 return;
474}
475
476sub delete_relationships {
477 my ( $self, %args ) = @_;
478
479 my $dbh = $self->dbh;
480 $dbh->begin_work;
481
482 my ($ret, $e, $failed);
483 {
484 local $@;
485 eval { $ret = $self->_delete_relationships( %args ); 1 }
486 or do {
487 ($failed, $e) = (1, $@||'Unknown error');
488 };
489 }
490 if ( $failed ) {
491 $dbh->rollback;
492 die $e;
493 }
494
495 $dbh->commit;
496
497 return $ret;
498}
499
500sub _delete_relationships {
501 my ( $self, %args ) = @_;
502 my ( $type, $id, $rel_type, $data ) = @args{qw< type id rel_type data >};
503
504 my $table_obj = $self->tables->{$type};
505 my $relation_obj = $table_obj->RELATIONS->{$rel_type};
506
507 my $table = $relation_obj->TABLE;
508 my $key_type = $relation_obj->TYPE;
509
510 my $id_column = $relation_obj->ID_COLUMN;
511 my $rel_id_column = $relation_obj->REL_ID_COLUMN;
512
513 my @all_values;
514 foreach my $resource ( @$data ) {
515 my $data_type = $resource->{type};
516
517 if ( $data_type ne $key_type ) {
518 PONAPI::Exception->throw(
519 message => "Data has type `$data_type`, but we were expecting `$key_type`",
520 bad_request_data => 1,
521 );
522 }
523
524 my $delete_where = {
525 $id_column => $id,
526 $rel_id_column => $resource->{id},
527 };
528
529 push @all_values, $delete_where;
530 }
531
532 my $ret = PONAPI_UPDATED_NORMAL;
533
534 my $rows_modified = 0;
535 DELETE:
536 foreach my $where ( @all_values ) {
537 my $stmt = $relation_obj->delete_stmt(
538 table => $table,
539 where => $where,
540 );
541
542 my $sth = $self->_db_execute( $stmt );
543 $rows_modified += $sth->rows;
544 }
545
546 $ret = PONAPI_UPDATED_NOTHING if !$rows_modified;
547
548 return $ret;
549}
550
551
552## --------------------------------------------------------
553
554
# spent 501s (11.4+490) within Test::PONAPI::Repository::MockDB::_add_resources which was called 100001 times, avg 5.01ms/call: # 100001 times (11.4s+490s) by Test::PONAPI::Repository::MockDB::retrieve_all at line 89, avg 5.01ms/call
sub _add_resources {
555100001286ms my ( $self, %args ) = @_;
556100001176ms my ( $doc, $stmt, $type ) =
557 @args{qw< document stmt type >};
558
559100001269ms10000120.8s my $sth = $self->_db_execute( $stmt );
# spent 20.8s making 100001 calls to Test::PONAPI::Repository::MockDB::_db_execute, avg 208µs/call
560
5611000019.94s85096811.2s while ( my $row = $sth->fetchrow_hashref() ) {
# spent 7.86s making 283656 calls to DBI::st::fetchrow_hashref, avg 28µs/call # spent 2.10s making 283656 calls to DBI::st::fetch, avg 7µs/call # spent 1.23s making 283656 calls to DBI::common::FETCH, avg 4µs/call
562183655236ms my $id = delete $row->{id};
563183655558ms18365540.6s my $rec = $doc->add_resource( type => $type, id => $id );
# spent 40.6s making 183655 calls to PONAPI::Builder::Document::add_resource, avg 221µs/call
5641836551.37s46830316.2s $rec->add_attribute( $_ => $row->{$_} ) for keys %{$row};
# spent 16.2s making 468303 calls to PONAPI::Builder::Resource::add_attribute, avg 35µs/call
565183655375ms18365543.2s $rec->add_self_link;
# spent 43.2s making 183655 calls to PONAPI::Builder::Resource::add_self_link, avg 235µs/call
566
567183655964ms183655361s $self->_add_resource_relationships($rec, %args);
# spent 361s making 183655 calls to Test::PONAPI::Repository::MockDB::_add_resource_relationships, avg 1.96ms/call
568 }
569
570 $self->_add_pagination_links(
57110000176.5ms page => $args{page},
572 rows => scalar $sth->rows,
573 document => $doc,
574 ) if $args{page};
575
5761000012.68s return;
577}
578
579sub _add_pagination_links {
580 my ($self, %args) = @_;
581 my ($page, $rows_fetched, $document) = @args{qw/page rows document/};
582 $rows_fetched ||= -1;
583
584 my ($offset, $limit) = @{$page}{qw/offset limit/};
585
586 my %current = %$page;
587 my %first = ( %current, offset => 0, );
588 my (%previous, %next);
589
590 if ( ($offset - $limit) >= 0 ) {
591 %previous = %current;
592 $previous{offset} -= $current{limit};
593 }
594
595 if ( $rows_fetched >= $limit ) {
596 %next = %current;
597 $next{offset} += $limit;
598 }
599
600 $document->add_pagination_links(
601 first => \%first,
602 self => \%current,
603 prev => \%previous,
604 next => \%next,
605 );
606}
607
608sub _validate_page {
609 my ($self, $page) = @_;
610
611 exists $page->{limit}
612 or PONAPI::Exception->throw(message => "Limit missing for `page`");
613
614 $page->{limit} =~ /\A[0-9]+\z/
615 or PONAPI::Exception->throw(message => "Bad limit value ($page->{limit}) in `page`");
616
617 !exists $page->{offset} || ($page->{offset} =~ /\A[0-9]+\z/)
618 or PONAPI::Exception->throw(message => "Bad offset value in `page`");
619
620 $page->{offset} ||= 0;
621
622 return;
623}
624
625
# spent 361s (12.3+348) within Test::PONAPI::Repository::MockDB::_add_resource_relationships which was called 183655 times, avg 1.96ms/call: # 183655 times (12.3s+348s) by Test::PONAPI::Repository::MockDB::_add_resources at line 567, avg 1.96ms/call
sub _add_resource_relationships {
626183655744ms my ( $self, $rec, %args ) = @_;
627183655293ms1836554.53s my $doc = $rec->find_root;
# spent 4.53s making 183655 calls to PONAPI::Builder::find_root, avg 25µs/call
628183655417ms183655456ms my $type = $rec->type;
# spent 456ms making 183655 calls to PONAPI::Builder::Resource::type, avg 2µs/call
62918365593.3ms my $fields = $args{fields};
630183655369ms my %include = map { $_ => 1 } @{ $args{include} };
631
632 # Do not add sort or page here -- those were for the primary resource
633 # *only*.
634183655804ms36731069.4s my $rels = $self->_fetchall_relationships(
# spent 69.0s making 183655 calls to Test::PONAPI::Repository::MockDB::_fetchall_relationships, avg 375µs/call # spent 458ms making 183655 calls to PONAPI::Builder::Resource::id, avg 2µs/call
635 type => $type,
636 id => $rec->id,
637 document => $doc,
638 fields => $fields,
639 );
64018365569.6ms $rels or return;
641
642183655380ms for my $r ( keys %$rels ) {
643187055100ms my $relationship = $rels->{$r};
64418705587.5ms @$relationship or next;
645
646158776138ms my $rel_type = $relationship->[0]{type};
647
648 # skipping the relationship if the type has an empty `fields` set
649158776110ms next if exists $fields->{$rel_type} and !@{ $fields->{$rel_type} };
650
651158776432ms1587764.17s my $one_to_many = $self->has_one_to_many_relationship($type, $r);
# spent 4.17s making 158776 calls to Test::PONAPI::Repository::MockDB::has_one_to_many_relationship, avg 26µs/call
652158776167ms for ( @$relationship ) {
6531728831.08s518649201s $rec->add_relationship( $r, $_, $one_to_many )
# spent 86.0s making 172883 calls to PONAPI::Builder::Relationship::add_self_link, avg 498µs/call # spent 60.9s making 172883 calls to PONAPI::Builder::Resource::add_relationship, avg 352µs/call # spent 53.9s making 172883 calls to PONAPI::Builder::Relationship::add_related_link, avg 312µs/call
654 ->add_self_link
655 ->add_related_link;
656 }
657
658 $self->_add_included(
659 $rel_type, # included type
6601587762.09s32424069.0s +[ map { $_->{id} } @$relationship ], # included ids
# spent 68.4s making 81060 calls to Test::PONAPI::Repository::MockDB::_add_included, avg 844µs/call # spent 450ms making 162120 calls to DBI::common::DESTROY, avg 3µs/call # spent 143ms making 81060 calls to DBD::_mem::common::DESTROY, avg 2µs/call
661 %args # filters / fields / etc.
662 ) if exists $include{$r};
663 }
664
6651836551.49s return;
666}
667
668
# spent 68.4s (5.18+63.2) within Test::PONAPI::Repository::MockDB::_add_included which was called 81060 times, avg 844µs/call: # 81060 times (5.18s+63.2s) by Test::PONAPI::Repository::MockDB::_add_resource_relationships at line 660, avg 844µs/call
sub _add_included {
66981060309ms my ( $self, $type, $ids, %args ) = @_;
67081060122ms my ( $doc, $filter, $fields ) = @args{qw< document filter fields >};
671
6728106070.5ms $filter->{id} = $ids;
673
674 # Do NOT add sort -- sort here was for the *main* resource!
67581060407ms1621205.20s my $stmt = $self->tables->{$type}->select_stmt(
# spent 4.99s making 81060 calls to Test::PONAPI::Repository::MockDB::Table::select_stmt, avg 62µs/call # spent 206ms making 81060 calls to Test::PONAPI::Repository::MockDB::tables, avg 3µs/call
676 type => $type,
677 filter => $filter,
678 fields => $fields,
679 );
680
68181060155ms8106010.3s my $sth = $self->_db_execute( $stmt );
# spent 10.3s making 81060 calls to Test::PONAPI::Repository::MockDB::_db_execute, avg 128µs/call
682
683810606.07s5029565.38s while ( my $inc = $sth->fetchrow_hashref() ) {
# spent 3.93s making 167652 calls to DBI::st::fetchrow_hashref, avg 23µs/call # spent 825ms making 167652 calls to DBI::st::fetch, avg 5µs/call # spent 630ms making 167652 calls to DBI::common::FETCH, avg 4µs/call
68486592113ms my $id = delete $inc->{id};
685 $doc->add_included( type => $type, id => $id )
68686592646ms25977643.7s ->add_attributes( %{$inc} )
# spent 17.3s making 86592 calls to PONAPI::Builder::Resource::add_self_link, avg 199µs/call # spent 15.1s making 86592 calls to PONAPI::Builder::Document::add_included, avg 175µs/call # spent 11.2s making 86592 calls to PONAPI::Builder::Resource::add_attributes, avg 130µs/call
687 ->add_self_link;
688 }
689}
690
691sub _find_resource_relationships {
692 my ( $self, %args ) = @_;
693 my $rel_type = $args{rel_type};
694
695 if ( $rel_type and my $rels = $self->_fetchall_relationships(%args) ) {
696 return $rels->{$rel_type} if exists $rels->{$rel_type};
697 }
698
699 return [];
700}
701
702
# spent 69.0s (17.5+51.4) within Test::PONAPI::Repository::MockDB::_fetchall_relationships which was called 183655 times, avg 375µs/call: # 183655 times (17.5s+51.4s) by Test::PONAPI::Repository::MockDB::_add_resource_relationships at line 634, avg 375µs/call
sub _fetchall_relationships {
703183655399ms my ( $self, %args ) = @_;
704183655241ms my ( $type, $id ) = @args{qw< type id >};
705
706 # we don't want to autovivify $args{fields}{$type}
707 # since it will be checked in order to know whether
708 # the key existed in the original fields argument
709 my %type_fields = exists $args{fields}{$type}
710183655433ms ? map { $_ => 1 } @{ $args{fields}{$type} }
711 : ();
712
71318365549.0ms my %ret;
71418365534.5ms my @errors;
715
7161836551.12s367310984ms for my $name ( keys %{ $self->tables->{$type}->RELATIONS } ) {
# spent 492ms making 183655 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 3µs/call # spent 492ms making 183655 calls to Test::PONAPI::Repository::MockDB::tables, avg 3µs/call
717 # If we have fields, and this relationship is not mentioned, skip
718 # it.
719250307184ms next if keys %type_fields > 0 and !exists $type_fields{$name};
720
721187055305ms187055261ms my $table_obj = $self->tables->{$type};
# spent 261ms making 187055 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
722187055273ms187055178ms my $rel_table_obj = $table_obj->RELATIONS->{$name};
# spent 178ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 952ns/call
723187055428ms187055516ms my $rel_type = $rel_table_obj->TYPE;
# spent 516ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::TYPE, avg 3µs/call
724187055299ms187055364ms my $rel_table = $rel_table_obj->TABLE;
# spent 364ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::TABLE, avg 2µs/call
725187055340ms187055434ms my $id_column = $rel_table_obj->ID_COLUMN;
# spent 434ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::ID_COLUMN, avg 2µs/call
726187055443ms187055482ms my $rel_id_column = $rel_table_obj->REL_ID_COLUMN;
# spent 482ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::Relationships::REL_ID_COLUMN, avg 3µs/call
727
728187055945ms18705510.9s my $stmt = $rel_table_obj->select_stmt(
# spent 10.9s making 187055 calls to Test::PONAPI::Repository::MockDB::Table::select_stmt, avg 58µs/call
729 %args,
730 type => $rel_table,
731 filter => { $id_column => $id },
732 fields => [ $rel_id_column ],
733 );
734
735187055361ms18705522.4s my $sth = $self->_db_execute( $stmt );
# spent 22.4s making 187055 calls to Test::PONAPI::Repository::MockDB::_db_execute, avg 120µs/call
736
737 $ret{$name} = +[
738 map +{ type => $rel_type, id => $_->{$rel_id_column} },
7391870556.66s93527527.4s @{ $sth->fetchall_arrayref({}) }
# spent 13.9s making 187055 calls to DBI::st::fetchall_arrayref, avg 74µs/call # spent 12.4s making 187055 calls to DBD::_::st::fetchall_arrayref, avg 66µs/call # spent 829ms making 374110 calls to DBI::common::DESTROY, avg 2µs/call # spent 269ms making 187055 calls to DBD::_mem::common::DESTROY, avg 1µs/call
740 ];
741 }
742
7431836551.22s return \%ret;
744}
745
746# Might not be there?
7471500nsmy $sqlite_constraint_failed = do {
7481200ns local $@;
749212µs15µs eval { SQLITE_CONSTRAINT() } // undef;
# spent 5µs making 1 call to DBD::SQLite::Constants::SQLITE_CONSTRAINT
750};
751
# spent 53.6s (7.83+45.7) within Test::PONAPI::Repository::MockDB::_db_execute which was called 368116 times, avg 145µs/call: # 187055 times (3.56s+18.8s) by Test::PONAPI::Repository::MockDB::_fetchall_relationships at line 735, avg 120µs/call # 100001 times (2.69s+18.1s) by Test::PONAPI::Repository::MockDB::_add_resources at line 559, avg 208µs/call # 81060 times (1.57s+8.78s) by Test::PONAPI::Repository::MockDB::_add_included at line 681, avg 128µs/call
sub _db_execute {
752368116150ms my ( $self, $stmt ) = @_;
753
754368116113ms my ($sth, $ret, $failed, $e);
755 {
756736232272ms local $@;
757 eval {
7583681164.90s110434865.3s $sth = $self->dbh->prepare($stmt->{sql});
# spent 33.9s making 368116 calls to DBI::db::prepare, avg 92µs/call # spent 30.6s making 368116 calls to DBD::SQLite::db::prepare, avg 83µs/call # spent 877ms making 368116 calls to Test::PONAPI::Repository::MockDB::dbh, avg 2µs/call
75936811613.2s36811611.0s $ret = $sth->execute(@{ $stmt->{bind} || [] });
# spent 11.0s making 368116 calls to DBI::st::execute, avg 30µs/call
760 # This should never happen, since the DB handle is
761 # created with RaiseError.
76236811690.4ms die $DBI::errstr if !$ret;
763368116285ms 1;
764368116352ms } or do {
765 $failed = 1;
766 $e = $@ || 'Unknown error';
767 };
768 };
769368116101ms if ( $failed ) {
770 my $errstr = $DBI::errstr || "Unknown SQL error";
771 my $err_id = $DBI::err || 0;
772
773 my $message;
774 if ( $sqlite_constraint_failed && $err_id && $err_id == $sqlite_constraint_failed ) {
775 PONAPI::Exception->throw(
776 message => "Table constraint failed: $errstr",
777 sql_error => 1,
778 status => 409,
779 );
780 }
781 elsif ( $err_id ) {
782 PONAPI::Exception->throw(
783 message => $errstr,
784 sql_error => 1,
785 );
786 }
787 else {
788 PONAPI::Exception->throw(
789 message => "Non-SQL error while running query? $e"
790 )
791 }
792 };
793
7943681161.86s return $sth;
795}
796
79715µs22.52ms__PACKAGE__->meta->make_immutable;
# spent 2.50ms making 1 call to Class::MOP::Class::make_immutable # spent 15µs making 1 call to Test::PONAPI::Repository::MockDB::meta
798369µs2180µs
# spent 95µs (9+85) within Test::PONAPI::Repository::MockDB::BEGIN@798 which was called: # once (9µs+85µs) by Module::Runtime::require_module at line 798
no Moose; 1;
# spent 95µs making 1 call to Test::PONAPI::Repository::MockDB::BEGIN@798 # spent 85µs making 1 call to Moose::unimport
799
800__END__