Profile of lib/Test/PONAPI/Repository/MockDB.pm

← 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
Statements | Executed 14711333 statements in 77.0s

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
183655 | 1 | 1 | 17.5s | 69.0s | Test::PONAPI::Repository::MockDB::::_fetchall_relationshipsTest::PONAPI::Repository::MockDB::_fetchall_relationships
183655 | 1 | 1 | 12.3s | 361s | Test::PONAPI::Repository::MockDB::::_add_resource_relationshipsTest::PONAPI::Repository::MockDB::_add_resource_relationships
100001 | 1 | 1 | 11.4s | 501s | Test::PONAPI::Repository::MockDB::::_add_resourcesTest::PONAPI::Repository::MockDB::_add_resources
368116 | 3 | 1 | 7.83s | 53.6s | Test::PONAPI::Repository::MockDB::::_db_executeTest::PONAPI::Repository::MockDB::_db_execute
81060 | 1 | 1 | 5.18s | 68.4s | Test::PONAPI::Repository::MockDB::::_add_includedTest::PONAPI::Repository::MockDB::_add_included
158776 | 1 | 1 | 3.20s | 4.17s | Test::PONAPI::Repository::MockDB::::has_one_to_many_relationshipTest::PONAPI::Repository::MockDB::has_one_to_many_relationship
100001 | 2 | 2 | 2.97s | 513s | Test::PONAPI::Repository::MockDB::::retrieve_allTest::PONAPI::Repository::MockDB::retrieve_all
93936 | 2 | 2 | 1.19s | 1.55s | Test::PONAPI::Repository::MockDB::::has_relationshipTest::PONAPI::Repository::MockDB::has_relationship
130870 | 2 | 2 | 1.18s | 1.68s | Test::PONAPI::Repository::MockDB::::has_typeTest::PONAPI::Repository::MockDB::has_type
44255 | 2 | 1 | 1.03s | 1.17s | Test::PONAPI::Repository::MockDB::::type_has_fieldsTest::PONAPI::Repository::MockDB::type_has_fields
49756 | 1 | 1 | 848ms | 160s | Test::PONAPI::Repository::MockDB::::retrieveTest::PONAPI::Repository::MockDB::retrieve
1 | 1 | 1 | 5.58ms | 57.2ms | Test::PONAPI::Repository::MockDB::::BEGIN@12Test::PONAPI::Repository::MockDB::BEGIN@12
1 | 1 | 1 | 3.62ms | 15.9ms | Test::PONAPI::Repository::MockDB::::BEGIN@7Test::PONAPI::Repository::MockDB::BEGIN@7
1 | 1 | 1 | 677µs | 1.33ms | Test::PONAPI::Repository::MockDB::::BEGIN@8Test::PONAPI::Repository::MockDB::BEGIN@8
1 | 1 | 1 | 446µs | 15.4ms | Test::PONAPI::Repository::MockDB::::BEGIN@10Test::PONAPI::Repository::MockDB::BEGIN@10
1 | 1 | 1 | 313µs | 12.7ms | Test::PONAPI::Repository::MockDB::::BEGIN@13Test::PONAPI::Repository::MockDB::BEGIN@13
1 | 1 | 1 | 296µs | 13.6ms | Test::PONAPI::Repository::MockDB::::BEGIN@14Test::PONAPI::Repository::MockDB::BEGIN@14
1 | 1 | 1 | 45µs | 666ms | Test::PONAPI::Repository::MockDB::::BUILDTest::PONAPI::Repository::MockDB::BUILD
1 | 1 | 1 | 32µs | 469µs | Test::PONAPI::Repository::MockDB::::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37]Test::PONAPI::Repository::MockDB::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37]
1 | 1 | 1 | 19µs | 8.13ms | Test::PONAPI::Repository::MockDB::::BEGIN@4Test::PONAPI::Repository::MockDB::BEGIN@4
1 | 1 | 1 | 10µs | 110µs | Test::PONAPI::Repository::MockDB::::BEGIN@16Test::PONAPI::Repository::MockDB::BEGIN@16
1 | 1 | 1 | 9µs | 95µs | Test::PONAPI::Repository::MockDB::::BEGIN@798Test::PONAPI::Repository::MockDB::BEGIN@798
1 | 1 | 1 | 6µs | 6µs | Test::PONAPI::Repository::MockDB::::BEGIN@17Test::PONAPI::Repository::MockDB::BEGIN@17
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_add_pagination_linksTest::PONAPI::Repository::MockDB::_add_pagination_links
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_createTest::PONAPI::Repository::MockDB::_create
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_create_relationshipsTest::PONAPI::Repository::MockDB::_create_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_delete_relationshipsTest::PONAPI::Repository::MockDB::_delete_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_find_resource_relationshipsTest::PONAPI::Repository::MockDB::_find_resource_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_updateTest::PONAPI::Repository::MockDB::_update
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_update_relationshipsTest::PONAPI::Repository::MockDB::_update_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::_validate_pageTest::PONAPI::Repository::MockDB::_validate_page
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::createTest::PONAPI::Repository::MockDB::create
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::create_relationshipsTest::PONAPI::Repository::MockDB::create_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::deleteTest::PONAPI::Repository::MockDB::delete
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::delete_relationshipsTest::PONAPI::Repository::MockDB::delete_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::retrieve_by_relationshipTest::PONAPI::Repository::MockDB::retrieve_by_relationship
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::retrieve_relationshipsTest::PONAPI::Repository::MockDB::retrieve_relationships
0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::::updateTest::PONAPI::Repository::MockDB::update
0 | 0 | 0 | 0s | 0s | Test::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
2 |  |  |  |  | package Test::PONAPI::Repository::MockDB;
3 |  |  |  |  |
4 | 2 | 60µs | 2 | 16.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!
7 | 2 | 148µs | 1 | 15.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
8 | 2 | 136µs | 2 | 1.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 |  |  |  |  |
10 | 2 | 123µs | 1 | 15.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 |  |  |  |  |
12 | 2 | 158µs | 1 | 57.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
13 | 2 | 137µs | 1 | 12.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
14 | 2 | 138µs | 1 | 13.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 |  |  |  |  |
16 | 2 | 26µs | 2 | 210µ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
17 | 2 | 2.68ms | 1 | 6µ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 |  |  |  |  |
19 | 1 | 3µs | 1 | 4.35ms | with 'PONAPI::Repository'; # spent 4.35ms making 1 call to Moose::with
20 |  |  |  |  |
21 | 1 | 2µs | 1 | 2.52ms | has dbh => ( # spent 2.52ms making 1 call to Moose::has
22 |  |  |  |  | is => 'ro',
23 |  |  |  |  | isa => 'DBI::db',
24 |  |  |  |  | writer => '_set_dbh'
25 |  |  |  |  | );
26 |  |  |  |  |
27 |  |  |  |  | has 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 +{
33 | 1 | 29µs | 3 | 437µs | articles => Test::PONAPI::Repository::MockDB::Table::Articles->new, # spent 202µs making 1 call to Test::PONAPI::Repository::MockDB::Table::Articles::new # spent 128µs making 1 call to Test::PONAPI::Repository::MockDB::Table::Comments::new # spent 107µs making 1 call to Test::PONAPI::Repository::MockDB::Table::People::new
34 |  |  |  |  | people => Test::PONAPI::Repository::MockDB::Table::People->new,
35 |  |  |  |  | comments => Test::PONAPI::Repository::MockDB::Table::Comments->new,
36 |  |  |  |  | }
37 |  |  |  |  | }
38 | 1 | 6µs | 1 | 5.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 {
41 | 1 | 400ns |  |  | my ($self, $params) = @_;
42 | 1 | 3µs | 1 | 375µs | my $loader = Test::PONAPI::Repository::MockDB::Loader->new; # spent 375µs making 1 call to Test::PONAPI::Repository::MockDB::Loader::new
43 | 1 | 6µs | 1 | 666ms | $loader->load unless $params->{skip_data_load}; # spent 666ms making 1 call to Test::PONAPI::Repository::MockDB::Loader::load
44 | 1 | 15µs | 2 | 43µ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 {
48 | 130870 | 80.0ms |  |  | my ( $self, $type ) = @_;
49 | 130870 | 978ms | 130870 | 505ms | !! 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 {
53 | 93936 | 51.6ms |  |  | my ( $self, $type, $rel_name ) = @_;
54 | 93936 | 147ms | 93936 | 112ms | if ( my $table = $self->tables->{$type} ) { # spent 112ms making 93936 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
55 | 93936 | 239ms | 93936 | 253ms | my $relations = $table->RELATIONS; # spent 253ms making 93936 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 3µs/call
56 | 93936 | 534ms |  |  | 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 {
62 | 158776 | 109ms |  |  | my ( $self, $type, $rel_name ) = @_;
63 | 158776 | 334ms | 158776 | 305ms | if ( my $table = $self->tables->{$type} ) { # spent 305ms making 158776 calls to Test::PONAPI::Repository::MockDB::tables, avg 2µs/call
64 | 158776 | 302ms | 158776 | 251ms | my $relations = $table->RELATIONS; # spent 251ms making 158776 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 2µs/call
65 | 158776 | 77.0ms |  |  | return if !exists $relations->{ $rel_name };
66 | 158776 | 1.18s | 158776 | 421ms | 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 {
72 | 44255 | 25.0ms |  |  | my ($self, $type, $fields) = @_;
73 |  |  |  |  |
74 |  |  |  |  | # Check for invalid 'fields'
75 | 44255 | 69.7ms | 44255 | 55.6ms | my $table_obj = $self->tables->{$type}; # spent 55.6ms making 44255 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
76 | 44255 | 567ms | 44255 | 87.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 |  |  |  |  |
78 | 44255 | 208ms |  |  | return 1 unless grep !exists $columns{$_}, @$fields;
79 | 13386 | 80.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 {
83 | 100001 | 328ms |  |  | my ( $self, %args ) = @_;
84 | 100001 | 87.0ms |  |  | my $type = $args{type};
85 |  |  |  |  |
86 | 100001 | 55.6ms |  |  | $self->_validate_page($args{page}) if $args{page};
87 |  |  |  |  |
88 | 100001 | 695ms | 200002 | 8.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
89 | 100001 | 1.23s | 400004 | 502s | $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 {
93 | 49756 | 203ms |  |  | my ( $self, %args ) = @_;
94 | 49756 | 117ms |  |  | $args{filter}{id} = delete $args{id};
95 | 49756 | 509ms | 49756 | 159s | $self->retrieve_all(%args); # spent 159s making 49756 calls to Test::PONAPI::Repository::MockDB::retrieve_all, avg 3.20ms/call
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | sub 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 |  |  |  |  |
137 |  |  |  |  | sub 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 |  |  |  |  |
178 |  |  |  |  | sub 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 |  |  |  |  |
202 |  |  |  |  | sub _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 |  |  |  |  |
237 |  |  |  |  | sub _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 |  |  |  |  |
304 |  |  |  |  | sub 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 |  |  |  |  |
327 |  |  |  |  | sub 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 |  |  |  |  |
350 |  |  |  |  | sub _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 |  |  |  |  |
393 |  |  |  |  | sub _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 |  |  |  |  |
437 |  |  |  |  | sub 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 |  |  |  |  |
461 |  |  |  |  | sub 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 |  |  |  |  |
476 |  |  |  |  | sub 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 |  |  |  |  |
500 |  |  |  |  | sub _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 {
555 | 100001 | 286ms |  |  | my ( $self, %args ) = @_;
556 | 100001 | 176ms |  |  | my ( $doc, $stmt, $type ) =
557 |  |  |  |  | @args{qw< document stmt type >};
558 |  |  |  |  |
559 | 100001 | 269ms | 100001 | 20.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 |  |  |  |  |
561 | 100001 | 9.94s | 850968 | 11.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
562 | 183655 | 236ms |  |  | my $id = delete $row->{id};
563 | 183655 | 558ms | 183655 | 40.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
564 | 183655 | 1.37s | 468303 | 16.2s | $rec->add_attribute( $_ => $row->{$_} ) for keys %{$row}; # spent 16.2s making 468303 calls to PONAPI::Builder::Resource::add_attribute, avg 35µs/call
565 | 183655 | 375ms | 183655 | 43.2s | $rec->add_self_link; # spent 43.2s making 183655 calls to PONAPI::Builder::Resource::add_self_link, avg 235µs/call
566 |  |  |  |  |
567 | 183655 | 964ms | 183655 | 361s | $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(
571 | 100001 | 76.5ms |  |  | page => $args{page},
572 |  |  |  |  | rows => scalar $sth->rows,
573 |  |  |  |  | document => $doc,
574 |  |  |  |  | ) if $args{page};
575 |  |  |  |  |
576 | 100001 | 2.68s |  |  | return;
577 |  |  |  |  | }
578 |  |  |  |  |
579 |  |  |  |  | sub _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 |  |  |  |  |
608 |  |  |  |  | sub _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 {
626 | 183655 | 744ms |  |  | my ( $self, $rec, %args ) = @_;
627 | 183655 | 293ms | 183655 | 4.53s | my $doc = $rec->find_root; # spent 4.53s making 183655 calls to PONAPI::Builder::find_root, avg 25µs/call
628 | 183655 | 417ms | 183655 | 456ms | my $type = $rec->type; # spent 456ms making 183655 calls to PONAPI::Builder::Resource::type, avg 2µs/call
629 | 183655 | 93.3ms |  |  | my $fields = $args{fields};
630 | 183655 | 369ms |  |  | my %include = map { $_ => 1 } @{ $args{include} };
631 |  |  |  |  |
632 |  |  |  |  | # Do not add sort or page here -- those were for the primary resource
633 |  |  |  |  | # *only*.
634 | 183655 | 804ms | 367310 | 69.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 |  |  |  |  | );
640 | 183655 | 69.6ms |  |  | $rels or return;
641 |  |  |  |  |
642 | 183655 | 380ms |  |  | for my $r ( keys %$rels ) {
643 | 187055 | 100ms |  |  | my $relationship = $rels->{$r};
644 | 187055 | 87.5ms |  |  | @$relationship or next;
645 |  |  |  |  |
646 | 158776 | 138ms |  |  | my $rel_type = $relationship->[0]{type};
647 |  |  |  |  |
648 |  |  |  |  | # skipping the relationship if the type has an empty `fields` set
649 | 158776 | 110ms |  |  | next if exists $fields->{$rel_type} and !@{ $fields->{$rel_type} };
650 |  |  |  |  |
651 | 158776 | 432ms | 158776 | 4.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
652 | 158776 | 167ms |  |  | for ( @$relationship ) {
653 | 172883 | 1.08s | 518649 | 201s | $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
660 | 158776 | 2.09s | 324240 | 69.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 |  |  |  |  |
665 | 183655 | 1.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 {
669 | 81060 | 309ms |  |  | my ( $self, $type, $ids, %args ) = @_;
670 | 81060 | 122ms |  |  | my ( $doc, $filter, $fields ) = @args{qw< document filter fields >};
671 |  |  |  |  |
672 | 81060 | 70.5ms |  |  | $filter->{id} = $ids;
673 |  |  |  |  |
674 |  |  |  |  | # Do NOT add sort -- sort here was for the *main* resource!
675 | 81060 | 407ms | 162120 | 5.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 |  |  |  |  |
681 | 81060 | 155ms | 81060 | 10.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 |  |  |  |  |
683 | 81060 | 6.07s | 502956 | 5.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
684 | 86592 | 113ms |  |  | my $id = delete $inc->{id};
685 |  |  |  |  | $doc->add_included( type => $type, id => $id )
686 | 86592 | 646ms | 259776 | 43.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 |  |  |  |  |
691 |  |  |  |  | sub _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 {
703 | 183655 | 399ms |  |  | my ( $self, %args ) = @_;
704 | 183655 | 241ms |  |  | 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}
710 | 183655 | 433ms |  |  | ? map { $_ => 1 } @{ $args{fields}{$type} }
711 |  |  |  |  | : ();
712 |  |  |  |  |
713 | 183655 | 49.0ms |  |  | my %ret;
714 | 183655 | 34.5ms |  |  | my @errors;
715 |  |  |  |  |
716 | 183655 | 1.12s | 367310 | 984ms | 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.
719 | 250307 | 184ms |  |  | next if keys %type_fields > 0 and !exists $type_fields{$name};
720 |  |  |  |  |
721 | 187055 | 305ms | 187055 | 261ms | my $table_obj = $self->tables->{$type}; # spent 261ms making 187055 calls to Test::PONAPI::Repository::MockDB::tables, avg 1µs/call
722 | 187055 | 273ms | 187055 | 178ms | my $rel_table_obj = $table_obj->RELATIONS->{$name}; # spent 178ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::RELATIONS, avg 952ns/call
723 | 187055 | 428ms | 187055 | 516ms | my $rel_type = $rel_table_obj->TYPE; # spent 516ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::TYPE, avg 3µs/call
724 | 187055 | 299ms | 187055 | 364ms | my $rel_table = $rel_table_obj->TABLE; # spent 364ms making 187055 calls to Test::PONAPI::Repository::MockDB::Table::TABLE, avg 2µs/call
725 | 187055 | 340ms | 187055 | 434ms | 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
726 | 187055 | 443ms | 187055 | 482ms | 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 |  |  |  |  |
728 | 187055 | 945ms | 187055 | 10.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 |  |  |  |  |
735 | 187055 | 361ms | 187055 | 22.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} },
739 | 187055 | 6.66s | 935275 | 27.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 |  |  |  |  |
743 | 183655 | 1.22s |  |  | return \%ret;
744 |  |  |  |  | }
745 |  |  |  |  |
746 |  |  |  |  | # Might not be there?
747 | 1 | 500ns |  |  | my $sqlite_constraint_failed = do {
748 | 1 | 200ns |  |  | local $@;
749 | 2 | 12µs | 1 | 5µ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 {
752 | 368116 | 150ms |  |  | my ( $self, $stmt ) = @_;
753 |  |  |  |  |
754 | 368116 | 113ms |  |  | my ($sth, $ret, $failed, $e);
755 |  |  |  |  | {
756 | 736232 | 272ms |  |  | local $@;
757 |  |  |  |  | eval {
758 | 368116 | 4.90s | 1104348 | 65.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
759 | 368116 | 13.2s | 368116 | 11.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.
762 | 368116 | 90.4ms |  |  | die $DBI::errstr if !$ret;
763 | 368116 | 285ms |  |  | 1;
764 | 368116 | 352ms |  |  | } or do {
765 |  |  |  |  | $failed = 1;
766 |  |  |  |  | $e = $@ || 'Unknown error';
767 |  |  |  |  | };
768 |  |  |  |  | };
769 | 368116 | 101ms |  |  | 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 |  |  |  |  |
794 | 368116 | 1.86s |  |  | return $sth;
795 |  |  |  |  | }
796 |  |  |  |  |
797 | 1 | 5µs | 2 | 2.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
798 | 3 | 69µs | 2 | 180µ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__