← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 13:50:58 2016
Reported on Fri Jan 8 13:51:28 2016

Filename/usr/share/perl5/DBIx/Class/ResultSource.pm
StatementsExecuted 332370 statements in 715ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
300011144ms612msDBIx::Class::ResultSource::::_minimal_valueset_satisfying_constraintDBIx::Class::ResultSource::_minimal_valueset_satisfying_constraint
615132132ms195msDBIx::Class::ResultSource::::columns_infoDBIx::Class::ResultSource::columns_info
60002260.5ms76.7msDBIx::Class::ResultSource::::unique_constraint_columnsDBIx::Class::ResultSource::unique_constraint_columns
30001156.2ms677msDBIx::Class::ResultSource::::resultsetDBIx::Class::ResultSource::resultset
60002250.6ms156msDBIx::Class::ResultSource::::storageDBIx::Class::ResultSource::storage
60013329.4ms29.4msDBIx::Class::ResultSource::::columnsDBIx::Class::ResultSource::columns
93483223.2ms23.2msDBIx::Class::ResultSource::::schemaDBIx::Class::ResultSource::schema
61702116.7ms16.8msDBIx::Class::ResultSource::::unique_constraintsDBIx::Class::ResultSource::unique_constraints
6963212.0ms12.0msDBIx::Class::ResultSource::::newDBIx::Class::ResultSource::new
1741111.6ms12.3msDBIx::Class::ResultSource::::add_columnsDBIx::Class::ResultSource::add_columns
170227.33ms8.47msDBIx::Class::ResultSource::::add_unique_constraintDBIx::Class::ResultSource::add_unique_constraint
1735226.56ms6.56msDBIx::Class::ResultSource::::column_infoDBIx::Class::ResultSource::column_info
319115.65ms6.62msDBIx::Class::ResultSource::::add_relationshipDBIx::Class::ResultSource::add_relationship
151112.35ms14.9msDBIx::Class::ResultSource::::set_primary_keyDBIx::Class::ResultSource::set_primary_key
632221.38ms1.38msDBIx::Class::ResultSource::::has_columnDBIx::Class::ResultSource::has_column
111858µs1.57msDBIx::Class::ResultSource::::BEGIN@9DBIx::Class::ResultSource::BEGIN@9
44122765µs765µsDBIx::Class::ResultSource::::relationship_infoDBIx::Class::ResultSource::relationship_info
17411588µs879µsDBIx::Class::ResultSource::::DESTROYDBIx::Class::ResultSource::DESTROY
11126µs39µsDBIx::Class::ResultSource::::BEGIN@14DBIx::Class::ResultSource::BEGIN@14
11125µs47µsDBIx::Class::ResultSource::::BEGIN@15DBIx::Class::ResultSource::BEGIN@15
11124µs36µsDBIx::Class::ResultSource::::BEGIN@16DBIx::Class::ResultSource::BEGIN@16
11118µs31µsDBIx::Class::ResultSource::::BEGIN@3DBIx::Class::ResultSource::BEGIN@3
21117µs43µsDBIx::Class::ResultSource::::_single_pri_col_or_dieDBIx::Class::ResultSource::_single_pri_col_or_die
11117µs27µsDBIx::Class::ResultSource::::BEGIN@4DBIx::Class::ResultSource::BEGIN@4
21116µs26µsDBIx::Class::ResultSource::::_pri_cols_or_dieDBIx::Class::ResultSource::_pri_cols_or_die
11112µs63µsDBIx::Class::ResultSource::::BEGIN@11DBIx::Class::ResultSource::BEGIN@11
11112µs5.32msDBIx::Class::ResultSource::::BEGIN@6DBIx::Class::ResultSource::BEGIN@6
11111µs27µsDBIx::Class::ResultSource::::BEGIN@13DBIx::Class::ResultSource::BEGIN@13
11110µs228µsDBIx::Class::ResultSource::::BEGIN@19DBIx::Class::ResultSource::BEGIN@19
11110µs38µsDBIx::Class::ResultSource::::BEGIN@12DBIx::Class::ResultSource::BEGIN@12
11110µs10µsDBIx::Class::ResultSource::::BEGIN@8DBIx::Class::ResultSource::BEGIN@8
2119µs10µsDBIx::Class::ResultSource::::primary_columnsDBIx::Class::ResultSource::primary_columns
1118µs39µsDBIx::Class::ResultSource::::BEGIN@17DBIx::Class::ResultSource::BEGIN@17
0000s0sDBIx::Class::ResultSource::::STORABLE_freezeDBIx::Class::ResultSource::STORABLE_freeze
0000s0sDBIx::Class::ResultSource::::STORABLE_thawDBIx::Class::ResultSource::STORABLE_thaw
0000s0sDBIx::Class::ResultSource::::__ANON__[:1128]DBIx::Class::ResultSource::__ANON__[:1128]
0000s0sDBIx::Class::ResultSource::::__ANON__[:1371]DBIx::Class::ResultSource::__ANON__[:1371]
0000s0sDBIx::Class::ResultSource::::__ANON__[:1377]DBIx::Class::ResultSource::__ANON__[:1377]
0000s0sDBIx::Class::ResultSource::::__ANON__[:1492]DBIx::Class::ResultSource::__ANON__[:1492]
0000s0sDBIx::Class::ResultSource::::__ANON__[:1707]DBIx::Class::ResultSource::__ANON__[:1707]
0000s0sDBIx::Class::ResultSource::::__ANON__[:2246]DBIx::Class::ResultSource::__ANON__[:2246]
0000s0sDBIx::Class::ResultSource::::__ANON__[:401]DBIx::Class::ResultSource::__ANON__[:401]
0000s0sDBIx::Class::ResultSource::::__ANON__[:419]DBIx::Class::ResultSource::__ANON__[:419]
0000s0sDBIx::Class::ResultSource::::__ANON__[:473]DBIx::Class::ResultSource::__ANON__[:473]
0000s0sDBIx::Class::ResultSource::::__ANON__[:479]DBIx::Class::ResultSource::__ANON__[:479]
0000s0sDBIx::Class::ResultSource::::__ANON__[:497]DBIx::Class::ResultSource::__ANON__[:497]
0000s0sDBIx::Class::ResultSource::::__ANON__[:800]DBIx::Class::ResultSource::__ANON__[:800]
0000s0sDBIx::Class::ResultSource::::__strip_relcondDBIx::Class::ResultSource::__strip_relcond
0000s0sDBIx::Class::ResultSource::::_compare_relationship_keysDBIx::Class::ResultSource::_compare_relationship_keys
0000s0sDBIx::Class::ResultSource::::_identifying_column_setDBIx::Class::ResultSource::_identifying_column_set
0000s0sDBIx::Class::ResultSource::::_invoke_sqlt_deploy_hookDBIx::Class::ResultSource::_invoke_sqlt_deploy_hook
0000s0sDBIx::Class::ResultSource::::_pk_depends_onDBIx::Class::ResultSource::_pk_depends_on
0000s0sDBIx::Class::ResultSource::::_resolve_conditionDBIx::Class::ResultSource::_resolve_condition
0000s0sDBIx::Class::ResultSource::::_resolve_joinDBIx::Class::ResultSource::_resolve_join
0000s0sDBIx::Class::ResultSource::::_resolve_relationship_conditionDBIx::Class::ResultSource::_resolve_relationship_condition
0000s0sDBIx::Class::ResultSource::::add_columnDBIx::Class::ResultSource::add_column
0000s0sDBIx::Class::ResultSource::::add_unique_constraintsDBIx::Class::ResultSource::add_unique_constraints
0000s0sDBIx::Class::ResultSource::::compare_relationship_keysDBIx::Class::ResultSource::compare_relationship_keys
0000s0sDBIx::Class::ResultSource::::default_sqlt_deploy_hookDBIx::Class::ResultSource::default_sqlt_deploy_hook
0000s0sDBIx::Class::ResultSource::::fromDBIx::Class::ResultSource::from
0000s0sDBIx::Class::ResultSource::::handleDBIx::Class::ResultSource::handle
0000s0sDBIx::Class::ResultSource::::has_relationshipDBIx::Class::ResultSource::has_relationship
0000s0sDBIx::Class::ResultSource::::name_unique_constraintDBIx::Class::ResultSource::name_unique_constraint
0000s0sDBIx::Class::ResultSource::::pk_depends_onDBIx::Class::ResultSource::pk_depends_on
0000s0sDBIx::Class::ResultSource::::related_classDBIx::Class::ResultSource::related_class
0000s0sDBIx::Class::ResultSource::::related_sourceDBIx::Class::ResultSource::related_source
0000s0sDBIx::Class::ResultSource::::relationshipsDBIx::Class::ResultSource::relationships
0000s0sDBIx::Class::ResultSource::::remove_columnDBIx::Class::ResultSource::remove_column
0000s0sDBIx::Class::ResultSource::::remove_columnsDBIx::Class::ResultSource::remove_columns
0000s0sDBIx::Class::ResultSource::::resolve_conditionDBIx::Class::ResultSource::resolve_condition
0000s0sDBIx::Class::ResultSource::::reverse_relationship_infoDBIx::Class::ResultSource::reverse_relationship_info
0000s0sDBIx::Class::ResultSource::::sequenceDBIx::Class::ResultSource::sequence
0000s0sDBIx::Class::ResultSource::::throw_exceptionDBIx::Class::ResultSource::throw_exception
0000s0sDBIx::Class::ResultSource::::try {...} DBIx::Class::ResultSource::try {...}
0000s0sDBIx::Class::ResultSource::::unique_constraint_namesDBIx::Class::ResultSource::unique_constraint_names
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DBIx::Class::ResultSource;
2
3246µs244µs
# spent 31µs (18+13) within DBIx::Class::ResultSource::BEGIN@3 which was called: # once (18µs+13µs) by Class::C3::Componentised::ensure_class_loaded at line 3
use strict;
# spent 31µs making 1 call to DBIx::Class::ResultSource::BEGIN@3 # spent 13µs making 1 call to strict::import
4252µs237µs
# spent 27µs (17+10) within DBIx::Class::ResultSource::BEGIN@4 which was called: # once (17µs+10µs) by Class::C3::Componentised::ensure_class_loaded at line 4
use warnings;
# spent 27µs making 1 call to DBIx::Class::ResultSource::BEGIN@4 # spent 10µs making 1 call to warnings::import
5
62207µs25.32ms
# spent 5.32ms (12µs+5.30) within DBIx::Class::ResultSource::BEGIN@6 which was called: # once (12µs+5.30ms) by Class::C3::Componentised::ensure_class_loaded at line 6
use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
# spent 5.32ms making 1 call to DBIx::Class::ResultSource::BEGIN@6 # spent 5.30ms making 1 call to base::import, recursion: max depth 1, sum of overlapping time 5.30ms
7
8228µs110µs
# spent 10µs within DBIx::Class::ResultSource::BEGIN@8 which was called: # once (10µs+0s) by Class::C3::Componentised::ensure_class_loaded at line 8
use DBIx::Class::ResultSet;
# spent 10µs making 1 call to DBIx::Class::ResultSource::BEGIN@8
92261µs11.57ms
# spent 1.57ms (858µs+708µs) within DBIx::Class::ResultSource::BEGIN@9 which was called: # once (858µs+708µs) by Class::C3::Componentised::ensure_class_loaded at line 9
use DBIx::Class::ResultSourceHandle;
# spent 1.57ms making 1 call to DBIx::Class::ResultSource::BEGIN@9
10
11234µs2113µs
# spent 63µs (12+51) within DBIx::Class::ResultSource::BEGIN@11 which was called: # once (12µs+51µs) by Class::C3::Componentised::ensure_class_loaded at line 11
use DBIx::Class::Carp;
# spent 63µs making 1 call to DBIx::Class::ResultSource::BEGIN@11 # spent 51µs making 1 call to DBIx::Class::Carp::import
12268µs267µs
# spent 38µs (10+29) within DBIx::Class::ResultSource::BEGIN@12 which was called: # once (10µs+29µs) by Class::C3::Componentised::ensure_class_loaded at line 12
use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
# spent 38µs making 1 call to DBIx::Class::ResultSource::BEGIN@12 # spent 29µs making 1 call to Exporter::import
13245µs243µs
# spent 27µs (11+16) within DBIx::Class::ResultSource::BEGIN@13 which was called: # once (11µs+16µs) by Class::C3::Componentised::ensure_class_loaded at line 13
use SQL::Abstract 'is_literal_value';
# spent 27µs making 1 call to DBIx::Class::ResultSource::BEGIN@13 # spent 16µs making 1 call to Exporter::import
14259µs252µs
# spent 39µs (26+13) within DBIx::Class::ResultSource::BEGIN@14 which was called: # once (26µs+13µs) by Class::C3::Componentised::ensure_class_loaded at line 14
use Devel::GlobalDestruction;
# spent 39µs making 1 call to DBIx::Class::ResultSource::BEGIN@14 # spent 13µs making 1 call to Sub::Exporter::Progressive::__ANON__
15270µs269µs
# spent 47µs (25+22) within DBIx::Class::ResultSource::BEGIN@15 which was called: # once (25µs+22µs) by Class::C3::Componentised::ensure_class_loaded at line 15
use Try::Tiny;
# spent 47µs making 1 call to DBIx::Class::ResultSource::BEGIN@15 # spent 22µs making 1 call to Exporter::import
16260µs247µs
# spent 36µs (24+12) within DBIx::Class::ResultSource::BEGIN@16 which was called: # once (24µs+12µs) by Class::C3::Componentised::ensure_class_loaded at line 16
use List::Util 'first';
# spent 36µs making 1 call to DBIx::Class::ResultSource::BEGIN@16 # spent 12µs making 1 call to List::Util::import
17259µs269µs
# spent 39µs (8+30) within DBIx::Class::ResultSource::BEGIN@17 which was called: # once (8µs+30µs) by Class::C3::Componentised::ensure_class_loaded at line 17
use Scalar::Util qw/blessed weaken isweak/;
# spent 39µs making 1 call to DBIx::Class::ResultSource::BEGIN@17 # spent 30µs making 1 call to Exporter::import
18
1927.58ms2446µs
# spent 228µs (10+218) within DBIx::Class::ResultSource::BEGIN@19 which was called: # once (10µs+218µs) by Class::C3::Componentised::ensure_class_loaded at line 19
use namespace::clean;
# spent 228µs making 1 call to DBIx::Class::ResultSource::BEGIN@19 # spent 218µs making 1 call to namespace::clean::import
20
21118µs1569µs__PACKAGE__->mk_group_accessors(simple => qw/
# spent 569µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
22 source_name name source_info
23 _ordered_columns _columns _primaries _unique_constraints
24 _relationships resultset_attributes
25 column_info_from_storage
26/);
27
2811µs1700µs__PACKAGE__->mk_group_accessors(component_class => qw/
# spent 700µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
29 resultset_class
30 result_class
31/);
32
3316µs1320µs__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
# spent 320µs making 1 call to DBIx::Class::mk_classdata
34
35=head1 NAME
36
37DBIx::Class::ResultSource - Result source object
38
39=head1 SYNOPSIS
40
41 # Create a table based result source, in a result class.
42
43 package MyApp::Schema::Result::Artist;
44 use base qw/DBIx::Class::Core/;
45
46 __PACKAGE__->table('artist');
47 __PACKAGE__->add_columns(qw/ artistid name /);
48 __PACKAGE__->set_primary_key('artistid');
49 __PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
50
51 1;
52
53 # Create a query (view) based result source, in a result class
54 package MyApp::Schema::Result::Year2000CDs;
55 use base qw/DBIx::Class::Core/;
56
57 __PACKAGE__->load_components('InflateColumn::DateTime');
58 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
59
60 __PACKAGE__->table('year2000cds');
61 __PACKAGE__->result_source_instance->is_virtual(1);
62 __PACKAGE__->result_source_instance->view_definition(
63 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
64 );
65
66
67=head1 DESCRIPTION
68
69A ResultSource is an object that represents a source of data for querying.
70
71This class is a base class for various specialised types of result
72sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
73default result source type, so one is created for you when defining a
74result class as described in the synopsis above.
75
76More specifically, the L<DBIx::Class::Core> base class pulls in the
77L<DBIx::Class::ResultSourceProxy::Table> component, which defines
78the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
79When called, C<table> creates and stores an instance of
80L<DBIx::Class::ResultSource::Table>. Luckily, to use tables as result
81sources, you don't need to remember any of this.
82
83Result sources representing select queries, or views, can also be
84created, see L<DBIx::Class::ResultSource::View> for full details.
85
86=head2 Finding result source objects
87
88As mentioned above, a result source instance is created and stored for
89you when you define a
90L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
91
92You can retrieve the result source at runtime in the following ways:
93
94=over
95
96=item From a Schema object:
97
98 $schema->source($source_name);
99
100=item From a Result object:
101
102 $result->result_source;
103
104=item From a ResultSet object:
105
106 $rs->result_source;
107
108=back
109
110=head1 METHODS
111
112=head2 new
113
114 $class->new();
115
116 $class->new({attribute_name => value});
117
118Creates a new ResultSource object. Not normally called directly by end users.
119
120=cut
121
122
# spent 12.0ms within DBIx::Class::ResultSource::new which was called 696 times, avg 17µs/call: # 348 times (6.02ms+0s) by DBIx::Class::Schema::_register_source at line 1354 of DBIx/Class/Schema.pm, avg 17µs/call # 174 times (3.36ms+0s) by DBIx::Class::Schema::_copy_state_from at line 1030 of DBIx/Class/Schema.pm, avg 19µs/call # 174 times (2.59ms+0s) by DBIx::Class::ResultSourceProxy::Table::table at line 91 of DBIx/Class/ResultSourceProxy/Table.pm, avg 15µs/call
sub new {
123696190µs my ($class, $attrs) = @_;
124696278µs $class = ref $class if ref $class;
125
1266963.26ms my $new = bless { %{$attrs || {}} }, $class;
1276961.24ms $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
128696788µs $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
1296961.27ms $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
1306962.77ms $new->{_columns} = { %{$new->{_columns}||{}} };
1316961.00ms $new->{_relationships} = { %{$new->{_relationships}||{}} };
132696166µs $new->{name} ||= "!!NAME NOT SET!!";
133696268µs $new->{_columns_info_loaded} ||= 0;
1346961.52ms return $new;
135}
136
137=pod
138
139=head2 add_columns
140
141=over
142
143=item Arguments: @columns
144
145=item Return Value: L<$result_source|/new>
146
147=back
148
149 $source->add_columns(qw/col1 col2 col3/);
150
151 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
152
153 $source->add_columns(
154 'col1' => { data_type => 'integer', is_nullable => 1, ... },
155 'col2' => { data_type => 'text', is_auto_increment => 1, ... },
156 );
157
158Adds columns to the result source. If supplied colname => hashref
159pairs, uses the hashref as the L</column_info> for that column. Repeated
160calls of this method will add more columns, not replace them.
161
162The column names given will be created as accessor methods on your
163L<Result|DBIx::Class::Manual::ResultClass> objects. You can change the name of the accessor
164by supplying an L</accessor> in the column_info hash.
165
166If a column name beginning with a plus sign ('+col1') is provided, the
167attributes provided will be merged with any existing attributes for the
168column, with the new attributes taking precedence in the case that an
169attribute already exists. Using this without a hashref
170(C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
171it does the same thing it would do without the plus.
172
173The contents of the column_info are not set in stone. The following
174keys are currently recognised/used by DBIx::Class:
175
176=over 4
177
178=item accessor
179
180 { accessor => '_name' }
181
182 # example use, replace standard accessor with one of your own:
183 sub name {
184 my ($self, $value) = @_;
185
186 die "Name cannot contain digits!" if($value =~ /\d/);
187 $self->_name($value);
188
189 return $self->_name();
190 }
191
192Use this to set the name of the accessor method for this column. If unset,
193the name of the column will be used.
194
195=item data_type
196
197 { data_type => 'integer' }
198
199This contains the column type. It is automatically filled if you use the
200L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
201L<DBIx::Class::Schema::Loader> module.
202
203Currently there is no standard set of values for the data_type. Use
204whatever your database supports.
205
206=item size
207
208 { size => 20 }
209
210The length of your column, if it is a column type that can have a size
211restriction. This is currently only used to create tables from your
212schema, see L<DBIx::Class::Schema/deploy>.
213
214=item is_nullable
215
216 { is_nullable => 1 }
217
218Set this to a true value for a column that is allowed to contain NULL
219values, default is false. This is currently only used to create tables
220from your schema, see L<DBIx::Class::Schema/deploy>.
221
222=item is_auto_increment
223
224 { is_auto_increment => 1 }
225
226Set this to a true value for a column whose value is somehow
227automatically set, defaults to false. This is used to determine which
228columns to empty when cloning objects using
229L<DBIx::Class::Row/copy>. It is also used by
230L<DBIx::Class::Schema/deploy>.
231
232=item is_numeric
233
234 { is_numeric => 1 }
235
236Set this to a true or false value (not C<undef>) to explicitly specify
237if this column contains numeric data. This controls how set_column
238decides whether to consider a column dirty after an update: if
239C<is_numeric> is true a numeric comparison C<< != >> will take place
240instead of the usual C<eq>
241
242If not specified the storage class will attempt to figure this out on
243first access to the column, based on the column C<data_type>. The
244result will be cached in this attribute.
245
246=item is_foreign_key
247
248 { is_foreign_key => 1 }
249
250Set this to a true value for a column that contains a key from a
251foreign table, defaults to false. This is currently only used to
252create tables from your schema, see L<DBIx::Class::Schema/deploy>.
253
254=item default_value
255
256 { default_value => \'now()' }
257
258Set this to the default value which will be inserted into a column by
259the database. Can contain either a value or a function (use a
260reference to a scalar e.g. C<\'now()'> if you want a function). This
261is currently only used to create tables from your schema, see
262L<DBIx::Class::Schema/deploy>.
263
264See the note on L<DBIx::Class::Row/new> for more information about possible
265issues related to db-side default values.
266
267=item sequence
268
269 { sequence => 'my_table_seq' }
270
271Set this on a primary key column to the name of the sequence used to
272generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
273will attempt to retrieve the name of the sequence from the database
274automatically.
275
276=item retrieve_on_insert
277
278 { retrieve_on_insert => 1 }
279
280For every column where this is set to true, DBIC will retrieve the RDBMS-side
281value upon a new row insertion (normally only the autoincrement PK is
282retrieved on insert). C<INSERT ... RETURNING> is used automatically if
283supported by the underlying storage, otherwise an extra SELECT statement is
284executed to retrieve the missing data.
285
286=item auto_nextval
287
288 { auto_nextval => 1 }
289
290Set this to a true value for a column whose value is retrieved automatically
291from a sequence or function (if supported by your Storage driver.) For a
292sequence, if you do not use a trigger to get the nextval, you have to set the
293L</sequence> value as well.
294
295Also set this for MSSQL columns with the 'uniqueidentifier'
296L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
297automatically generate using C<NEWID()>, unless they are a primary key in which
298case this will be done anyway.
299
300=item extra
301
302This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
303to add extra non-generic data to the column. For example: C<< extra
304=> { unsigned => 1} >> is used by the MySQL producer to set an integer
305column to unsigned. For more details, see
306L<SQL::Translator::Producer::MySQL>.
307
308=back
309
310=head2 add_column
311
312=over
313
314=item Arguments: $colname, \%columninfo?
315
316=item Return Value: 1/0 (true/false)
317
318=back
319
320 $source->add_column('col' => \%info);
321
322Add a single column and optional column info. Uses the same column
323info keys as L</add_columns>.
324
325=cut
326
327
# spent 12.3ms (11.6+754µs) within DBIx::Class::ResultSource::add_columns which was called 174 times, avg 71µs/call: # 174 times (11.6ms+754µs) by DBIx::Class::ResultSourceProxy::add_columns at line 30 of DBIx/Class/ResultSourceProxy.pm, avg 71µs/call
sub add_columns {
328174341µs my ($self, @cols) = @_;
329174218µs299µs $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
# spent 98µs making 1 call to DBIx::Class::ResultSource::_ordered_columns # spent 900ns making 1 call to DBIx::Class::ResultSource::Table::_ordered_columns
330
33117448µs my @added;
332174204µs297µs my $columns = $self->_columns;
# spent 96µs making 1 call to DBIx::Class::ResultSource::_columns # spent 1µs making 1 call to DBIx::Class::ResultSource::Table::_columns
333174831µs while (my $col = shift @cols) {
3341602446µs my $column_info = {};
33516022.94ms1602557µs if ($col =~ s/^\+//) {
# spent 557µs making 1602 calls to DBIx::Class::ResultSource::CORE:subst, avg 348ns/call
336 $column_info = $self->column_info($col);
337 }
338
339 # If next entry is { ... } use that for the column info, if not
340 # use an empty hashref
3411602748µs if (ref $cols[0]) {
3421602287µs my $new_info = shift(@cols);
34316023.09ms %$column_info = (%$column_info, %$new_info);
344 }
3451602687µs push(@added, $col) unless exists $columns->{$col};
34616021.51ms $columns->{$col} = $column_info;
347 }
348174396µs1700ns push @{ $self->_ordered_columns }, @added;
# spent 700ns making 1 call to DBIx::Class::ResultSource::Table::_ordered_columns
349174547µs return $self;
350}
351
352sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
353
354=head2 has_column
355
356=over
357
358=item Arguments: $colname
359
360=item Return Value: 1/0 (true/false)
361
362=back
363
364 if ($source->has_column($colname)) { ... }
365
366Returns true if the source has a column of this name, false otherwise.
367
368=cut
369
370
# spent 1.38ms (1.38+500ns) within DBIx::Class::ResultSource::has_column which was called 632 times, avg 2µs/call: # 419 times (883µs+0s) by DBIx::Class::ResultSourceProxy::has_column at line 18 of (eval 188)[Sub/Quote.pm:5], avg 2µs/call # 213 times (494µs+500ns) by DBIx::Class::ResultSource::add_unique_constraint at line 753, avg 2µs/call
sub has_column {
371632242µs my ($self, $column) = @_;
3726325.88ms1500ns return exists $self->_columns->{$column};
# spent 500ns making 1 call to DBIx::Class::ResultSource::Table::_columns
373}
374
375=head2 column_info
376
377=over
378
379=item Arguments: $colname
380
381=item Return Value: Hashref of info
382
383=back
384
385 my $info = $source->column_info($col);
386
387Returns the column metadata hashref for a column, as originally passed
388to L</add_columns>. See L</add_columns> above for information on the
389contents of the hashref.
390
391=cut
392
393
# spent 6.56ms (6.56+1µs) within DBIx::Class::ResultSource::column_info which was called 1735 times, avg 4µs/call: # 1602 times (6.18ms+1µs) by DBIx::Class::ResultSourceProxy::add_columns at line 35 of DBIx/Class/ResultSourceProxy.pm, avg 4µs/call # 133 times (383µs+0s) by DBIx::Class::ResultSourceProxy::column_info at line 18 of (eval 190)[Sub/Quote.pm:5], avg 3µs/call
sub column_info {
3941735754µs my ($self, $column) = @_;
39517351.68ms1400ns $self->throw_exception("No such column $column")
# spent 400ns making 1 call to DBIx::Class::ResultSource::Table::_columns
396 unless exists $self->_columns->{$column};
397
39817351.20ms1300ns if ( ! $self->_columns->{$column}{data_type}
# spent 300ns making 1 call to DBIx::Class::ResultSource::Table::_columns
399 and ! $self->{_columns_info_loaded}
400 and $self->column_info_from_storage
401 and my $stor = try { $self->storage } )
402 {
403 $self->{_columns_info_loaded}++;
404
405 # try for the case of storage without table
406 try {
407 my $info = $stor->columns_info_for( $self->from );
408 my $lc_info = { map
409 { (lc $_) => $info->{$_} }
410 ( keys %$info )
411 };
412
413 foreach my $col ( keys %{$self->_columns} ) {
414 $self->_columns->{$col} = {
415 %{ $self->_columns->{$col} },
416 %{ $info->{$col} || $lc_info->{lc $col} || {} }
417 };
418 }
419 };
420 }
421
42217353.72ms1400ns return $self->_columns->{$column};
# spent 400ns making 1 call to DBIx::Class::ResultSource::Table::_columns
423}
424
425=head2 columns
426
427=over
428
429=item Arguments: none
430
431=item Return Value: Ordered list of column names
432
433=back
434
435 my @column_names = $source->columns;
436
437Returns all column names in the order they were declared to L</add_columns>.
438
439=cut
440
441
# spent 29.4ms within DBIx::Class::ResultSource::columns which was called 6001 times, avg 5µs/call: # 3000 times (16.7ms+0s) by DBIx::Class::Storage::DBIHacks::_resolve_column_info at line 726 of DBIx/Class/Storage/DBIHacks.pm, avg 6µs/call # 3000 times (12.6ms+0s) by DBIx::Class::ResultSet::_resolved_attrs at line 3524 of DBIx/Class/ResultSet.pm, avg 4µs/call # once (4µs+0s) by DBIx::Class::ResultSourceProxy::columns at line 18 of (eval 519)[Sub/Quote.pm:5]
sub columns {
44290012.98ms my $self = shift;
44390013.08ms $self->throw_exception(
444 "columns() is a read-only accessor, did you mean add_columns()?"
445 ) if @_;
446900147.3ms return @{$self->{_ordered_columns}||[]};
447}
448
449=head2 columns_info
450
451=over
452
453=item Arguments: \@colnames ?
454
455=item Return Value: Hashref of column name/info pairs
456
457=back
458
459 my $columns_info = $source->columns_info;
460
461Like L</column_info> but returns information for the requested columns. If
462the optional column-list arrayref is omitted it returns info on all columns
463currently defined on the ResultSource via L</add_columns>.
464
465=cut
466
467
# spent 195ms (132+63.0) within DBIx::Class::ResultSource::columns_info which was called 6151 times, avg 32µs/call: # 3000 times (64.1ms+32.9ms) by DBIx::Class::ResultSource::_minimal_valueset_satisfying_constraint at line 1579, avg 32µs/call # 3000 times (65.3ms+29.0ms) by DBIx::Class::Storage::DBIHacks::_resolve_column_info at line 752 of DBIx/Class/Storage/DBIHacks.pm, avg 31µs/call # 151 times (2.49ms+1.01ms) by DBIx::Class::ResultSource::set_primary_key at line 606, avg 23µs/call
sub columns_info {
46861513.18ms my ($self, $columns) = @_;
469
470615110.2ms1900ns my $colinfo = $self->_columns;
# spent 900ns making 1 call to DBIx::Class::ResultSource::Table::_columns
471
472615136.3ms615163.0ms if (
# spent 63.0ms making 6151 calls to List::Util::first, avg 10µs/call
47312143682.6ms first { ! $_->{data_type} } values %$colinfo
474 and
475 ! $self->{_columns_info_loaded}
476 and
477 $self->column_info_from_storage
478 and
479 my $stor = try { $self->storage }
480 ) {
481 $self->{_columns_info_loaded}++;
482
483 # try for the case of storage without table
484 try {
485 my $info = $stor->columns_info_for( $self->from );
486 my $lc_info = { map
487 { (lc $_) => $info->{$_} }
488 ( keys %$info )
489 };
490
491 foreach my $col ( keys %$colinfo ) {
492 $colinfo->{$col} = {
493 %{ $colinfo->{$col} },
494 %{ $info->{$col} || $lc_info->{lc $col} || {} }
495 };
496 }
497 };
498 }
499
50061511.39ms my %ret;
501
50261516.30ms if ($columns) {
503151173µs for (@$columns) {
504184370µs if (my $inf = $colinfo->{$_}) {
505 $ret{$_} = $inf;
506 }
507 else {
508 $self->throw_exception( sprintf (
509 "No such column '%s' on source '%s'",
510 $_,
511 $self->source_name || $self->name || 'Unknown source...?',
512 ));
513 }
514 }
515 }
516 else {
517600043.2ms %ret = %$colinfo;
518 }
519
520615129.7ms return \%ret;
521}
522
523=head2 remove_columns
524
525=over
526
527=item Arguments: @colnames
528
529=item Return Value: not defined
530
531=back
532
533 $source->remove_columns(qw/col1 col2 col3/);
534
535Removes the given list of columns by name, from the result source.
536
537B<Warning>: Removing a column that is also used in the sources primary
538key, or in one of the sources unique constraints, B<will> result in a
539broken result source.
540
541=head2 remove_column
542
543=over
544
545=item Arguments: $colname
546
547=item Return Value: not defined
548
549=back
550
551 $source->remove_column('col');
552
553Remove a single column by name from the result source, similar to
554L</remove_columns>.
555
556B<Warning>: Removing a column that is also used in the sources primary
557key, or in one of the sources unique constraints, B<will> result in a
558broken result source.
559
560=cut
561
562sub remove_columns {
563 my ($self, @to_remove) = @_;
564
565 my $columns = $self->_columns
566 or return;
567
568 my %to_remove;
569 for (@to_remove) {
570 delete $columns->{$_};
571 ++$to_remove{$_};
572 }
573
574 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
575}
576
577sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
578
579=head2 set_primary_key
580
581=over 4
582
583=item Arguments: @cols
584
585=item Return Value: not defined
586
587=back
588
589Defines one or more columns as primary key for this source. Must be
590called after L</add_columns>.
591
592Additionally, defines a L<unique constraint|/add_unique_constraint>
593named C<primary>.
594
595Note: you normally do want to define a primary key on your sources
596B<even if the underlying database table does not have a primary key>.
597See
598L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
599for more info.
600
601=cut
602
603
# spent 14.9ms (2.35+12.6) within DBIx::Class::ResultSource::set_primary_key which was called 151 times, avg 99µs/call: # 151 times (2.35ms+12.6ms) by DBIx::Class::ResultSourceProxy::set_primary_key at line 18 of (eval 187)[Sub/Quote.pm:5], avg 99µs/call
sub set_primary_key {
604151155µs my ($self, @cols) = @_;
605
606151555µs1513.50ms my $colinfo = $self->columns_info(\@cols);
# spent 3.50ms making 151 calls to DBIx::Class::ResultSource::columns_info, avg 23µs/call
607151105µs for my $col (@cols) {
608184190µs carp_unique(sprintf (
609 "Primary key of source '%s' includes the column '%s' which has its "
610 . "'is_nullable' attribute set to true. This is a mistake and will cause "
611 . 'various Result-object operations to fail',
612 $self->source_name || $self->name || 'Unknown source...?',
613 $col,
614 )) if $colinfo->{$col}{is_nullable};
615 }
616
617151231µs2884µs $self->_primaries(\@cols);
# spent 882µs making 1 call to DBIx::Class::ResultSource::_primaries # spent 1µs making 1 call to DBIx::Class::ResultSource::Table::_primaries
618
619151894µs1518.19ms $self->add_unique_constraint(primary => \@cols);
# spent 8.19ms making 151 calls to DBIx::Class::ResultSource::add_unique_constraint, avg 54µs/call
620}
621
622=head2 primary_columns
623
624=over 4
625
626=item Arguments: none
627
628=item Return Value: Ordered list of primary column names
629
630=back
631
632Read-only accessor which returns the list of primary keys, supplied by
633L</set_primary_key>.
634
635=cut
636
637
# spent 10µs (9+1) within DBIx::Class::ResultSource::primary_columns which was called 2 times, avg 5µs/call: # 2 times (9µs+1µs) by DBIx::Class::ResultSource::_pri_cols_or_die at line 646, avg 5µs/call
sub primary_columns {
638214µs11µs return @{shift->_primaries||[]};
# spent 1µs making 1 call to DBIx::Class::ResultSource::Table::_primaries
639}
640
641# a helper method that will automatically die with a descriptive message if
642# no pk is defined on the source in question. For internal use to save
643# on if @pks... boilerplate
644
# spent 26µs (16+10) within DBIx::Class::ResultSource::_pri_cols_or_die which was called 2 times, avg 13µs/call: # 2 times (16µs+10µs) by DBIx::Class::ResultSource::_single_pri_col_or_die at line 659, avg 13µs/call
sub _pri_cols_or_die {
6452800ns my $self = shift;
64628µs210µs my @pcols = $self->primary_columns
# spent 10µs making 2 calls to DBIx::Class::ResultSource::primary_columns, avg 5µs/call
647 or $self->throw_exception (sprintf(
648 "Operation requires a primary key to be declared on '%s' via set_primary_key",
649 # source_name is set only after schema-registration
650 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
651 ));
65227µs return @pcols;
653}
654
655# same as above but mandating single-column PK (used by relationship condition
656# inference)
657
# spent 43µs (17+26) within DBIx::Class::ResultSource::_single_pri_col_or_die which was called 2 times, avg 21µs/call: # 2 times (17µs+26µs) by DBIx::Class::Relationship::BelongsTo::belongs_to at line 54 of DBIx/Class/Relationship/BelongsTo.pm, avg 21µs/call
sub _single_pri_col_or_die {
6582800ns my $self = shift;
65928µs226µs my ($pri, @too_many) = $self->_pri_cols_or_die;
# spent 26µs making 2 calls to DBIx::Class::ResultSource::_pri_cols_or_die, avg 13µs/call
660
6612900ns $self->throw_exception( sprintf(
662 "Operation requires a single-column primary key declared on '%s'",
663 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
664 )) if @too_many;
66526µs return $pri;
666}
667
668
669=head2 sequence
670
671Manually define the correct sequence for your table, to avoid the overhead
672associated with looking up the sequence automatically. The supplied sequence
673will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
674
675=over 4
676
677=item Arguments: $sequence_name
678
679=item Return Value: not defined
680
681=back
682
683=cut
684
685sub sequence {
686 my ($self,$seq) = @_;
687
688 my @pks = $self->primary_columns
689 or return;
690
691 $_->{sequence} = $seq
692 for values %{ $self->columns_info (\@pks) };
693}
694
695
696=head2 add_unique_constraint
697
698=over 4
699
700=item Arguments: $name?, \@colnames
701
702=item Return Value: not defined
703
704=back
705
706Declare a unique constraint on this source. Call once for each unique
707constraint.
708
709 # For UNIQUE (column1, column2)
710 __PACKAGE__->add_unique_constraint(
711 constraint_name => [ qw/column1 column2/ ],
712 );
713
714Alternatively, you can specify only the columns:
715
716 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
717
718This will result in a unique constraint named
719C<table_column1_column2>, where C<table> is replaced with the table
720name.
721
722Unique constraints are used, for example, when you pass the constraint
723name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
724only columns in the constraint are searched.
725
726Throws an error if any of the given column names do not yet exist on
727the result source.
728
729=cut
730
731
# spent 8.47ms (7.33+1.15) within DBIx::Class::ResultSource::add_unique_constraint which was called 170 times, avg 50µs/call: # 151 times (7.13ms+1.07ms) by DBIx::Class::ResultSource::set_primary_key at line 619, avg 54µs/call # 19 times (200µs+78µs) by DBIx::Class::ResultSourceProxy::add_unique_constraint at line 18 of (eval 246)[Sub/Quote.pm:5], avg 15µs/call
sub add_unique_constraint {
73217062µs my $self = shift;
733
73417089µs if (@_ > 2) {
735 $self->throw_exception(
736 'add_unique_constraint() does not accept multiple constraints, use '
737 . 'add_unique_constraints() instead'
738 );
739 }
740
74117057µs my $cols = pop @_;
742170112µs if (ref $cols ne 'ARRAY') {
743 $self->throw_exception (
744 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
745 );
746 }
747
74817068µs my $name = shift @_;
749
75017046µs $name ||= $self->name_unique_constraint($cols);
751
752170180µs foreach my $col (@$cols) {
753213825µs213495µs $self->throw_exception("No such column $col on table " . $self->name)
# spent 495µs making 213 calls to DBIx::Class::ResultSource::has_column, avg 2µs/call
754 unless $self->has_column($col);
755 }
756
757170765µs170651µs my %unique_constraints = $self->unique_constraints;
# spent 651µs making 170 calls to DBIx::Class::ResultSource::unique_constraints, avg 4µs/call
758170174µs $unique_constraints{$name} = $cols;
759170531µs1800ns $self->_unique_constraints(\%unique_constraints);
# spent 800ns making 1 call to DBIx::Class::ResultSource::Table::_unique_constraints
760}
761
762=head2 add_unique_constraints
763
764=over 4
765
766=item Arguments: @constraints
767
768=item Return Value: not defined
769
770=back
771
772Declare multiple unique constraints on this source.
773
774 __PACKAGE__->add_unique_constraints(
775 constraint_name1 => [ qw/column1 column2/ ],
776 constraint_name2 => [ qw/column2 column3/ ],
777 );
778
779Alternatively, you can specify only the columns:
780
781 __PACKAGE__->add_unique_constraints(
782 [ qw/column1 column2/ ],
783 [ qw/column3 column4/ ]
784 );
785
786This will result in unique constraints named C<table_column1_column2> and
787C<table_column3_column4>, where C<table> is replaced with the table name.
788
789Throws an error if any of the given column names do not yet exist on
790the result source.
791
792See also L</add_unique_constraint>.
793
794=cut
795
796sub add_unique_constraints {
797 my $self = shift;
798 my @constraints = @_;
799
800 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
801 # with constraint name
802 while (my ($name, $constraint) = splice @constraints, 0, 2) {
803 $self->add_unique_constraint($name => $constraint);
804 }
805 }
806 else {
807 # no constraint name
808 foreach my $constraint (@constraints) {
809 $self->add_unique_constraint($constraint);
810 }
811 }
812}
813
814=head2 name_unique_constraint
815
816=over 4
817
818=item Arguments: \@colnames
819
820=item Return Value: Constraint name
821
822=back
823
824 $source->table('mytable');
825 $source->name_unique_constraint(['col1', 'col2']);
826 # returns
827 'mytable_col1_col2'
828
829Return a name for a unique constraint containing the specified
830columns. The name is created by joining the table name and each column
831name, using an underscore character.
832
833For example, a constraint on a table named C<cd> containing the columns
834C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
835
836This is used by L</add_unique_constraint> if you do not specify the
837optional constraint name.
838
839=cut
840
841sub name_unique_constraint {
842 my ($self, $cols) = @_;
843
844 my $name = $self->name;
845 $name = $$name if (ref $name eq 'SCALAR');
846 $name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier
847
848 return join '_', $name, @$cols;
849}
850
851=head2 unique_constraints
852
853=over 4
854
855=item Arguments: none
856
857=item Return Value: Hash of unique constraint data
858
859=back
860
861 $source->unique_constraints();
862
863Read-only accessor which returns a hash of unique constraints on this
864source.
865
866The hash is keyed by constraint name, and contains an arrayref of
867column names as values.
868
869=cut
870
871
# spent 16.8ms (16.7+97µs) within DBIx::Class::ResultSource::unique_constraints which was called 6170 times, avg 3µs/call: # 6000 times (16.2ms+0s) by DBIx::Class::ResultSource::unique_constraint_columns at line 918, avg 3µs/call # 170 times (554µs+97µs) by DBIx::Class::ResultSource::add_unique_constraint at line 757, avg 4µs/call
sub unique_constraints {
872617043.3ms297µs return %{shift->_unique_constraints||{}};
# spent 96µs making 1 call to DBIx::Class::ResultSource::_unique_constraints # spent 900ns making 1 call to DBIx::Class::ResultSource::Table::_unique_constraints
873}
874
875=head2 unique_constraint_names
876
877=over 4
878
879=item Arguments: none
880
881=item Return Value: Unique constraint names
882
883=back
884
885 $source->unique_constraint_names();
886
887Returns the list of unique constraint names defined on this source.
888
889=cut
890
891sub unique_constraint_names {
892 my ($self) = @_;
893
894 my %unique_constraints = $self->unique_constraints;
895
896 return keys %unique_constraints;
897}
898
899=head2 unique_constraint_columns
900
901=over 4
902
903=item Arguments: $constraintname
904
905=item Return Value: List of constraint columns
906
907=back
908
909 $source->unique_constraint_columns('myconstraint');
910
911Returns the list of columns that make up the specified unique constraint.
912
913=cut
914
915
# spent 76.7ms (60.5+16.2) within DBIx::Class::ResultSource::unique_constraint_columns which was called 6000 times, avg 13µs/call: # 3000 times (38.3ms+10.3ms) by Koha::Objects::find at line 803 of DBIx/Class/ResultSet.pm, avg 16µs/call # 3000 times (22.2ms+5.86ms) by DBIx::Class::ResultSource::_minimal_valueset_satisfying_constraint at line 1587, avg 9µs/call
sub unique_constraint_columns {
91660002.53ms my ($self, $constraint_name) = @_;
917
918600015.6ms600016.2ms my %unique_constraints = $self->unique_constraints;
# spent 16.2ms making 6000 calls to DBIx::Class::ResultSource::unique_constraints, avg 3µs/call
919
92060002.41ms $self->throw_exception(
921 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
922 ) unless exists $unique_constraints{$constraint_name};
923
924600034.0ms return @{ $unique_constraints{$constraint_name} };
925}
926
927=head2 sqlt_deploy_callback
928
929=over
930
931=item Arguments: $callback_name | \&callback_code
932
933=item Return Value: $callback_name | \&callback_code
934
935=back
936
937 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
938
939 or
940
941 __PACKAGE__->sqlt_deploy_callback(sub {
942 my ($source_instance, $sqlt_table) = @_;
943 ...
944 } );
945
946An accessor to set a callback to be called during deployment of
947the schema via L<DBIx::Class::Schema/create_ddl_dir> or
948L<DBIx::Class::Schema/deploy>.
949
950The callback can be set as either a code reference or the name of a
951method in the current result class.
952
953Defaults to L</default_sqlt_deploy_hook>.
954
955Your callback will be passed the $source object representing the
956ResultSource instance being deployed, and the
957L<SQL::Translator::Schema::Table> object being created from it. The
958callback can be used to manipulate the table object or add your own
959customised indexes. If you need to manipulate a non-table object, use
960the L<DBIx::Class::Schema/sqlt_deploy_hook>.
961
962See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
963Your SQL> for examples.
964
965This sqlt deployment callback can only be used to manipulate
966SQL::Translator objects as they get turned into SQL. To execute
967post-deploy statements which SQL::Translator does not currently
968handle, override L<DBIx::Class::Schema/deploy> in your Schema class
969and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
970
971=head2 default_sqlt_deploy_hook
972
973This is the default deploy hook implementation which checks if your
974current Result class has a C<sqlt_deploy_hook> method, and if present
975invokes it B<on the Result class directly>. This is to preserve the
976semantics of C<sqlt_deploy_hook> which was originally designed to expect
977the Result class name and the
978L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being
979deployed.
980
981=cut
982
983sub default_sqlt_deploy_hook {
984 my $self = shift;
985
986 my $class = $self->result_class;
987
988 if ($class and $class->can('sqlt_deploy_hook')) {
989 $class->sqlt_deploy_hook(@_);
990 }
991}
992
993sub _invoke_sqlt_deploy_hook {
994 my $self = shift;
995 if ( my $hook = $self->sqlt_deploy_callback) {
996 $self->$hook(@_);
997 }
998}
999
1000=head2 result_class
1001
1002=over 4
1003
1004=item Arguments: $classname
1005
1006=item Return Value: $classname
1007
1008=back
1009
1010 use My::Schema::ResultClass::Inflator;
1011 ...
1012
1013 use My::Schema::Artist;
1014 ...
1015 __PACKAGE__->result_class('My::Schema::ResultClass::Inflator');
1016
1017Set the default result class for this source. You can use this to create
1018and use your own result inflator. See L<DBIx::Class::ResultSet/result_class>
1019for more details.
1020
1021Please note that setting this to something like
1022L<DBIx::Class::ResultClass::HashRefInflator> will make every result unblessed
1023and make life more difficult. Inflators like those are better suited to
1024temporary usage via L<DBIx::Class::ResultSet/result_class>.
1025
1026=head2 resultset
1027
1028=over 4
1029
1030=item Arguments: none
1031
1032=item Return Value: L<$resultset|DBIx::Class::ResultSet>
1033
1034=back
1035
1036Returns a resultset for the given source. This will initially be created
1037on demand by calling
1038
1039 $self->resultset_class->new($self, $self->resultset_attributes)
1040
1041but is cached from then on unless resultset_class changes.
1042
1043=head2 resultset_class
1044
1045=over 4
1046
1047=item Arguments: $classname
1048
1049=item Return Value: $classname
1050
1051=back
1052
1053 package My::Schema::ResultSet::Artist;
1054 use base 'DBIx::Class::ResultSet';
1055 ...
1056
1057 # In the result class
1058 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
1059
1060 # Or in code
1061 $source->resultset_class('My::Schema::ResultSet::Artist');
1062
1063Set the class of the resultset. This is useful if you want to create your
1064own resultset methods. Create your own class derived from
1065L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
1066this method returns the name of the existing resultset class, if one
1067exists.
1068
1069=head2 resultset_attributes
1070
1071=over 4
1072
1073=item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1074
1075=item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
1076
1077=back
1078
1079 # In the result class
1080 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1081
1082 # Or in code
1083 $source->resultset_attributes({ order_by => [ 'id' ] });
1084
1085Store a collection of resultset attributes, that will be set on every
1086L<DBIx::Class::ResultSet> produced from this result source.
1087
1088B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
1089bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
1090not recommended!
1091
1092Since relationships use attributes to link tables together, the "default"
1093attributes you set may cause unpredictable and undesired behavior. Furthermore,
1094the defaults cannot be turned off, so you are stuck with them.
1095
1096In most cases, what you should actually be using are project-specific methods:
1097
1098 package My::Schema::ResultSet::Artist;
1099 use base 'DBIx::Class::ResultSet';
1100 ...
1101
1102 # BAD IDEA!
1103 #__PACKAGE__->resultset_attributes({ prefetch => 'tracks' });
1104
1105 # GOOD IDEA!
1106 sub with_tracks { shift->search({}, { prefetch => 'tracks' }) }
1107
1108 # in your code
1109 $schema->resultset('Artist')->with_tracks->...
1110
1111This gives you the flexibility of not using it when you don't need it.
1112
1113For more complex situations, another solution would be to use a virtual view
1114via L<DBIx::Class::ResultSource::View>.
1115
1116=cut
1117
1118
# spent 677ms (56.2+620) within DBIx::Class::ResultSource::resultset which was called 3000 times, avg 226µs/call: # 3000 times (56.2ms+620ms) by Koha::Objects::find at line 547 of DBIx/Class/Schema.pm, avg 226µs/call
sub resultset {
111930001.36ms my $self = shift;
112030001.29ms $self->throw_exception(
1121 'resultset does not take any arguments. If you want another resultset, '.
1122 'call it on the schema instead.'
1123 ) if scalar @_;
1124
1125 $self->resultset_class->new(
1126 $self,
1127 {
1128300016.3ms6000147ms try { %{$self->schema->default_resultset_attributes} },
# spent 136ms making 3000 calls to DBIx::Class::Schema::default_resultset_attributes, avg 45µs/call # spent 10.2ms making 3000 calls to DBIx::Class::ResultSource::schema, avg 3µs/call
1129300074.5ms9000620ms %{$self->{resultset_attributes}},
# spent 313ms making 3000 calls to DBIx::Class::ResultSet::new, avg 104µs/call # spent 226ms making 3000 calls to Try::Tiny::try, avg 75µs/call # spent 81.6ms making 3000 calls to DBIx::Class::ResultSource::resultset_class, avg 27µs/call
1130 },
1131 );
1132}
1133
1134=head2 name
1135
1136=over 4
1137
1138=item Arguments: none
1139
1140=item Result value: $name
1141
1142=back
1143
1144Returns the name of the result source, which will typically be the table
1145name. This may be a scalar reference if the result source has a non-standard
1146name.
1147
1148=head2 source_name
1149
1150=over 4
1151
1152=item Arguments: $source_name
1153
1154=item Result value: $source_name
1155
1156=back
1157
1158Set an alternate name for the result source when it is loaded into a schema.
1159This is useful if you want to refer to a result source by a name other than
1160its class name.
1161
1162 package ArchivedBooks;
1163 use base qw/DBIx::Class/;
1164 __PACKAGE__->table('books_archive');
1165 __PACKAGE__->source_name('Books');
1166
1167 # from your schema...
1168 $schema->resultset('Books')->find(1);
1169
1170=head2 from
1171
1172=over 4
1173
1174=item Arguments: none
1175
1176=item Return Value: FROM clause
1177
1178=back
1179
1180 my $from_clause = $source->from();
1181
1182Returns an expression of the source to be supplied to storage to specify
1183retrieval from this source. In the case of a database, the required FROM
1184clause contents.
1185
1186=cut
1187
1188sub from { die 'Virtual method!' }
1189
1190=head2 source_info
1191
1192Stores a hashref of per-source metadata. No specific key names
1193have yet been standardized, the examples below are purely hypothetical
1194and don't actually accomplish anything on their own:
1195
1196 __PACKAGE__->source_info({
1197 "_tablespace" => 'fast_disk_array_3',
1198 "_engine" => 'InnoDB',
1199 });
1200
1201=head2 schema
1202
1203=over 4
1204
1205=item Arguments: L<$schema?|DBIx::Class::Schema>
1206
1207=item Return Value: L<$schema|DBIx::Class::Schema>
1208
1209=back
1210
1211 my $schema = $source->schema();
1212
1213Sets and/or returns the L<DBIx::Class::Schema> object to which this
1214result source instance has been attached to.
1215
1216=cut
1217
1218
# spent 23.2ms within DBIx::Class::ResultSource::schema which was called 9348 times, avg 2µs/call: # 6000 times (12.1ms+0s) by DBIx::Class::ResultSource::storage at line 1253, avg 2µs/call # 3000 times (10.2ms+0s) by Try::Tiny::try at line 1128, avg 3µs/call # 348 times (926µs+0s) by DBIx::Class::Schema::_register_source at line 1356 of DBIx/Class/Schema.pm, avg 3µs/call
sub schema {
1219934835.5ms if (@_ > 1) {
1220 $_[0]->{schema} = $_[1];
1221 }
1222 else {
122390008.57ms $_[0]->{schema} || do {
1224 my $name = $_[0]->{source_name} || '_unnamed_';
1225 my $err = 'Unable to perform storage-dependent operations with a detached result source '
1226 . "(source '$name' is not associated with a schema).";
1227
1228 $err .= ' You need to use $schema->thaw() or manually set'
1229 . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
1230 if $_[0]->{_detached_thaw};
1231
1232 DBIx::Class::Exception->throw($err);
1233 };
1234 }
1235}
1236
1237=head2 storage
1238
1239=over 4
1240
1241=item Arguments: none
1242
1243=item Return Value: L<$storage|DBIx::Class::Storage>
1244
1245=back
1246
1247 $source->storage->debug(1);
1248
1249Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
1250
1251=cut
1252
1253600036.2ms12000105ms
# spent 156ms (50.6+105) within DBIx::Class::ResultSource::storage which was called 6000 times, avg 26µs/call: # 3000 times (24.0ms+59.1ms) by DBIx::Class::ResultSet::single at line 1099 of DBIx/Class/ResultSet.pm, avg 28µs/call # 3000 times (26.6ms+45.9ms) by DBIx::Class::ResultSource::_minimal_valueset_satisfying_constraint at line 1581, avg 24µs/call
sub storage { shift->schema->storage; }
# spent 92.9ms making 6000 calls to DBIx::Class::Schema::storage, avg 15µs/call # spent 12.1ms making 6000 calls to DBIx::Class::ResultSource::schema, avg 2µs/call
1254
1255=head2 add_relationship
1256
1257=over 4
1258
1259=item Arguments: $rel_name, $related_source_name, \%cond, \%attrs?
1260
1261=item Return Value: 1/true if it succeeded
1262
1263=back
1264
1265 $source->add_relationship('rel_name', 'related_source', $cond, $attrs);
1266
1267L<DBIx::Class::Relationship> describes a series of methods which
1268create pre-defined useful types of relationships. Look there first
1269before using this method directly.
1270
1271The relationship name can be arbitrary, but must be unique for each
1272relationship attached to this result source. 'related_source' should
1273be the name with which the related result source was registered with
1274the current schema. For example:
1275
1276 $schema->source('Book')->add_relationship('reviews', 'Review', {
1277 'foreign.book_id' => 'self.id',
1278 });
1279
1280The condition C<$cond> needs to be an L<SQL::Abstract>-style
1281representation of the join between the tables. For example, if you're
1282creating a relation from Author to Book,
1283
1284 { 'foreign.author_id' => 'self.id' }
1285
1286will result in the JOIN clause
1287
1288 author me JOIN book foreign ON foreign.author_id = me.id
1289
1290You can specify as many foreign => self mappings as necessary.
1291
1292Valid attributes are as follows:
1293
1294=over 4
1295
1296=item join_type
1297
1298Explicitly specifies the type of join to use in the relationship. Any
1299SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1300the SQL command immediately before C<JOIN>.
1301
1302=item proxy
1303
1304An arrayref containing a list of accessors in the foreign class to proxy in
1305the main class. If, for example, you do the following:
1306
1307 CD->might_have(liner_notes => 'LinerNotes', undef, {
1308 proxy => [ qw/notes/ ],
1309 });
1310
1311Then, assuming LinerNotes has an accessor named notes, you can do:
1312
1313 my $cd = CD->find(1);
1314 # set notes -- LinerNotes object is created if it doesn't exist
1315 $cd->notes('Notes go here');
1316
1317=item accessor
1318
1319Specifies the type of accessor that should be created for the
1320relationship. Valid values are C<single> (for when there is only a single
1321related object), C<multi> (when there can be many), and C<filter> (for
1322when there is a single related object, but you also want the relationship
1323accessor to double as a column accessor). For C<multi> accessors, an
1324add_to_* method is also created, which calls C<create_related> for the
1325relationship.
1326
1327=back
1328
1329Throws an exception if the condition is improperly supplied, or cannot
1330be resolved.
1331
1332=cut
1333
1334
# spent 6.62ms (5.65+970µs) within DBIx::Class::ResultSource::add_relationship which was called 319 times, avg 21µs/call: # 319 times (5.65ms+970µs) by DBIx::Class::ResultSourceProxy::add_relationship at line 45 of DBIx/Class/ResultSourceProxy.pm, avg 21µs/call
sub add_relationship {
1335319158µs my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
133631994µs $self->throw_exception("Can't create relationship without join condition")
1337 unless $cond;
133831968µs $attrs ||= {};
1339
1340 # Check foreign and self are right in cond
1341319273µs if ( (ref $cond ||'') eq 'HASH') {
1342 $_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'")
13433191.89ms325594µs for keys %$cond;
# spent 594µs making 325 calls to DBIx::Class::ResultSource::CORE:match, avg 2µs/call
1344
1345 $_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'")
13463191.13ms325251µs for values %$cond;
# spent 251µs making 325 calls to DBIx::Class::ResultSource::CORE:match, avg 774ns/call
1347 }
1348
13493191.07ms2123µs my %rels = %{ $self->_relationships };
# spent 122µs making 1 call to DBIx::Class::ResultSource::_relationships # spent 900ns making 1 call to DBIx::Class::ResultSource::Table::_relationships
1350319931µs $rels{$rel} = { class => $f_source_name,
1351 source => $f_source_name,
1352 cond => $cond,
1353 attrs => $attrs };
1354319409µs1800ns $self->_relationships(\%rels);
# spent 800ns making 1 call to DBIx::Class::ResultSource::Table::_relationships
1355
13563194.06ms return $self;
1357
1358# XXX disabled. doesn't work properly currently. skip in tests.
1359
1360 my $f_source = $self->schema->source($f_source_name);
1361 unless ($f_source) {
1362 $self->ensure_class_loaded($f_source_name);
1363 $f_source = $f_source_name->result_source;
1364 #my $s_class = ref($self->schema);
1365 #$f_source_name =~ m/^${s_class}::(.*)$/;
1366 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1367 #$f_source = $self->schema->source($f_source_name);
1368 }
1369 return unless $f_source; # Can't test rel without f_source
1370
1371 try { $self->_resolve_join($rel, 'me', {}, []) }
1372 catch {
1373 # If the resolve failed, back out and re-throw the error
1374 delete $rels{$rel};
1375 $self->_relationships(\%rels);
1376 $self->throw_exception("Error creating relationship $rel: $_");
1377 };
1378
1379 1;
1380}
1381
1382=head2 relationships
1383
1384=over 4
1385
1386=item Arguments: none
1387
1388=item Return Value: L<@rel_names|DBIx::Class::Relationship>
1389
1390=back
1391
1392 my @rel_names = $source->relationships();
1393
1394Returns all relationship names for this source.
1395
1396=cut
1397
1398sub relationships {
1399 return keys %{shift->_relationships};
1400}
1401
1402=head2 relationship_info
1403
1404=over 4
1405
1406=item Arguments: L<$rel_name|DBIx::Class::Relationship>
1407
1408=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1409
1410=back
1411
1412Returns a hash of relationship information for the specified relationship
1413name. The keys/values are as specified for L<DBIx::Class::Relationship::Base/add_relationship>.
1414
1415=cut
1416
1417
# spent 765µs (765+300ns) within DBIx::Class::ResultSource::relationship_info which was called 441 times, avg 2µs/call: # 319 times (613µs+300ns) by DBIx::Class::ResultSourceProxy::add_relationship at line 46 of DBIx/Class/ResultSourceProxy.pm, avg 2µs/call # 122 times (152µs+0s) by DBIx::Class::ResultSourceProxy::relationship_info at line 18 of (eval 189)[Sub/Quote.pm:5], avg 1µs/call
sub relationship_info {
1418 #my ($self, $rel) = @_;
14194411.21ms1300ns return shift->_relationships->{+shift};
# spent 300ns making 1 call to DBIx::Class::ResultSource::Table::_relationships
1420}
1421
1422=head2 has_relationship
1423
1424=over 4
1425
1426=item Arguments: L<$rel_name|DBIx::Class::Relationship>
1427
1428=item Return Value: 1/0 (true/false)
1429
1430=back
1431
1432Returns true if the source has a relationship of this name, false otherwise.
1433
1434=cut
1435
1436sub has_relationship {
1437 #my ($self, $rel) = @_;
1438 return exists shift->_relationships->{+shift};
1439}
1440
1441=head2 reverse_relationship_info
1442
1443=over 4
1444
1445=item Arguments: L<$rel_name|DBIx::Class::Relationship>
1446
1447=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship>
1448
1449=back
1450
1451Looks through all the relationships on the source this relationship
1452points to, looking for one whose condition is the reverse of the
1453condition on this relationship.
1454
1455A common use of this is to find the name of the C<belongs_to> relation
1456opposing a C<has_many> relation. For definition of these look in
1457L<DBIx::Class::Relationship>.
1458
1459The returned hashref is keyed by the name of the opposing
1460relationship, and contains its data in the same manner as
1461L</relationship_info>.
1462
1463=cut
1464
1465sub reverse_relationship_info {
1466 my ($self, $rel) = @_;
1467
1468 my $rel_info = $self->relationship_info($rel)
1469 or $self->throw_exception("No such relationship '$rel'");
1470
1471 my $ret = {};
1472
1473 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1474
1475 my $stripped_cond = $self->__strip_relcond ($rel_info->{cond});
1476
1477 my $registered_source_name = $self->source_name;
1478
1479 # this may be a partial schema or something else equally esoteric
1480 my $other_rsrc = $self->related_source($rel);
1481
1482 # Get all the relationships for that source that related to this source
1483 # whose foreign column set are our self columns on $rel and whose self
1484 # columns are our foreign columns on $rel
1485 foreach my $other_rel ($other_rsrc->relationships) {
1486
1487 # only consider stuff that points back to us
1488 # "us" here is tricky - if we are in a schema registration, we want
1489 # to use the source_names, otherwise we will use the actual classes
1490
1491 # the schema may be partial
1492 my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
1493 or next;
1494
1495 if ($registered_source_name) {
1496 next if $registered_source_name ne ($roundtrip_rsrc->source_name || '')
1497 }
1498 else {
1499 next if $self->result_class ne $roundtrip_rsrc->result_class;
1500 }
1501
1502 my $other_rel_info = $other_rsrc->relationship_info($other_rel);
1503
1504 # this can happen when we have a self-referential class
1505 next if $other_rel_info eq $rel_info;
1506
1507 next unless ref $other_rel_info->{cond} eq 'HASH';
1508 my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond});
1509
1510 $ret->{$other_rel} = $other_rel_info if (
1511 $self->_compare_relationship_keys (
1512 [ keys %$stripped_cond ], [ values %$other_stripped_cond ]
1513 )
1514 and
1515 $self->_compare_relationship_keys (
1516 [ values %$stripped_cond ], [ keys %$other_stripped_cond ]
1517 )
1518 );
1519 }
1520
1521 return $ret;
1522}
1523
1524# all this does is removes the foreign/self prefix from a condition
1525sub __strip_relcond {
1526 +{
1527 map
1528 { map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) }
1529 keys %{$_[1]}
1530 }
1531}
1532
1533sub compare_relationship_keys {
1534 carp 'compare_relationship_keys is a private method, stop calling it';
1535 my $self = shift;
1536 $self->_compare_relationship_keys (@_);
1537}
1538
1539# Returns true if both sets of keynames are the same, false otherwise.
1540sub _compare_relationship_keys {
1541# my ($self, $keys1, $keys2) = @_;
1542 return
1543 join ("\x00", sort @{$_[1]})
1544 eq
1545 join ("\x00", sort @{$_[2]})
1546 ;
1547}
1548
1549# optionally takes either an arrayref of column names, or a hashref of already
1550# retrieved colinfos
1551# returns an arrayref of column names of the shortest unique constraint
1552# (matching some of the input if any), giving preference to the PK
1553sub _identifying_column_set {
1554 my ($self, $cols) = @_;
1555
1556 my %unique = $self->unique_constraints;
1557 my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||());
1558
1559 # always prefer the PK first, and then shortest constraints first
1560 USET:
1561 for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) {
1562 next unless $set && @$set;
1563
1564 for (@$set) {
1565 next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} );
1566 }
1567
1568 # copy so we can mangle it at will
1569 return [ @$set ];
1570 }
1571
1572 return undef;
1573}
1574
1575
# spent 612ms (144+469) within DBIx::Class::ResultSource::_minimal_valueset_satisfying_constraint which was called 3000 times, avg 204µs/call: # 3000 times (144ms+469ms) by Koha::Objects::find at line 842 of DBIx/Class/ResultSet.pm, avg 204µs/call
sub _minimal_valueset_satisfying_constraint {
157630001.36ms my $self = shift;
157730009.02ms my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1578
157930008.38ms300097.0ms $args->{columns_info} ||= $self->columns_info;
# spent 97.0ms making 3000 calls to DBIx::Class::ResultSource::columns_info, avg 32µs/call
1580
1581300020.2ms6000343ms my $vals = $self->storage->_extract_fixed_condition_columns(
# spent 271ms making 3000 calls to DBIx::Class::Storage::DBIHacks::_extract_fixed_condition_columns, avg 90µs/call # spent 72.5ms making 3000 calls to DBIx::Class::ResultSource::storage, avg 24µs/call
1582 $args->{values},
1583 ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
1584 );
1585
15863000572µs my $cols;
158730009.07ms300028.1ms for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) {
# spent 28.1ms making 3000 calls to DBIx::Class::ResultSource::unique_constraint_columns, avg 9µs/call
158830007.74ms if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) {
1589 $cols->{missing}{$col} = undef;
1590 }
1591 elsif( ! defined $vals->{$col} ) {
1592 $cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef;
1593 }
1594 else {
1595 # we need to inject back the '=' as _extract_fixed_condition_columns
1596 # will strip it from literals and values alike, resulting in an invalid
1597 # condition in the end
159830007.42ms $cols->{present}{$col} = { '=' => $vals->{$col} };
1599 }
1600
1601 $cols->{fc}{$col} = 1 if (
1602 ( ! $cols->{missing} or ! exists $cols->{missing}{$col} )
1603 and
160430009.27ms keys %{ $args->{columns_info}{$col}{_filter_info} || {} }
1605 );
1606 }
1607
1608 $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s",
1609 $args->{constraint_name},
161030002.26ms join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ),
1611 ) ) if $cols->{missing};
1612
1613 $self->throw_exception( sprintf (
1614 "Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s",
1615 $args->{constraint_name},
161630002.35ms join (', ', map { "'$_'" } sort keys %{$cols->{fc}}),
1617 )) if $cols->{fc};
1618
161930001.38ms if (
1620 $cols->{undefined}
1621 and
1622 !$ENV{DBIC_NULLABLE_KEY_NOWARN}
1623 ) {
1624 carp_unique ( sprintf (
1625 "NULL/undef values supplied for requested unique constraint '%s' (NULL "
1626 . 'values in column(s): %s). This is almost certainly not what you wanted, '
1627 . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
1628 $args->{constraint_name},
1629 join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}),
1630 ));
1631 }
1632
1633300033.9ms return { map { %{ $cols->{$_}||{} } } qw(present undefined) };
1634}
1635
1636# Returns the {from} structure used to express JOIN conditions
1637sub _resolve_join {
1638 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1639
1640 # we need a supplied one, because we do in-place modifications, no returns
1641 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1642 unless ref $seen eq 'HASH';
1643
1644 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1645 unless ref $jpath eq 'ARRAY';
1646
1647 $jpath = [@$jpath]; # copy
1648
1649 if (not defined $join or not length $join) {
1650 return ();
1651 }
1652 elsif (ref $join eq 'ARRAY') {
1653 return
1654 map {
1655 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1656 } @$join;
1657 }
1658 elsif (ref $join eq 'HASH') {
1659
1660 my @ret;
1661 for my $rel (keys %$join) {
1662
1663 my $rel_info = $self->relationship_info($rel)
1664 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1665
1666 my $force_left = $parent_force_left;
1667 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1668
1669 # the actual seen value will be incremented by the recursion
1670 my $as = $self->storage->relname_to_table_alias(
1671 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1672 );
1673
1674 push @ret, (
1675 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1676 $self->related_source($rel)->_resolve_join(
1677 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1678 )
1679 );
1680 }
1681 return @ret;
1682
1683 }
1684 elsif (ref $join) {
1685 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1686 }
1687 else {
1688 my $count = ++$seen->{$join};
1689 my $as = $self->storage->relname_to_table_alias(
1690 $join, ($count > 1 && $count)
1691 );
1692
1693 my $rel_info = $self->relationship_info($join)
1694 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1695
1696 my $rel_src = $self->related_source($join);
1697 return [ { $as => $rel_src->from,
1698 -rsrc => $rel_src,
1699 -join_type => $parent_force_left
1700 ? 'left'
1701 : $rel_info->{attrs}{join_type}
1702 ,
1703 -join_path => [@$jpath, { $join => $as } ],
1704 -is_single => (
1705 (! $rel_info->{attrs}{accessor})
1706 or
1707 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1708 ),
1709 -alias => $as,
1710 -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
1711 },
1712 scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1713 ];
1714 }
1715}
1716
1717sub pk_depends_on {
1718 carp 'pk_depends_on is a private method, stop calling it';
1719 my $self = shift;
1720 $self->_pk_depends_on (@_);
1721}
1722
1723# Determines whether a relation is dependent on an object from this source
1724# having already been inserted. Takes the name of the relationship and a
1725# hashref of columns of the related object.
1726sub _pk_depends_on {
1727 my ($self, $rel_name, $rel_data) = @_;
1728
1729 my $relinfo = $self->relationship_info($rel_name);
1730
1731 # don't assume things if the relationship direction is specified
1732 return $relinfo->{attrs}{is_foreign_key_constraint}
1733 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1734
1735 my $cond = $relinfo->{cond};
1736 return 0 unless ref($cond) eq 'HASH';
1737
1738 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1739 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1740
1741 # assume anything that references our PK probably is dependent on us
1742 # rather than vice versa, unless the far side is (a) defined or (b)
1743 # auto-increment
1744 my $rel_source = $self->related_source($rel_name);
1745
1746 foreach my $p ($self->primary_columns) {
1747 if (exists $keyhash->{$p}) {
1748 unless (defined($rel_data->{$keyhash->{$p}})
1749 || $rel_source->column_info($keyhash->{$p})
1750 ->{is_auto_increment}) {
1751 return 0;
1752 }
1753 }
1754 }
1755
1756 return 1;
1757}
1758
1759sub resolve_condition {
1760 carp 'resolve_condition is a private method, stop calling it';
1761 shift->_resolve_condition (@_);
1762}
1763
1764sub _resolve_condition {
1765# carp_unique sprintf
1766# '_resolve_condition is a private method, and moreover is about to go '
1767# . 'away. Please contact the development team at %s if you believe you '
1768# . 'have a genuine use for this method, in order to discuss alternatives.',
1769# DBIx::Class::_ENV_::HELP_URL,
1770# ;
1771
1772#######################
1773### API Design? What's that...? (a backwards compatible shim, kill me now)
1774
1775 my ($self, $cond, @res_args, $rel_name);
1776
1777 # we *SIMPLY DON'T KNOW YET* which arg is which, yay
1778 ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
1779
1780 # assume that an undef is an object-like unset (set_from_related(undef))
1781 my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
1782
1783 # turn objlike into proper objects for saner code further down
1784 for (0,1) {
1785 next unless $is_objlike[$_];
1786
1787 if ( defined blessed $res_args[$_] ) {
1788
1789 # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
1790 if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
1791 carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
1792 $is_objlike[$_] = 0;
1793 $res_args[$_] = '__gremlins__';
1794 }
1795 }
1796 else {
1797 $res_args[$_] ||= {};
1798
1799 # hate everywhere - have to pass in as a plain hash
1800 # pretending to be an object at least for now
1801 $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
1802 unless ref $res_args[$_] eq 'HASH';
1803 }
1804 }
1805
1806 my $args = {
1807 condition => $cond,
1808
1809 # where-is-waldo block guesses relname, then further down we override it if available
1810 (
1811 $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
1812 : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] )
1813 : ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] )
1814 ),
1815
1816 ( $rel_name ? ( rel_name => $rel_name ) : () ),
1817 };
1818#######################
1819
1820 # now it's fucking easy isn't it?!
1821 my $rc = $self->_resolve_relationship_condition( $args );
1822
1823 my @res = (
1824 ( $rc->{join_free_condition} || $rc->{condition} ),
1825 ! $rc->{join_free_condition},
1826 );
1827
1828 # _resolve_relationship_condition always returns qualified cols even in the
1829 # case of join_free_condition, but nothing downstream expects this
1830 if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') {
1831 $res[0] = { map
1832 { ($_ =~ /\.(.+)/) => $res[0]{$_} }
1833 keys %{$res[0]}
1834 };
1835 }
1836
1837 # and more legacy
1838 return wantarray ? @res : $res[0];
1839}
1840
1841# Keep this indefinitely. There is evidence of both CPAN and
1842# darkpan using it, and there isn't much harm in an extra var
1843# anyway.
18441600nsour $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
1845# YES I KNOW THIS IS EVIL
1846# it is there to save darkpan from themselves, since internally
1847# we are moving to a constant
184817µs11µsInternals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
# spent 1µs making 1 call to Internals::SvREADONLY
1849
1850# Resolves the passed condition to a concrete query fragment and extra
1851# metadata
1852#
1853## self-explanatory API, modeled on the custom cond coderef:
1854# rel_name => (scalar)
1855# foreign_alias => (scalar)
1856# foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef )
1857# self_alias => (scalar)
1858# self_result_object => (either not supplied or a result object)
1859# require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
1860# infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
1861# condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond})
1862#
1863## returns a hash
1864# condition => (a valid *likely fully qualified* sqla cond structure)
1865# identity_map => (a hashref of foreign-to-self *unqualified* column equality names)
1866# join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset)
1867# inferred_values => (in case of an available join_free condition, this is a hashref of
1868# *unqualified* column/value *EQUALITY* pairs, representing an amalgamation
1869# of the JF-cond parse and infer_values_based_on
1870# always either complete or unset)
1871#
1872sub _resolve_relationship_condition {
1873 my $self = shift;
1874
1875 my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
1876
1877 for ( qw( rel_name self_alias foreign_alias ) ) {
1878 $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
1879 if !defined $args->{$_} or length ref $args->{$_};
1880 }
1881
1882 $self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical")
1883 if $args->{self_alias} eq $args->{foreign_alias};
1884
1885# TEMP
1886 my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
1887
1888 my $rel_info = $self->relationship_info($args->{rel_name})
1889# TEMP
1890# or $self->throw_exception( "No such $exception_rel_id" );
1891 or carp_unique("Requesting resolution on non-existent relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}': fix your code *soon*, as it will break with the next major version");
1892
1893# TEMP
1894 $exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'"
1895 if $rel_info and exists $rel_info->{_original_name};
1896
1897 $self->throw_exception("No practical way to resolve $exception_rel_id between two data structures")
1898 if exists $args->{self_result_object} and exists $args->{foreign_values};
1899
1900 $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
1901 if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
1902
1903 $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
1904
1905 $args->{condition} ||= $rel_info->{cond};
1906
1907 $self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
1908 if (
1909 exists $args->{self_result_object}
1910 and
1911 ( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') )
1912 )
1913 ;
1914
1915#TEMP
1916 my $rel_rsrc;# = $self->related_source($args->{rel_name});
1917
1918 if (exists $args->{foreign_values}) {
1919# TEMP
1920 $rel_rsrc ||= $self->related_source($args->{rel_name});
1921
1922 if (defined blessed $args->{foreign_values}) {
1923
1924 $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
1925 unless $args->{foreign_values}->isa('DBIx::Class::Row');
1926
1927 carp_unique(
1928 "Objects supplied as 'foreign_values' ($args->{foreign_values}) "
1929 . "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), "
1930 . "perhaps you've made a mistake invoking the condition resolver?"
1931 ) unless $args->{foreign_values}->isa($rel_rsrc->result_class);
1932
1933 $args->{foreign_values} = { $args->{foreign_values}->get_columns };
1934 }
1935 elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
1936 my $ri = { map { $_ => 1 } $rel_rsrc->relationships };
1937 my $ci = $rel_rsrc->columns_info;
1938 ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception(
1939 "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
1940 ) for keys %{ $args->{foreign_values} ||= {} };
1941 }
1942 else {
1943 $self->throw_exception(
1944 "Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', "
1945 . "or a hash reference, or undef"
1946 );
1947 }
1948 }
1949
1950 my $ret;
1951
1952 if (ref $args->{condition} eq 'CODE') {
1953
1954 my $cref_args = {
1955 rel_name => $args->{rel_name},
1956 self_resultsource => $self,
1957 self_alias => $args->{self_alias},
1958 foreign_alias => $args->{foreign_alias},
1959 ( map
1960 { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
1961 qw( self_result_object foreign_values )
1962 ),
1963 };
1964
1965 # legacy - never remove these!!!
1966 $cref_args->{foreign_relname} = $cref_args->{rel_name};
1967
1968 $cref_args->{self_rowobj} = $cref_args->{self_result_object}
1969 if exists $cref_args->{self_result_object};
1970
1971 ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
1972
1973 # sanity check
1974 $self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
1975 if @extra;
1976
1977 if (my $jfc = $ret->{join_free_condition}) {
1978
1979 $self->throw_exception (
1980 "The join-free condition returned for $exception_rel_id must be a hash reference"
1981 ) unless ref $jfc eq 'HASH';
1982
1983# TEMP
1984 $rel_rsrc ||= $self->related_source($args->{rel_name});
1985
1986 my ($joinfree_alias, $joinfree_source);
1987 if (defined $args->{self_result_object}) {
1988 $joinfree_alias = $args->{foreign_alias};
1989 $joinfree_source = $rel_rsrc;
1990 }
1991 elsif (defined $args->{foreign_values}) {
1992 $joinfree_alias = $args->{self_alias};
1993 $joinfree_source = $self;
1994 }
1995
1996 # FIXME sanity check until things stabilize, remove at some point
1997 $self->throw_exception (
1998 "A join-free condition returned for $exception_rel_id without a result object to chain from"
1999 ) unless $joinfree_alias;
2000
2001 my $fq_col_list = { map
2002 { ( "$joinfree_alias.$_" => 1 ) }
2003 $joinfree_source->columns
2004 };
2005
2006 exists $fq_col_list->{$_} or $self->throw_exception (
2007 "The join-free condition returned for $exception_rel_id may only "
2008 . 'contain keys that are fully qualified column names of the corresponding source '
2009 . "(it returned '$_')"
2010 ) for keys %$jfc;
2011
2012 (
2013 length ref $_
2014 and
2015 defined blessed($_)
2016 and
2017 $_->isa('DBIx::Class::Row')
2018 and
2019 $self->throw_exception (
2020 "The join-free condition returned for $exception_rel_id may not "
2021 . 'contain result objects as values - perhaps instead of invoking '
2022 . '->$something you meant to return ->get_column($something)'
2023 )
2024 ) for values %$jfc;
2025
2026 }
2027 }
2028 elsif (ref $args->{condition} eq 'HASH') {
2029
2030 # the condition is static - use parallel arrays
2031 # for a "pivot" depending on which side of the
2032 # rel did we get as an object
2033 my (@f_cols, @l_cols);
2034 for my $fc (keys %{$args->{condition}}) {
2035 my $lc = $args->{condition}{$fc};
2036
2037 # FIXME STRICTMODE should probably check these are valid columns
2038 $fc =~ s/^foreign\.// ||
2039 $self->throw_exception("Invalid rel cond key '$fc'");
2040
2041 $lc =~ s/^self\.// ||
2042 $self->throw_exception("Invalid rel cond val '$lc'");
2043
2044 push @f_cols, $fc;
2045 push @l_cols, $lc;
2046 }
2047
2048 # construct the crosstable condition and the identity map
2049 for (0..$#f_cols) {
2050 $ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" };
2051 $ret->{identity_map}{$l_cols[$_]} = $f_cols[$_];
2052 };
2053
2054 if ($args->{foreign_values}) {
2055 $ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]}
2056 for 0..$#f_cols;
2057 }
2058 elsif (defined $args->{self_result_object}) {
2059
2060 for my $i (0..$#l_cols) {
2061 if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) {
2062 $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]);
2063 }
2064 else {
2065 $self->throw_exception(sprintf
2066 "Unable to resolve relationship '%s' from object '%s': column '%s' not "
2067 . 'loaded from storage (or not passed to new() prior to insert()). You '
2068 . 'probably need to call ->discard_changes to get the server-side defaults '
2069 . 'from the database.',
2070 $args->{rel_name},
2071 $args->{self_result_object},
2072 $l_cols[$i],
2073 ) if $args->{self_result_object}->in_storage;
2074
2075 # FIXME - temporarly force-override
2076 delete $args->{require_join_free_condition};
2077 $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
2078 last;
2079 }
2080 }
2081 }
2082 }
2083 elsif (ref $args->{condition} eq 'ARRAY') {
2084 if (@{$args->{condition}} == 0) {
2085 $ret = {
2086 condition => UNRESOLVABLE_CONDITION,
2087 join_free_condition => UNRESOLVABLE_CONDITION,
2088 };
2089 }
2090 elsif (@{$args->{condition}} == 1) {
2091 $ret = $self->_resolve_relationship_condition({
2092 %$args,
2093 condition => $args->{condition}[0],
2094 });
2095 }
2096 else {
2097 # we are discarding inferred values here... likely incorrect...
2098 # then again - the entire thing is an OR, so we *can't* use them anyway
2099 for my $subcond ( map
2100 { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
2101 @{$args->{condition}}
2102 ) {
2103 $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
2104 if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
2105
2106 $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
2107 }
2108 }
2109 }
2110 else {
2111 $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
2112 }
2113
2114 $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
2115 $args->{require_join_free_condition}
2116 and
2117 ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
2118 );
2119
2120 my $storage = $self->schema->storage;
2121
2122 # we got something back - sanity check and infer values if we can
2123 my @nonvalues;
2124 if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
2125
2126 my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
2127
2128 if (keys %$jfc_eqs) {
2129
2130 for (keys %$jfc) {
2131 # $jfc is fully qualified by definition
2132 my ($col) = $_ =~ /\.(.+)/;
2133
2134 if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
2135 $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
2136 }
2137 elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
2138 push @nonvalues, $col;
2139 }
2140 }
2141
2142 # all or nothing
2143 delete $ret->{inferred_values} if @nonvalues;
2144 }
2145 }
2146
2147 # did the user explicitly ask
2148 if ($args->{infer_values_based_on}) {
2149
2150 $self->throw_exception(sprintf (
2151 "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
2152 map { "'$_'" } @nonvalues
2153 )) if @nonvalues;
2154
2155
2156 $ret->{inferred_values} ||= {};
2157
2158 $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
2159 for keys %{$args->{infer_values_based_on}};
2160 }
2161
2162 # add the identities based on the main condition
2163 # (may already be there, since easy to calculate on the fly in the HASH case)
2164 if ( ! $ret->{identity_map} ) {
2165
2166 my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition});
2167
2168 my $colinfos;
2169 for my $lhs (keys %$col_eqs) {
2170
2171 next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
2172
2173# TEMP
2174 $rel_rsrc ||= $self->related_source($args->{rel_name});
2175
2176 # there is no way to know who is right and who is left in a cref
2177 # therefore a full blown resolution call, and figure out the
2178 # direction a bit further below
2179 $colinfos ||= $storage->_resolve_column_info([
2180 { -alias => $args->{self_alias}, -rsrc => $self },
2181 { -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc },
2182 ]);
2183
2184 next unless $colinfos->{$lhs}; # someone is engaging in witchcraft
2185
2186 if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) {
2187
2188 if (
2189 $colinfos->{$rhs_ref->[0]}
2190 and
2191 $colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias}
2192 ) {
2193 ( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} )
2194 ? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} )
2195 : ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} )
2196 ;
2197 }
2198 }
2199 elsif (
2200 $col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x
2201 and
2202 ($colinfos->{$1}||{})->{-result_source} == $rel_rsrc
2203 ) {
2204 my ($lcol, $rcol) = map
2205 { $colinfos->{$_}{-colname} }
2206 ( $lhs, $1 )
2207 ;
2208 carp_unique(
2209 "The $exception_rel_id specifies equality of column '$lcol' and the "
2210 . "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)"
2211 );
2212 }
2213 }
2214 }
2215
2216 # FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition
2217 $ret->{condition} = { -and => [ $ret->{condition} ] }
2218 unless $ret->{condition} eq UNRESOLVABLE_CONDITION;
2219
2220 $ret;
2221}
2222
2223=head2 related_source
2224
2225=over 4
2226
2227=item Arguments: $rel_name
2228
2229=item Return Value: $source
2230
2231=back
2232
2233Returns the result source object for the given relationship.
2234
2235=cut
2236
2237sub related_source {
2238 my ($self, $rel) = @_;
2239 if( !$self->has_relationship( $rel ) ) {
2240 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2241 }
2242
2243 # if we are not registered with a schema - just use the prototype
2244 # however if we do have a schema - ask for the source by name (and
2245 # throw in the process if all fails)
2246 if (my $schema = try { $self->schema }) {
2247 $schema->source($self->relationship_info($rel)->{source});
2248 }
2249 else {
2250 my $class = $self->relationship_info($rel)->{class};
2251 $self->ensure_class_loaded($class);
2252 $class->result_source_instance;
2253 }
2254}
2255
2256=head2 related_class
2257
2258=over 4
2259
2260=item Arguments: $rel_name
2261
2262=item Return Value: $classname
2263
2264=back
2265
2266Returns the class name for objects in the given relationship.
2267
2268=cut
2269
2270sub related_class {
2271 my ($self, $rel) = @_;
2272 if( !$self->has_relationship( $rel ) ) {
2273 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
2274 }
2275 return $self->schema->class($self->relationship_info($rel)->{source});
2276}
2277
2278=head2 handle
2279
2280=over 4
2281
2282=item Arguments: none
2283
2284=item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle>
2285
2286=back
2287
2288Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
2289for this source. Used as a serializable pointer to this resultsource, as it is not
2290easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
2291relationship definitions.
2292
2293=cut
2294
2295sub handle {
2296 return DBIx::Class::ResultSourceHandle->new({
2297 source_moniker => $_[0]->source_name,
2298
2299 # so that a detached thaw can be re-frozen
2300 $_[0]->{_detached_thaw}
2301 ? ( _detached_source => $_[0] )
2302 : ( schema => $_[0]->schema )
2303 ,
2304 });
2305}
2306
23071100nsmy $global_phase_destroy;
2308
# spent 879µs (588+291) within DBIx::Class::ResultSource::DESTROY which was called 174 times, avg 5µs/call: # 174 times (588µs+291µs) by DBIx::Class::Schema::_copy_state_from at line 1033 of DBIx/Class/Schema.pm, avg 5µs/call
sub DESTROY {
2309174199µs174291µs return if $global_phase_destroy ||= in_global_destruction;
# spent 291µs making 174 calls to Devel::GlobalDestruction::in_global_destruction, avg 2µs/call
2310
2311######
2312# !!! ACHTUNG !!!!
2313######
2314#
2315# Under no circumstances shall $_[0] be stored anywhere else (like copied to
2316# a lexical variable, or shifted, or anything else). Doing so will mess up
2317# the refcount of this particular result source, and will allow the $schema
2318# we are trying to save to reattach back to the source we are destroying.
2319# The relevant code checking refcounts is in ::Schema::DESTROY()
2320
2321 # if we are not a schema instance holder - we don't matter
2322 return if(
2323174325µs ! ref $_[0]->{schema}
2324 or
2325 isweak $_[0]->{schema}
2326 );
2327
2328 # weaken our schema hold forcing the schema to find somewhere else to live
2329 # during global destruction (if we have not yet bailed out) this will throw
2330 # which will serve as a signal to not try doing anything else
2331 # however beware - on older perls the exception seems randomly untrappable
2332 # due to some weird race condition during thread joining :(((
2333 local $@;
2334 eval {
2335 weaken $_[0]->{schema};
2336
2337 # if schema is still there reintroduce ourselves with strong refs back to us
2338 if ($_[0]->{schema}) {
2339 my $srcregs = $_[0]->{schema}->source_registrations;
2340 for (keys %$srcregs) {
2341 next unless $srcregs->{$_};
2342 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
2343 }
2344 }
2345
2346 1;
2347 } or do {
2348 $global_phase_destroy = 1;
2349 };
2350
2351 return;
2352}
2353
2354sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
2355
2356sub STORABLE_thaw {
2357 my ($self, $cloning, $ice) = @_;
2358 %$self = %{ (Storable::thaw($ice))->resolve };
2359}
2360
2361=head2 throw_exception
2362
2363See L<DBIx::Class::Schema/"throw_exception">.
2364
2365=cut
2366
2367sub throw_exception {
2368 my $self = shift;
2369
2370 $self->{schema}
2371 ? $self->{schema}->throw_exception(@_)
2372 : DBIx::Class::Exception->throw(@_)
2373 ;
2374}
2375
2376=head2 column_info_from_storage
2377
2378=over
2379
2380=item Arguments: 1/0 (default: 0)
2381
2382=item Return Value: 1/0
2383
2384=back
2385
2386 __PACKAGE__->column_info_from_storage(1);
2387
2388Enables the on-demand automatic loading of the above column
2389metadata from storage as necessary. This is *deprecated*, and
2390should not be used. It will be removed before 1.0.
2391
2392=head1 FURTHER QUESTIONS?
2393
2394Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
2395
2396=head1 COPYRIGHT AND LICENSE
2397
2398This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
2399by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
2400redistribute it and/or modify it under the same terms as the
2401L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
2402
2403=cut
2404
240518µs11.01ms1;
# spent 1.01ms making 1 call to B::Hooks::EndOfScope::XS::__ANON__
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.