New format of changelog (easier to read)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
CommitLineData
9c992ba1 1package DBIx::Class::ResultSource;
2
3use strict;
4use warnings;
5
6use DBIx::Class::ResultSet;
aec3eff1 7use DBIx::Class::ResultSourceHandle;
1a58752c 8
9use DBIx::Class::Exception;
701da8c4 10use Carp::Clan qw/^DBIx::Class/;
ed7ab0f4 11use Try::Tiny;
6da5894c 12
9c992ba1 13use base qw/DBIx::Class/;
9c992ba1 14
aa1088bf 15__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
16 _columns _primaries _unique_constraints name resultset_attributes
acbe81cf 17 schema from _relationships column_info_from_storage source_info
f89bb832 18 source_name sqlt_deploy_callback/);
aa1088bf 19
fac560c2 20__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
b0dd0e03 21 result_class/);
9c992ba1 22
75d07914 23=head1 NAME
9c992ba1 24
25DBIx::Class::ResultSource - Result source object
26
27=head1 SYNOPSIS
28
16ccb4fe 29 # Create a table based result source, in a result class.
30
31 package MyDB::Schema::Result::Artist;
d88ecca6 32 use base qw/DBIx::Class::Core/;
16ccb4fe 33
16ccb4fe 34 __PACKAGE__->table('artist');
35 __PACKAGE__->add_columns(qw/ artistid name /);
36 __PACKAGE__->set_primary_key('artistid');
37 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
38
39 1;
40
41 # Create a query (view) based result source, in a result class
42 package MyDB::Schema::Result::Year2000CDs;
d88ecca6 43 use base qw/DBIx::Class::Core/;
16ccb4fe 44
d88ecca6 45 __PACKAGE__->load_components('InflateColumn::DateTime');
16ccb4fe 46 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
47
48 __PACKAGE__->table('year2000cds');
49 __PACKAGE__->result_source_instance->is_virtual(1);
50 __PACKAGE__->result_source_instance->view_definition(
51 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
52 );
53
54
9c992ba1 55=head1 DESCRIPTION
56
16ccb4fe 57A ResultSource is an object that represents a source of data for querying.
58
59This class is a base class for various specialised types of result
60sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
61default result source type, so one is created for you when defining a
62result class as described in the synopsis above.
63
d88ecca6 64More specifically, the L<DBIx::Class::Core> base class pulls in the
65L<DBIx::Class::ResultSourceProxy::Table> component, which defines
66the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
67When called, C<table> creates and stores an instance of
16ccb4fe 68L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
69sources, you don't need to remember any of this.
70
71Result sources representing select queries, or views, can also be
72created, see L<DBIx::Class::ResultSource::View> for full details.
73
74=head2 Finding result source objects
75
76As mentioned above, a result source instance is created and stored for
77you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
78
79You can retrieve the result source at runtime in the following ways:
80
81=over
82
83=item From a Schema object:
84
85 $schema->source($source_name);
86
87=item From a Row object:
9c992ba1 88
16ccb4fe 89 $row->result_source;
90
91=item From a ResultSet object:
92
93 $rs->result_source;
94
95=back
00be2e0b 96
9c992ba1 97=head1 METHODS
98
7eb4ecc8 99=pod
100
9c992ba1 101=cut
102
103sub new {
104 my ($class, $attrs) = @_;
105 $class = ref $class if ref $class;
04786a4c 106
6b051e14 107 my $new = bless { %{$attrs || {}} }, $class;
9c992ba1 108 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
5ac6a044 109 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
6da5894c 110 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
111 $new->{_columns} = { %{$new->{_columns}||{}} };
112 $new->{_relationships} = { %{$new->{_relationships}||{}} };
9c992ba1 113 $new->{name} ||= "!!NAME NOT SET!!";
5afa2a15 114 $new->{_columns_info_loaded} ||= 0;
f89bb832 115 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
9c992ba1 116 return $new;
117}
118
988bf309 119=pod
120
5ac6a044 121=head2 add_columns
122
391ccf38 123=over
124
125=item Arguments: @columns
126
127=item Return value: The ResultSource object
128
129=back
130
843f6bc1 131 $source->add_columns(qw/col1 col2 col3/);
5ac6a044 132
843f6bc1 133 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
5ac6a044 134
16ccb4fe 135Adds columns to the result source. If supplied colname => hashref
136pairs, uses the hashref as the L</column_info> for that column. Repeated
137calls of this method will add more columns, not replace them.
5ac6a044 138
5d9d9e87 139The column names given will be created as accessor methods on your
7e51afbf 140L<DBIx::Class::Row> objects. You can change the name of the accessor
5d9d9e87 141by supplying an L</accessor> in the column_info hash.
142
157ce0cf 143If a column name beginning with a plus sign ('+col1') is provided, the
144attributes provided will be merged with any existing attributes for the
145column, with the new attributes taking precedence in the case that an
146attribute already exists. Using this without a hashref
147(C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
148it does the same thing it would do without the plus.
149
2053ab2a 150The contents of the column_info are not set in stone. The following
151keys are currently recognised/used by DBIx::Class:
988bf309 152
153=over 4
154
75d07914 155=item accessor
988bf309 156
16ccb4fe 157 { accessor => '_name' }
158
159 # example use, replace standard accessor with one of your own:
160 sub name {
161 my ($self, $value) = @_;
162
163 die "Name cannot contain digits!" if($value =~ /\d/);
164 $self->_name($value);
165
166 return $self->_name();
167 }
168
5d9d9e87 169Use this to set the name of the accessor method for this column. If unset,
988bf309 170the name of the column will be used.
171
172=item data_type
173
16ccb4fe 174 { data_type => 'integer' }
175
176This contains the column type. It is automatically filled if you use the
177L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
178L<DBIx::Class::Schema::Loader> module.
988bf309 179
2053ab2a 180Currently there is no standard set of values for the data_type. Use
181whatever your database supports.
988bf309 182
183=item size
184
16ccb4fe 185 { size => 20 }
186
988bf309 187The length of your column, if it is a column type that can have a size
16ccb4fe 188restriction. This is currently only used to create tables from your
189schema, see L<DBIx::Class::Schema/deploy>.
988bf309 190
191=item is_nullable
192
16ccb4fe 193 { is_nullable => 1 }
194
195Set this to a true value for a columns that is allowed to contain NULL
196values, default is false. This is currently only used to create tables
197from your schema, see L<DBIx::Class::Schema/deploy>.
988bf309 198
199=item is_auto_increment
200
16ccb4fe 201 { is_auto_increment => 1 }
202
2053ab2a 203Set this to a true value for a column whose value is somehow
16ccb4fe 204automatically set, defaults to false. This is used to determine which
205columns to empty when cloning objects using
206L<DBIx::Class::Row/copy>. It is also used by
d7be2784 207L<DBIx::Class::Schema/deploy>.
988bf309 208
26a29815 209=item is_numeric
210
16ccb4fe 211 { is_numeric => 1 }
212
26a29815 213Set this to a true or false value (not C<undef>) to explicitly specify
214if this column contains numeric data. This controls how set_column
215decides whether to consider a column dirty after an update: if
0bad1823 216C<is_numeric> is true a numeric comparison C<< != >> will take place
26a29815 217instead of the usual C<eq>
218
219If not specified the storage class will attempt to figure this out on
220first access to the column, based on the column C<data_type>. The
221result will be cached in this attribute.
222
988bf309 223=item is_foreign_key
224
16ccb4fe 225 { is_foreign_key => 1 }
226
2053ab2a 227Set this to a true value for a column that contains a key from a
16ccb4fe 228foreign table, defaults to false. This is currently only used to
229create tables from your schema, see L<DBIx::Class::Schema/deploy>.
988bf309 230
231=item default_value
232
16ccb4fe 233 { default_value => \'now()' }
234
235Set this to the default value which will be inserted into a column by
236the database. Can contain either a value or a function (use a
4858fea7 237reference to a scalar e.g. C<\'now()'> if you want a function). This
16ccb4fe 238is currently only used to create tables from your schema, see
239L<DBIx::Class::Schema/deploy>.
988bf309 240
a4fcda00 241See the note on L<DBIx::Class::Row/new> for more information about possible
242issues related to db-side default values.
243
988bf309 244=item sequence
245
16ccb4fe 246 { sequence => 'my_table_seq' }
247
2053ab2a 248Set this on a primary key column to the name of the sequence used to
249generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
250will attempt to retrieve the name of the sequence from the database
251automatically.
988bf309 252
838ef78d 253=item auto_nextval
254
ca791b95 255Set this to a true value for a column whose value is retrieved automatically
256from a sequence or function (if supported by your Storage driver.) For a
257sequence, if you do not use a trigger to get the nextval, you have to set the
258L</sequence> value as well.
259
260Also set this for MSSQL columns with the 'uniqueidentifier'
e1958268 261L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
262automatically generate using C<NEWID()>, unless they are a primary key in which
263case this will be done anyway.
838ef78d 264
190615a7 265=item extra
d7be2784 266
267This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
190615a7 268to add extra non-generic data to the column. For example: C<< extra
d7be2784 269=> { unsigned => 1} >> is used by the MySQL producer to set an integer
270column to unsigned. For more details, see
271L<SQL::Translator::Producer::MySQL>.
272
988bf309 273=back
274
5ac6a044 275=head2 add_column
276
391ccf38 277=over
278
16ccb4fe 279=item Arguments: $colname, \%columninfo?
391ccf38 280
281=item Return value: 1/0 (true/false)
282
283=back
284
16ccb4fe 285 $source->add_column('col' => \%info);
5ac6a044 286
391ccf38 287Add a single column and optional column info. Uses the same column
288info keys as L</add_columns>.
5ac6a044 289
290=cut
291
9c992ba1 292sub add_columns {
293 my ($self, @cols) = @_;
8e04bf91 294 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
002a359a 295
20518cb4 296 my @added;
297 my $columns = $self->_columns;
9c992ba1 298 while (my $col = shift @cols) {
157ce0cf 299 my $column_info = {};
300 if ($col =~ s/^\+//) {
301 $column_info = $self->column_info($col);
302 }
303
8e04bf91 304 # If next entry is { ... } use that for the column info, if not
305 # use an empty hashref
157ce0cf 306 if (ref $cols[0]) {
307 my $new_info = shift(@cols);
308 %$column_info = (%$column_info, %$new_info);
309 }
20518cb4 310 push(@added, $col) unless exists $columns->{$col};
20518cb4 311 $columns->{$col} = $column_info;
9c992ba1 312 }
20518cb4 313 push @{ $self->_ordered_columns }, @added;
30126ac7 314 return $self;
9c992ba1 315}
316
b25e9fa0 317sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
9c992ba1 318
3842b955 319=head2 has_column
320
391ccf38 321=over
322
323=item Arguments: $colname
324
325=item Return value: 1/0 (true/false)
326
327=back
328
843f6bc1 329 if ($source->has_column($colname)) { ... }
988bf309 330
2053ab2a 331Returns true if the source has a column of this name, false otherwise.
988bf309 332
333=cut
9c992ba1 334
335sub has_column {
336 my ($self, $column) = @_;
337 return exists $self->_columns->{$column};
338}
339
87c4e602 340=head2 column_info
9c992ba1 341
391ccf38 342=over
343
344=item Arguments: $colname
345
346=item Return value: Hashref of info
347
348=back
349
843f6bc1 350 my $info = $source->column_info($col);
9c992ba1 351
391ccf38 352Returns the column metadata hashref for a column, as originally passed
16ccb4fe 353to L</add_columns>. See L</add_columns> above for information on the
354contents of the hashref.
9c992ba1 355
988bf309 356=cut
9c992ba1 357
358sub column_info {
359 my ($self, $column) = @_;
75d07914 360 $self->throw_exception("No such column $column")
701da8c4 361 unless exists $self->_columns->{$column};
5afa2a15 362 #warn $self->{_columns_info_loaded}, "\n";
75d07914 363 if ( ! $self->_columns->{$column}{data_type}
6eda9bcf 364 and $self->column_info_from_storage
75d07914 365 and ! $self->{_columns_info_loaded}
8e04bf91 366 and $self->schema and $self->storage )
367 {
368 $self->{_columns_info_loaded}++;
d51f93c8 369 my $info = {};
370 my $lc_info = {};
52b420dd 371
ed7ab0f4 372 # try for the case of storage without table
52b420dd 373 try {
374 $info = $self->storage->columns_info_for( $self->from );
0b88a5bb 375 for my $realcol ( keys %{$info} ) {
376 $lc_info->{lc $realcol} = $info->{$realcol};
377 }
8e04bf91 378 foreach my $col ( keys %{$self->_columns} ) {
d51f93c8 379 $self->_columns->{$col} = {
380 %{ $self->_columns->{$col} },
381 %{ $info->{$col} || $lc_info->{lc $col} || {} }
382 };
a953d8d9 383 }
52b420dd 384 };
a953d8d9 385 }
9c992ba1 386 return $self->_columns->{$column};
387}
388
389=head2 columns
390
391ccf38 391=over
392
393=item Arguments: None
394
395=item Return value: Ordered list of column names
396
397=back
398
399 my @column_names = $source->columns;
20518cb4 400
391ccf38 401Returns all column names in the order they were declared to L</add_columns>.
87f0da6a 402
403=cut
9c992ba1 404
405sub columns {
8e04bf91 406 my $self = shift;
aa1088bf 407 $self->throw_exception(
408 "columns() is a read-only accessor, did you mean add_columns()?"
9851dada 409 ) if @_;
701da8c4 410 return @{$self->{_ordered_columns}||[]};
571dced3 411}
412
002a359a 413=head2 remove_columns
414
391ccf38 415=over
002a359a 416
391ccf38 417=item Arguments: @colnames
418
419=item Return value: undefined
420
421=back
422
423 $source->remove_columns(qw/col1 col2 col3/);
424
425Removes the given list of columns by name, from the result source.
426
427B<Warning>: Removing a column that is also used in the sources primary
428key, or in one of the sources unique constraints, B<will> result in a
429broken result source.
002a359a 430
431=head2 remove_column
432
391ccf38 433=over
434
435=item Arguments: $colname
436
437=item Return value: undefined
438
439=back
002a359a 440
391ccf38 441 $source->remove_column('col');
442
443Remove a single column by name from the result source, similar to
444L</remove_columns>.
445
446B<Warning>: Removing a column that is also used in the sources primary
447key, or in one of the sources unique constraints, B<will> result in a
448broken result source.
002a359a 449
450=cut
451
452sub remove_columns {
4738027b 453 my ($self, @to_remove) = @_;
002a359a 454
4738027b 455 my $columns = $self->_columns
456 or return;
002a359a 457
4738027b 458 my %to_remove;
459 for (@to_remove) {
a918d901 460 delete $columns->{$_};
4738027b 461 ++$to_remove{$_};
462 }
002a359a 463
4738027b 464 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
002a359a 465}
466
b25e9fa0 467sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
002a359a 468
87c4e602 469=head2 set_primary_key
470
27f01d1f 471=over 4
472
ebc77b53 473=item Arguments: @cols
27f01d1f 474
391ccf38 475=item Return value: undefined
476
27f01d1f 477=back
87f0da6a 478
16ccb4fe 479Defines one or more columns as primary key for this source. Must be
391ccf38 480called after L</add_columns>.
87f0da6a 481
391ccf38 482Additionally, defines a L<unique constraint|add_unique_constraint>
483named C<primary>.
87f0da6a 484
90f250bc 485Note: you normally do want to define a primary key on your sources
486B<even if the underlying database table does not have a primary key>.
487See
488L<DBIx::Class::Intro/The Significance and Importance of Primary Keys>
489for more info.
988bf309 490
87f0da6a 491=cut
9c992ba1 492
493sub set_primary_key {
494 my ($self, @cols) = @_;
495 # check if primary key columns are valid columns
8e04bf91 496 foreach my $col (@cols) {
497 $self->throw_exception("No such column $col on table " . $self->name)
498 unless $self->has_column($col);
9c992ba1 499 }
500 $self->_primaries(\@cols);
87f0da6a 501
502 $self->add_unique_constraint(primary => \@cols);
9c992ba1 503}
504
87f0da6a 505=head2 primary_columns
506
391ccf38 507=over 4
508
509=item Arguments: None
510
511=item Return value: Ordered list of primary column names
512
513=back
514
515Read-only accessor which returns the list of primary keys, supplied by
516L</set_primary_key>.
30126ac7 517
87f0da6a 518=cut
9c992ba1 519
520sub primary_columns {
521 return @{shift->_primaries||[]};
522}
523
b1d8e3fd 524# a helper method that will automatically die with a descriptive message if
525# no pk is defined on the source in question. For internal use to save
526# on if @pks... boilerplate
e8fb771b 527sub _pri_cols {
528 my $self = shift;
529 my @pcols = $self->primary_columns
530 or $self->throw_exception (sprintf(
455a33cb 531 "Operation requires a primary key to be declared on '%s' via set_primary_key",
532 $self->source_name,
e8fb771b 533 ));
534 return @pcols;
535}
536
87f0da6a 537=head2 add_unique_constraint
538
391ccf38 539=over 4
540
16ccb4fe 541=item Arguments: $name?, \@colnames
391ccf38 542
543=item Return value: undefined
544
545=back
546
87f0da6a 547Declare a unique constraint on this source. Call once for each unique
58b5bb8c 548constraint.
27f01d1f 549
550 # For UNIQUE (column1, column2)
551 __PACKAGE__->add_unique_constraint(
552 constraint_name => [ qw/column1 column2/ ],
553 );
87f0da6a 554
368a5228 555Alternatively, you can specify only the columns:
556
557 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
558
16ccb4fe 559This will result in a unique constraint named
560C<table_column1_column2>, where C<table> is replaced with the table
561name.
368a5228 562
16ccb4fe 563Unique constraints are used, for example, when you pass the constraint
564name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
565only columns in the constraint are searched.
58b5bb8c 566
391ccf38 567Throws an error if any of the given column names do not yet exist on
568the result source.
569
87f0da6a 570=cut
571
572sub add_unique_constraint {
368a5228 573 my $self = shift;
574 my $cols = pop @_;
575 my $name = shift;
576
577 $name ||= $self->name_unique_constraint($cols);
87f0da6a 578
8e04bf91 579 foreach my $col (@$cols) {
580 $self->throw_exception("No such column $col on table " . $self->name)
581 unless $self->has_column($col);
87f0da6a 582 }
583
584 my %unique_constraints = $self->unique_constraints;
585 $unique_constraints{$name} = $cols;
586 $self->_unique_constraints(\%unique_constraints);
587}
588
d9c74322 589=head2 name_unique_constraint
368a5228 590
391ccf38 591=over 4
592
593=item Arguments: @colnames
594
595=item Return value: Constraint name
596
597=back
598
599 $source->table('mytable');
600 $source->name_unique_constraint('col1', 'col2');
601 # returns
602 'mytable_col1_col2'
603
604Return a name for a unique constraint containing the specified
605columns. The name is created by joining the table name and each column
606name, using an underscore character.
368a5228 607
608For example, a constraint on a table named C<cd> containing the columns
609C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
610
391ccf38 611This is used by L</add_unique_constraint> if you do not specify the
612optional constraint name.
613
368a5228 614=cut
615
616sub name_unique_constraint {
617 my ($self, $cols) = @_;
618
3e6c1131 619 my $name = $self->name;
4678e9da 620 $name = $$name if (ref $name eq 'SCALAR');
3e6c1131 621
622 return join '_', $name, @$cols;
368a5228 623}
624
87f0da6a 625=head2 unique_constraints
626
391ccf38 627=over 4
628
629=item Arguments: None
630
631=item Return value: Hash of unique constraint data
632
633=back
634
635 $source->unique_constraints();
636
16ccb4fe 637Read-only accessor which returns a hash of unique constraints on this
638source.
391ccf38 639
640The hash is keyed by constraint name, and contains an arrayref of
641column names as values.
87f0da6a 642
643=cut
644
645sub unique_constraints {
646 return %{shift->_unique_constraints||{}};
647}
648
e6a0e17c 649=head2 unique_constraint_names
650
391ccf38 651=over 4
652
653=item Arguments: None
654
655=item Return value: Unique constraint names
656
657=back
658
659 $source->unique_constraint_names();
660
e6a0e17c 661Returns the list of unique constraint names defined on this source.
662
663=cut
664
665sub unique_constraint_names {
666 my ($self) = @_;
667
668 my %unique_constraints = $self->unique_constraints;
669
670 return keys %unique_constraints;
671}
672
673=head2 unique_constraint_columns
674
391ccf38 675=over 4
676
677=item Arguments: $constraintname
678
679=item Return value: List of constraint columns
680
681=back
682
683 $source->unique_constraint_columns('myconstraint');
684
e6a0e17c 685Returns the list of columns that make up the specified unique constraint.
686
687=cut
688
689sub unique_constraint_columns {
690 my ($self, $constraint_name) = @_;
691
692 my %unique_constraints = $self->unique_constraints;
693
694 $self->throw_exception(
695 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
696 ) unless exists $unique_constraints{$constraint_name};
697
698 return @{ $unique_constraints{$constraint_name} };
699}
700
880c075b 701=head2 sqlt_deploy_callback
702
703=over
704
705=item Arguments: $callback
706
707=back
708
709 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
710
711An accessor to set a callback to be called during deployment of
712the schema via L<DBIx::Class::Schema/create_ddl_dir> or
713L<DBIx::Class::Schema/deploy>.
714
715The callback can be set as either a code reference or the name of a
716method in the current result class.
717
718If not set, the L</default_sqlt_deploy_hook> is called.
719
720Your callback will be passed the $source object representing the
721ResultSource instance being deployed, and the
722L<SQL::Translator::Schema::Table> object being created from it. The
723callback can be used to manipulate the table object or add your own
724customised indexes. If you need to manipulate a non-table object, use
725the L<DBIx::Class::Schema/sqlt_deploy_hook>.
726
727See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
728Your SQL> for examples.
729
730This sqlt deployment callback can only be used to manipulate
731SQL::Translator objects as they get turned into SQL. To execute
732post-deploy statements which SQL::Translator does not currently
733handle, override L<DBIx::Class::Schema/deploy> in your Schema class
734and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
735
736=head2 default_sqlt_deploy_hook
737
738=over
739
740=item Arguments: $source, $sqlt_table
741
742=item Return value: undefined
743
744=back
745
746This is the sensible default for L</sqlt_deploy_callback>.
747
748If a method named C<sqlt_deploy_hook> exists in your Result class, it
749will be called and passed the current C<$source> and the
750C<$sqlt_table> being deployed.
751
752=cut
753
754sub default_sqlt_deploy_hook {
755 my $self = shift;
756
757 my $class = $self->result_class;
758
759 if ($class and $class->can('sqlt_deploy_hook')) {
760 $class->sqlt_deploy_hook(@_);
761 }
762}
763
764sub _invoke_sqlt_deploy_hook {
765 my $self = shift;
766 if ( my $hook = $self->sqlt_deploy_callback) {
767 $self->$hook(@_);
768 }
769}
770
843f6bc1 771=head2 resultset
772
773=over 4
774
775=item Arguments: None
776
777=item Return value: $resultset
778
779=back
780
781Returns a resultset for the given source. This will initially be created
782on demand by calling
783
784 $self->resultset_class->new($self, $self->resultset_attributes)
785
786but is cached from then on unless resultset_class changes.
787
788=head2 resultset_class
789
790=over 4
791
792=item Arguments: $classname
793
794=item Return value: $classname
795
796=back
797
16ccb4fe 798 package My::Schema::ResultSet::Artist;
843f6bc1 799 use base 'DBIx::Class::ResultSet';
800 ...
801
16ccb4fe 802 # In the result class
803 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
804
805 # Or in code
806 $source->resultset_class('My::Schema::ResultSet::Artist');
843f6bc1 807
7e51afbf 808Set the class of the resultset. This is useful if you want to create your
843f6bc1 809own resultset methods. Create your own class derived from
810L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
811this method returns the name of the existing resultset class, if one
812exists.
813
814=head2 resultset_attributes
815
816=over 4
817
818=item Arguments: \%attrs
819
820=item Return value: \%attrs
821
822=back
823
16ccb4fe 824 # In the result class
825 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
826
827 # Or in code
843f6bc1 828 $source->resultset_attributes({ order_by => [ 'id' ] });
829
830Store a collection of resultset attributes, that will be set on every
831L<DBIx::Class::ResultSet> produced from this result source. For a full
832list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
833
834=cut
835
836sub resultset {
837 my $self = shift;
838 $self->throw_exception(
839 'resultset does not take any arguments. If you want another resultset, '.
840 'call it on the schema instead.'
841 ) if scalar @_;
842
843 return $self->resultset_class->new(
844 $self,
845 {
846 %{$self->{resultset_attributes}},
847 %{$self->schema->default_resultset_attributes}
848 },
849 );
850}
851
852=head2 source_name
853
854=over 4
855
856=item Arguments: $source_name
857
858=item Result value: $source_name
859
860=back
861
862Set an alternate name for the result source when it is loaded into a schema.
863This is useful if you want to refer to a result source by a name other than
864its class name.
865
866 package ArchivedBooks;
867 use base qw/DBIx::Class/;
868 __PACKAGE__->table('books_archive');
869 __PACKAGE__->source_name('Books');
870
871 # from your schema...
872 $schema->resultset('Books')->find(1);
873
9c992ba1 874=head2 from
875
391ccf38 876=over 4
877
878=item Arguments: None
879
880=item Return value: FROM clause
881
882=back
883
884 my $from_clause = $source->from();
885
9c992ba1 886Returns an expression of the source to be supplied to storage to specify
2053ab2a 887retrieval from this source. In the case of a database, the required FROM
888clause contents.
9c992ba1 889
f9b7bd6e 890=head2 schema
891
391ccf38 892=over 4
893
894=item Arguments: None
895
896=item Return value: A schema object
897
898=back
899
900 my $schema = $source->schema();
901
f9b7bd6e 902Returns the L<DBIx::Class::Schema> object that this result source
391ccf38 903belongs to.
9c992ba1 904
905=head2 storage
906
391ccf38 907=over 4
908
909=item Arguments: None
910
911=item Return value: A Storage object
912
913=back
914
915 $source->storage->debug(1);
916
75d07914 917Returns the storage handle for the current schema.
988bf309 918
919See also: L<DBIx::Class::Storage>
9c992ba1 920
921=cut
922
923sub storage { shift->schema->storage; }
924
8452e496 925=head2 add_relationship
926
391ccf38 927=over 4
928
929=item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
930
931=item Return value: 1/true if it succeeded
932
933=back
934
8452e496 935 $source->add_relationship('relname', 'related_source', $cond, $attrs);
936
391ccf38 937L<DBIx::Class::Relationship> describes a series of methods which
938create pre-defined useful types of relationships. Look there first
939before using this method directly.
940
24d67825 941The relationship name can be arbitrary, but must be unique for each
942relationship attached to this result source. 'related_source' should
943be the name with which the related result source was registered with
944the current schema. For example:
8452e496 945
24d67825 946 $schema->source('Book')->add_relationship('reviews', 'Review', {
947 'foreign.book_id' => 'self.id',
948 });
949
2053ab2a 950The condition C<$cond> needs to be an L<SQL::Abstract>-style
24d67825 951representation of the join between the tables. For example, if you're
391ccf38 952creating a relation from Author to Book,
988bf309 953
954 { 'foreign.author_id' => 'self.id' }
955
956will result in the JOIN clause
957
958 author me JOIN book foreign ON foreign.author_id = me.id
959
8452e496 960You can specify as many foreign => self mappings as necessary.
961
988bf309 962Valid attributes are as follows:
963
964=over 4
965
966=item join_type
967
968Explicitly specifies the type of join to use in the relationship. Any
969SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
970the SQL command immediately before C<JOIN>.
971
972=item proxy
973
24d67825 974An arrayref containing a list of accessors in the foreign class to proxy in
975the main class. If, for example, you do the following:
002a359a 976
24d67825 977 CD->might_have(liner_notes => 'LinerNotes', undef, {
978 proxy => [ qw/notes/ ],
979 });
002a359a 980
24d67825 981Then, assuming LinerNotes has an accessor named notes, you can do:
988bf309 982
24d67825 983 my $cd = CD->find(1);
2053ab2a 984 # set notes -- LinerNotes object is created if it doesn't exist
985 $cd->notes('Notes go here');
988bf309 986
987=item accessor
988
989Specifies the type of accessor that should be created for the
75d07914 990relationship. Valid values are C<single> (for when there is only a single
991related object), C<multi> (when there can be many), and C<filter> (for
992when there is a single related object, but you also want the relationship
993accessor to double as a column accessor). For C<multi> accessors, an
994add_to_* method is also created, which calls C<create_related> for the
988bf309 995relationship.
996
8452e496 997=back
998
391ccf38 999Throws an exception if the condition is improperly supplied, or cannot
6d0ee587 1000be resolved.
391ccf38 1001
8452e496 1002=cut
1003
1004sub add_relationship {
1005 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
27f01d1f 1006 $self->throw_exception("Can't create relationship without join condition")
1007 unless $cond;
8452e496 1008 $attrs ||= {};
87772e46 1009
eba322a7 1010 # Check foreign and self are right in cond
1011 if ( (ref $cond ||'') eq 'HASH') {
1012 for (keys %$cond) {
1013 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1014 if /\./ && !/^foreign\./;
1015 }
1016 }
1017
8452e496 1018 my %rels = %{ $self->_relationships };
1019 $rels{$rel} = { class => $f_source_name,
87772e46 1020 source => $f_source_name,
8452e496 1021 cond => $cond,
1022 attrs => $attrs };
1023 $self->_relationships(\%rels);
1024
30126ac7 1025 return $self;
87772e46 1026
52b420dd 1027# XXX disabled. doesn't work properly currently. skip in tests.
953a18ef 1028
8452e496 1029 my $f_source = $self->schema->source($f_source_name);
1030 unless ($f_source) {
c037c03a 1031 $self->ensure_class_loaded($f_source_name);
8452e496 1032 $f_source = $f_source_name->result_source;
87772e46 1033 #my $s_class = ref($self->schema);
1034 #$f_source_name =~ m/^${s_class}::(.*)$/;
1035 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1036 #$f_source = $self->schema->source($f_source_name);
8452e496 1037 }
1038 return unless $f_source; # Can't test rel without f_source
1039
ed7ab0f4 1040 try { $self->_resolve_join($rel, 'me', {}, []) }
1041 catch {
1042 # If the resolve failed, back out and re-throw the error
52b420dd 1043 delete $rels{$rel};
8452e496 1044 $self->_relationships(\%rels);
ed7ab0f4 1045 $self->throw_exception("Error creating relationship $rel: $_");
1046 };
52b420dd 1047
8452e496 1048 1;
1049}
1050
87c4e602 1051=head2 relationships
8452e496 1052
391ccf38 1053=over 4
1054
1055=item Arguments: None
1056
1057=item Return value: List of relationship names
1058
1059=back
1060
1061 my @relnames = $source->relationships();
1062
2053ab2a 1063Returns all relationship names for this source.
8452e496 1064
1065=cut
1066
1067sub relationships {
1068 return keys %{shift->_relationships};
1069}
1070
87c4e602 1071=head2 relationship_info
1072
27f01d1f 1073=over 4
1074
ebc77b53 1075=item Arguments: $relname
27f01d1f 1076
391ccf38 1077=item Return value: Hashref of relation data,
1078
27f01d1f 1079=back
8452e496 1080
2053ab2a 1081Returns a hash of relationship information for the specified relationship
391ccf38 1082name. The keys/values are as specified for L</add_relationship>.
8452e496 1083
1084=cut
1085
1086sub relationship_info {
1087 my ($self, $rel) = @_;
1088 return $self->_relationships->{$rel};
75d07914 1089}
8452e496 1090
87c4e602 1091=head2 has_relationship
1092
27f01d1f 1093=over 4
1094
ebc77b53 1095=item Arguments: $rel
27f01d1f 1096
391ccf38 1097=item Return value: 1/0 (true/false)
1098
27f01d1f 1099=back
953a18ef 1100
2053ab2a 1101Returns true if the source has a relationship of this name, false otherwise.
988bf309 1102
1103=cut
953a18ef 1104
1105sub has_relationship {
1106 my ($self, $rel) = @_;
1107 return exists $self->_relationships->{$rel};
1108}
1109
de60a93d 1110=head2 reverse_relationship_info
1111
1112=over 4
1113
1114=item Arguments: $relname
1115
391ccf38 1116=item Return value: Hashref of relationship data
1117
de60a93d 1118=back
1119
391ccf38 1120Looks through all the relationships on the source this relationship
1121points to, looking for one whose condition is the reverse of the
1122condition on this relationship.
1123
1124A common use of this is to find the name of the C<belongs_to> relation
1125opposing a C<has_many> relation. For definition of these look in
1126L<DBIx::Class::Relationship>.
1127
1128The returned hashref is keyed by the name of the opposing
faaba25f 1129relationship, and contains its data in the same manner as
391ccf38 1130L</relationship_info>.
de60a93d 1131
1132=cut
1133
1134sub reverse_relationship_info {
1135 my ($self, $rel) = @_;
1136 my $rel_info = $self->relationship_info($rel);
1137 my $ret = {};
1138
1139 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1140
1141 my @cond = keys(%{$rel_info->{cond}});
1142 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1143 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
bab77431 1144
de60a93d 1145 # Get the related result source for this relationship
1146 my $othertable = $self->related_source($rel);
1147
1148 # Get all the relationships for that source that related to this source
1149 # whose foreign column set are our self columns on $rel and whose self
bab77431 1150 # columns are our foreign columns on $rel.
de60a93d 1151 my @otherrels = $othertable->relationships();
1152 my $otherrelationship;
1153 foreach my $otherrel (@otherrels) {
1154 my $otherrel_info = $othertable->relationship_info($otherrel);
1155
1156 my $back = $othertable->related_source($otherrel);
f3fb2641 1157 next unless $back->source_name eq $self->source_name;
de60a93d 1158
1159 my @othertestconds;
1160
1161 if (ref $otherrel_info->{cond} eq 'HASH') {
1162 @othertestconds = ($otherrel_info->{cond});
1163 }
1164 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1165 @othertestconds = @{$otherrel_info->{cond}};
1166 }
1167 else {
1168 next;
1169 }
1170
1171 foreach my $othercond (@othertestconds) {
1172 my @other_cond = keys(%$othercond);
1173 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1174 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
6d0ee587 1175 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1176 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
de60a93d 1177 $ret->{$otherrel} = $otherrel_info;
1178 }
1179 }
1180 return $ret;
1181}
1182
de60a93d 1183sub compare_relationship_keys {
6d0ee587 1184 carp 'compare_relationship_keys is a private method, stop calling it';
1185 my $self = shift;
1186 $self->_compare_relationship_keys (@_);
1187}
1188
1189# Returns true if both sets of keynames are the same, false otherwise.
1190sub _compare_relationship_keys {
de60a93d 1191 my ($self, $keys1, $keys2) = @_;
1192
1193 # Make sure every keys1 is in keys2
1194 my $found;
1195 foreach my $key (@$keys1) {
1196 $found = 0;
1197 foreach my $prim (@$keys2) {
1198 if ($prim eq $key) {
1199 $found = 1;
1200 last;
1201 }
1202 }
1203 last unless $found;
1204 }
1205
1206 # Make sure every key2 is in key1
1207 if ($found) {
1208 foreach my $prim (@$keys2) {
1209 $found = 0;
1210 foreach my $key (@$keys1) {
1211 if ($prim eq $key) {
1212 $found = 1;
1213 last;
1214 }
1215 }
1216 last unless $found;
1217 }
1218 }
1219
1220 return $found;
1221}
1222
6d0ee587 1223# Returns the {from} structure used to express JOIN conditions
1224sub _resolve_join {
8a3fa4ae 1225 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1979278e 1226
1227 # we need a supplied one, because we do in-place modifications, no returns
6d0ee587 1228 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
88a66388 1229 unless ref $seen eq 'HASH';
1979278e 1230
88a66388 1231 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1232 unless ref $jpath eq 'ARRAY';
1233
38f42d85 1234 $jpath = [@$jpath]; # copy
1979278e 1235
8a3fa4ae 1236 if (not defined $join) {
1237 return ();
1238 }
1239 elsif (ref $join eq 'ARRAY') {
caac1708 1240 return
1241 map {
8a3fa4ae 1242 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
caac1708 1243 } @$join;
8a3fa4ae 1244 }
1245 elsif (ref $join eq 'HASH') {
1246
1247 my @ret;
1248 for my $rel (keys %$join) {
1249
1250 my $rel_info = $self->relationship_info($rel)
455a33cb 1251 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
8a3fa4ae 1252
1253 my $force_left = $parent_force_left;
1254 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1255
1256 # the actual seen value will be incremented by the recursion
6c0230de 1257 my $as = $self->storage->relname_to_table_alias(
1258 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1259 );
1979278e 1260
8a3fa4ae 1261 push @ret, (
1262 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1263 $self->related_source($rel)->_resolve_join(
38f42d85 1264 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
8a3fa4ae 1265 )
1266 );
1267 }
1268 return @ret;
096395af 1269
8a3fa4ae 1270 }
1271 elsif (ref $join) {
1272 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1273 }
1274 else {
489709af 1275 my $count = ++$seen->{$join};
6c0230de 1276 my $as = $self->storage->relname_to_table_alias(
1277 $join, ($count > 1 && $count)
1278 );
1979278e 1279
8a3fa4ae 1280 my $rel_info = $self->relationship_info($join)
455a33cb 1281 or $self->throw_exception("No such relationship $join on " . $self->source_name);
ba61fa2a 1282
1283 my $rel_src = $self->related_source($join);
1284 return [ { $as => $rel_src->from,
35ec0366 1285 -source_handle => $rel_src->handle,
8a3fa4ae 1286 -join_type => $parent_force_left
1287 ? 'left'
1288 : $rel_info->{attrs}{join_type}
1289 ,
38f42d85 1290 -join_path => [@$jpath, { $join => $as } ],
b82c8a28 1291 -is_single => (
1292 $rel_info->{attrs}{accessor}
1293 &&
1294 List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1295 ),
ba61fa2a 1296 -alias => $as,
1979278e 1297 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1298 },
6d0ee587 1299 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
953a18ef 1300 }
1301}
1302
370f2ba2 1303sub pk_depends_on {
6d0ee587 1304 carp 'pk_depends_on is a private method, stop calling it';
1305 my $self = shift;
1306 $self->_pk_depends_on (@_);
1307}
1308
1309# Determines whether a relation is dependent on an object from this source
1310# having already been inserted. Takes the name of the relationship and a
1311# hashref of columns of the related object.
1312sub _pk_depends_on {
370f2ba2 1313 my ($self, $relname, $rel_data) = @_;
370f2ba2 1314
c39b48e5 1315 my $relinfo = $self->relationship_info($relname);
1316
1317 # don't assume things if the relationship direction is specified
1318 return $relinfo->{attrs}{is_foreign_key_constraint}
1319 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1320
1321 my $cond = $relinfo->{cond};
370f2ba2 1322 return 0 unless ref($cond) eq 'HASH';
1323
1324 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
370f2ba2 1325 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1326
1327 # assume anything that references our PK probably is dependent on us
1328 # rather than vice versa, unless the far side is (a) defined or (b)
1329 # auto-increment
370f2ba2 1330 my $rel_source = $self->related_source($relname);
1331
1332 foreach my $p ($self->primary_columns) {
1333 if (exists $keyhash->{$p}) {
1334 unless (defined($rel_data->{$keyhash->{$p}})
1335 || $rel_source->column_info($keyhash->{$p})
1336 ->{is_auto_increment}) {
1337 return 0;
1338 }
1339 }
1340 }
1341
1342 return 1;
1343}
1344
6d0ee587 1345sub resolve_condition {
1346 carp 'resolve_condition is a private method, stop calling it';
1347 my $self = shift;
1348 $self->_resolve_condition (@_);
1349}
953a18ef 1350
6d0ee587 1351# Resolves the passed condition to a concrete query fragment. If given an alias,
1352# returns a join condition; if given an object, inverts that object to produce
1353# a related conditional from that object.
8c368cf3 1354our $UNRESOLVABLE_CONDITION = \'1 = 0';
1355
6d0ee587 1356sub _resolve_condition {
489709af 1357 my ($self, $cond, $as, $for) = @_;
953a18ef 1358 if (ref $cond eq 'HASH') {
1359 my %ret;
bd054cb4 1360 foreach my $k (keys %{$cond}) {
1361 my $v = $cond->{$k};
953a18ef 1362 # XXX should probably check these are valid columns
27f01d1f 1363 $k =~ s/^foreign\.// ||
75d07914 1364 $self->throw_exception("Invalid rel cond key ${k}");
27f01d1f 1365 $v =~ s/^self\.// ||
75d07914 1366 $self->throw_exception("Invalid rel cond val ${v}");
953a18ef 1367 if (ref $for) { # Object
3842b955 1368 #warn "$self $k $for $v";
370f2ba2 1369 unless ($for->has_column_loaded($v)) {
1370 if ($for->in_storage) {
8bbfe6b2 1371 $self->throw_exception(sprintf
5c89c897 1372 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1373 . 'loaded from storage (or not passed to new() prior to insert()). You '
1374 . 'probably need to call ->discard_changes to get the server-side defaults '
1375 . 'from the database.',
8bbfe6b2 1376 $as,
971beb94 1377 $for,
5c89c897 1378 $v,
a4fcda00 1379 );
370f2ba2 1380 }
68f3b0dd 1381 return $UNRESOLVABLE_CONDITION;
370f2ba2 1382 }
1383 $ret{$k} = $for->get_column($v);
1384 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
3842b955 1385 #warn %ret;
2c037e6b 1386 } elsif (!defined $for) { # undef, i.e. "no object"
1387 $ret{$k} = undef;
2ec8e594 1388 } elsif (ref $as eq 'HASH') { # reverse hashref
1389 $ret{$v} = $as->{$k};
fde6e28e 1390 } elsif (ref $as) { # reverse object
1391 $ret{$v} = $as->get_column($k);
2c037e6b 1392 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1393 $ret{$v} = undef;
953a18ef 1394 } else {
489709af 1395 $ret{"${as}.${k}"} = "${for}.${v}";
953a18ef 1396 }
953a18ef 1397 }
1398 return \%ret;
5efe4c79 1399 } elsif (ref $cond eq 'ARRAY') {
6d0ee587 1400 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
953a18ef 1401 } else {
35c77aa3 1402 die("Can't handle condition $cond yet :(");
87772e46 1403 }
1404}
1405
988bf309 1406
6d0ee587 1407# Accepts one or more relationships for the current source and returns an
1408# array of column names for each of those relationships. Column names are
1409# prefixed relative to the current source, in accordance with where they appear
38f42d85 1410# in the supplied relationships.
b3e8ac9b 1411
6d0ee587 1412sub _resolve_prefetch {
1979278e 1413 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1414 $pref_path ||= [];
1415
8a3fa4ae 1416 if (not defined $pre) {
1417 return ();
1418 }
1419 elsif( ref $pre eq 'ARRAY' ) {
0f66a01b 1420 return
6d0ee587 1421 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
0f66a01b 1422 @$pre;
b3e8ac9b 1423 }
1424 elsif( ref $pre eq 'HASH' ) {
1425 my @ret =
1426 map {
6d0ee587 1427 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1428 $self->related_source($_)->_resolve_prefetch(
1979278e 1429 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
0f66a01b 1430 } keys %$pre;
b3e8ac9b 1431 return @ret;
1432 }
1433 elsif( ref $pre ) {
a86b1efe 1434 $self->throw_exception(
1435 "don't know how to resolve prefetch reftype ".ref($pre));
b3e8ac9b 1436 }
1437 else {
1979278e 1438 my $p = $alias_map;
1439 $p = $p->{$_} for (@$pref_path, $pre);
1440
1441 $self->throw_exception (
5e8cb53c 1442 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1979278e 1443 . join (' -> ', @$pref_path, $pre)
1444 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
88a66388 1445
1979278e 1446 my $as = shift @{$p->{-join_aliases}};
1447
b3e8ac9b 1448 my $rel_info = $self->relationship_info( $pre );
455a33cb 1449 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
a86b1efe 1450 unless $rel_info;
37f23589 1451 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
a86b1efe 1452 my $rel_source = $self->related_source($pre);
0f66a01b 1453
b82c8a28 1454 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
0f66a01b 1455 $self->throw_exception(
1456 "Can't prefetch has_many ${pre} (join cond too complex)")
1457 unless ref($rel_info->{cond}) eq 'HASH';
cb136e67 1458 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1459 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1460 keys %{$collapse}) {
1461 my ($last) = ($fail =~ /([^\.]+)$/);
616b461d 1462 carp (
1463 "Prefetching multiple has_many rels ${last} and ${pre} "
1464 .(length($as_prefix)
1465 ? "at the same level (${as_prefix}) "
1466 : "at top level "
1467 )
2e251255 1468 . 'will explode the number of row objects retrievable via ->next or ->all. '
616b461d 1469 . 'Use at your own risk.'
1470 );
cb136e67 1471 }
b25e9fa0 1472 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1473 # values %{$rel_info->{cond}};
b1d8e3fd 1474 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
b25e9fa0 1475 # action at a distance. prepending the '.' allows simpler code
1476 # in ResultSet->_collapse_result
37f23589 1477 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
0f66a01b 1478 keys %{$rel_info->{cond}};
5a5bec6c 1479 my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
1480 ? @{$rel_info->{attrs}{order_by}}
b82c8a28 1481
1482 : (defined $rel_info->{attrs}{order_by}
5a5bec6c 1483 ? ($rel_info->{attrs}{order_by})
1484 : ()));
1485 push(@$order, map { "${as}.$_" } (@key, @ord));
0f66a01b 1486 }
1487
489709af 1488 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
a86b1efe 1489 $rel_source->columns;
b3e8ac9b 1490 }
1491}
953a18ef 1492
87c4e602 1493=head2 related_source
1494
27f01d1f 1495=over 4
1496
ebc77b53 1497=item Arguments: $relname
27f01d1f 1498
391ccf38 1499=item Return value: $source
1500
27f01d1f 1501=back
87772e46 1502
2053ab2a 1503Returns the result source object for the given relationship.
87772e46 1504
1505=cut
1506
1507sub related_source {
1508 my ($self, $rel) = @_;
aea52c85 1509 if( !$self->has_relationship( $rel ) ) {
455a33cb 1510 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
aea52c85 1511 }
87772e46 1512 return $self->schema->source($self->relationship_info($rel)->{source});
8452e496 1513}
1514
77254782 1515=head2 related_class
1516
27f01d1f 1517=over 4
1518
ebc77b53 1519=item Arguments: $relname
27f01d1f 1520
391ccf38 1521=item Return value: $classname
1522
27f01d1f 1523=back
77254782 1524
2053ab2a 1525Returns the class name for objects in the given relationship.
77254782 1526
1527=cut
1528
1529sub related_class {
1530 my ($self, $rel) = @_;
1531 if( !$self->has_relationship( $rel ) ) {
455a33cb 1532 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
77254782 1533 }
1534 return $self->schema->class($self->relationship_info($rel)->{source});
1535}
1536
aec3eff1 1537=head2 handle
1538
1539Obtain a new handle to this source. Returns an instance of a
1540L<DBIx::Class::ResultSourceHandle>.
1541
1542=cut
1543
1544sub handle {
24c349e8 1545 return DBIx::Class::ResultSourceHandle->new({
aec3eff1 1546 schema => $_[0]->schema,
3441fd57 1547 source_moniker => $_[0]->source_name
aec3eff1 1548 });
1549}
1550
701da8c4 1551=head2 throw_exception
1552
2053ab2a 1553See L<DBIx::Class::Schema/"throw_exception">.
701da8c4 1554
1555=cut
1556
1557sub throw_exception {
1558 my $self = shift;
1a58752c 1559
0b4926ce 1560 if (defined $self->schema) {
701da8c4 1561 $self->schema->throw_exception(@_);
1a58752c 1562 }
1563 else {
1564 DBIx::Class::Exception->throw(@_);
701da8c4 1565 }
1566}
1567
843f6bc1 1568=head2 source_info
d2f3e87b 1569
843f6bc1 1570Stores a hashref of per-source metadata. No specific key names
1571have yet been standardized, the examples below are purely hypothetical
1572and don't actually accomplish anything on their own:
391ccf38 1573
843f6bc1 1574 __PACKAGE__->source_info({
1575 "_tablespace" => 'fast_disk_array_3',
1576 "_engine" => 'InnoDB',
1577 });
391ccf38 1578
843f6bc1 1579=head2 new
391ccf38 1580
843f6bc1 1581 $class->new();
391ccf38 1582
843f6bc1 1583 $class->new({attribute_name => value});
d2f3e87b 1584
843f6bc1 1585Creates a new ResultSource object. Not normally called directly by end users.
391ccf38 1586
843f6bc1 1587=head2 column_info_from_storage
1588
1589=over
1590
1591=item Arguments: 1/0 (default: 0)
1592
1593=item Return value: 1/0
1594
1595=back
1596
880c075b 1597 __PACKAGE__->column_info_from_storage(1);
1598
843f6bc1 1599Enables the on-demand automatic loading of the above column
c1300297 1600metadata from storage as necessary. This is *deprecated*, and
843f6bc1 1601should not be used. It will be removed before 1.0.
1602
f89bb832 1603
9c992ba1 1604=head1 AUTHORS
1605
1606Matt S. Trout <mst@shadowcatsystems.co.uk>
1607
1608=head1 LICENSE
1609
1610You may distribute this code under the same terms as Perl itself.
1611
1612=cut
1613
b25e9fa0 16141;