| Filename | /home/mickey/git_tree/PONAPI/Server/lib/Test/PONAPI/Repository/MockDB.pm |
| Statements | Executed 14711333 statements in 77.0s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 183655 | 1 | 1 | 17.5s | 69.0s | Test::PONAPI::Repository::MockDB::_fetchall_relationships |
| 183655 | 1 | 1 | 12.3s | 361s | Test::PONAPI::Repository::MockDB::_add_resource_relationships |
| 100001 | 1 | 1 | 11.4s | 501s | Test::PONAPI::Repository::MockDB::_add_resources |
| 368116 | 3 | 1 | 7.83s | 53.6s | Test::PONAPI::Repository::MockDB::_db_execute |
| 81060 | 1 | 1 | 5.18s | 68.4s | Test::PONAPI::Repository::MockDB::_add_included |
| 158776 | 1 | 1 | 3.20s | 4.17s | Test::PONAPI::Repository::MockDB::has_one_to_many_relationship |
| 100001 | 2 | 2 | 2.97s | 513s | Test::PONAPI::Repository::MockDB::retrieve_all |
| 93936 | 2 | 2 | 1.19s | 1.55s | Test::PONAPI::Repository::MockDB::has_relationship |
| 130870 | 2 | 2 | 1.18s | 1.68s | Test::PONAPI::Repository::MockDB::has_type |
| 44255 | 2 | 1 | 1.03s | 1.17s | Test::PONAPI::Repository::MockDB::type_has_fields |
| 49756 | 1 | 1 | 848ms | 160s | Test::PONAPI::Repository::MockDB::retrieve |
| 1 | 1 | 1 | 5.58ms | 57.2ms | Test::PONAPI::Repository::MockDB::BEGIN@12 |
| 1 | 1 | 1 | 3.62ms | 15.9ms | Test::PONAPI::Repository::MockDB::BEGIN@7 |
| 1 | 1 | 1 | 677µs | 1.33ms | Test::PONAPI::Repository::MockDB::BEGIN@8 |
| 1 | 1 | 1 | 446µs | 15.4ms | Test::PONAPI::Repository::MockDB::BEGIN@10 |
| 1 | 1 | 1 | 313µs | 12.7ms | Test::PONAPI::Repository::MockDB::BEGIN@13 |
| 1 | 1 | 1 | 296µs | 13.6ms | Test::PONAPI::Repository::MockDB::BEGIN@14 |
| 1 | 1 | 1 | 45µs | 666ms | Test::PONAPI::Repository::MockDB::BUILD |
| 1 | 1 | 1 | 32µs | 469µs | Test::PONAPI::Repository::MockDB::__ANON__[lib/Test/PONAPI/Repository/MockDB.pm:37] |
| 1 | 1 | 1 | 19µs | 8.13ms | Test::PONAPI::Repository::MockDB::BEGIN@4 |
| 1 | 1 | 1 | 10µs | 110µs | Test::PONAPI::Repository::MockDB::BEGIN@16 |
| 1 | 1 | 1 | 9µs | 95µs | Test::PONAPI::Repository::MockDB::BEGIN@798 |
| 1 | 1 | 1 | 6µs | 6µs | Test::PONAPI::Repository::MockDB::BEGIN@17 |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_add_pagination_links |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_create |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_create_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_delete_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_find_resource_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_update |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_update_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::_validate_page |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::create |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::create_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::delete |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::delete_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::retrieve_by_relationship |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::retrieve_relationships |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::update |
| 0 | 0 | 0 | 0s | 0s | Test::PONAPI::Repository::MockDB::update_relationships |
| 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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] | ||||
| 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] | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 # 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__ |