1 package DBIx::Class::ResultSource;
6 use DBIx::Class::ResultSet;
7 use DBIx::Class::ResultSourceHandle;
9 use DBIx::Class::Exception;
10 use Carp::Clan qw/^DBIx::Class/;
12 use List::Util 'first';
13 use Scalar::Util qw/weaken isweak/;
14 use Storable qw/nfreeze thaw/;
17 use base qw/DBIx::Class/;
19 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
20 _columns _primaries _unique_constraints name resultset_attributes
21 schema from _relationships column_info_from_storage source_info
22 source_name sqlt_deploy_callback/);
24 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
29 DBIx::Class::ResultSource - Result source object
33 # Create a table based result source, in a result class.
35 package MyDB::Schema::Result::Artist;
36 use base qw/DBIx::Class::Core/;
38 __PACKAGE__->table('artist');
39 __PACKAGE__->add_columns(qw/ artistid name /);
40 __PACKAGE__->set_primary_key('artistid');
41 __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
45 # Create a query (view) based result source, in a result class
46 package MyDB::Schema::Result::Year2000CDs;
47 use base qw/DBIx::Class::Core/;
49 __PACKAGE__->load_components('InflateColumn::DateTime');
50 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
52 __PACKAGE__->table('year2000cds');
53 __PACKAGE__->result_source_instance->is_virtual(1);
54 __PACKAGE__->result_source_instance->view_definition(
55 "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
61 A ResultSource is an object that represents a source of data for querying.
63 This class is a base class for various specialised types of result
64 sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
65 default result source type, so one is created for you when defining a
66 result class as described in the synopsis above.
68 More specifically, the L<DBIx::Class::Core> base class pulls in the
69 L<DBIx::Class::ResultSourceProxy::Table> component, which defines
70 the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
71 When called, C<table> creates and stores an instance of
72 L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
73 sources, you don't need to remember any of this.
75 Result sources representing select queries, or views, can also be
76 created, see L<DBIx::Class::ResultSource::View> for full details.
78 =head2 Finding result source objects
80 As mentioned above, a result source instance is created and stored for
81 you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
83 You can retrieve the result source at runtime in the following ways:
87 =item From a Schema object:
89 $schema->source($source_name);
91 =item From a Row object:
95 =item From a ResultSet object:
108 my ($class, $attrs) = @_;
109 $class = ref $class if ref $class;
111 my $new = bless { %{$attrs || {}} }, $class;
112 $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
113 $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
114 $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
115 $new->{_columns} = { %{$new->{_columns}||{}} };
116 $new->{_relationships} = { %{$new->{_relationships}||{}} };
117 $new->{name} ||= "!!NAME NOT SET!!";
118 $new->{_columns_info_loaded} ||= 0;
119 $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook";
129 =item Arguments: @columns
131 =item Return value: The ResultSource object
135 $source->add_columns(qw/col1 col2 col3/);
137 $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
139 Adds columns to the result source. If supplied colname => hashref
140 pairs, uses the hashref as the L</column_info> for that column. Repeated
141 calls of this method will add more columns, not replace them.
143 The column names given will be created as accessor methods on your
144 L<DBIx::Class::Row> objects. You can change the name of the accessor
145 by supplying an L</accessor> in the column_info hash.
147 If a column name beginning with a plus sign ('+col1') is provided, the
148 attributes provided will be merged with any existing attributes for the
149 column, with the new attributes taking precedence in the case that an
150 attribute already exists. Using this without a hashref
151 (C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless --
152 it does the same thing it would do without the plus.
154 The contents of the column_info are not set in stone. The following
155 keys are currently recognised/used by DBIx::Class:
161 { accessor => '_name' }
163 # example use, replace standard accessor with one of your own:
165 my ($self, $value) = @_;
167 die "Name cannot contain digits!" if($value =~ /\d/);
168 $self->_name($value);
170 return $self->_name();
173 Use this to set the name of the accessor method for this column. If unset,
174 the name of the column will be used.
178 { data_type => 'integer' }
180 This contains the column type. It is automatically filled if you use the
181 L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
182 L<DBIx::Class::Schema::Loader> module.
184 Currently there is no standard set of values for the data_type. Use
185 whatever your database supports.
191 The length of your column, if it is a column type that can have a size
192 restriction. This is currently only used to create tables from your
193 schema, see L<DBIx::Class::Schema/deploy>.
199 Set this to a true value for a columns that is allowed to contain NULL
200 values, default is false. This is currently only used to create tables
201 from your schema, see L<DBIx::Class::Schema/deploy>.
203 =item is_auto_increment
205 { is_auto_increment => 1 }
207 Set this to a true value for a column whose value is somehow
208 automatically set, defaults to false. This is used to determine which
209 columns to empty when cloning objects using
210 L<DBIx::Class::Row/copy>. It is also used by
211 L<DBIx::Class::Schema/deploy>.
217 Set this to a true or false value (not C<undef>) to explicitly specify
218 if this column contains numeric data. This controls how set_column
219 decides whether to consider a column dirty after an update: if
220 C<is_numeric> is true a numeric comparison C<< != >> will take place
221 instead of the usual C<eq>
223 If not specified the storage class will attempt to figure this out on
224 first access to the column, based on the column C<data_type>. The
225 result will be cached in this attribute.
229 { is_foreign_key => 1 }
231 Set this to a true value for a column that contains a key from a
232 foreign table, defaults to false. This is currently only used to
233 create tables from your schema, see L<DBIx::Class::Schema/deploy>.
237 { default_value => \'now()' }
239 Set this to the default value which will be inserted into a column by
240 the database. Can contain either a value or a function (use a
241 reference to a scalar e.g. C<\'now()'> if you want a function). This
242 is currently only used to create tables from your schema, see
243 L<DBIx::Class::Schema/deploy>.
245 See the note on L<DBIx::Class::Row/new> for more information about possible
246 issues related to db-side default values.
250 { sequence => 'my_table_seq' }
252 Set this on a primary key column to the name of the sequence used to
253 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
254 will attempt to retrieve the name of the sequence from the database
259 Set this to a true value for a column whose value is retrieved automatically
260 from a sequence or function (if supported by your Storage driver.) For a
261 sequence, if you do not use a trigger to get the nextval, you have to set the
262 L</sequence> value as well.
264 Also set this for MSSQL columns with the 'uniqueidentifier'
265 L<data_type|DBIx::Class::ResultSource/data_type> whose values you want to
266 automatically generate using C<NEWID()>, unless they are a primary key in which
267 case this will be done anyway.
271 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
272 to add extra non-generic data to the column. For example: C<< extra
273 => { unsigned => 1} >> is used by the MySQL producer to set an integer
274 column to unsigned. For more details, see
275 L<SQL::Translator::Producer::MySQL>.
283 =item Arguments: $colname, \%columninfo?
285 =item Return value: 1/0 (true/false)
289 $source->add_column('col' => \%info);
291 Add a single column and optional column info. Uses the same column
292 info keys as L</add_columns>.
297 my ($self, @cols) = @_;
298 $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
301 my $columns = $self->_columns;
302 while (my $col = shift @cols) {
303 my $column_info = {};
304 if ($col =~ s/^\+//) {
305 $column_info = $self->column_info($col);
308 # If next entry is { ... } use that for the column info, if not
309 # use an empty hashref
311 my $new_info = shift(@cols);
312 %$column_info = (%$column_info, %$new_info);
314 push(@added, $col) unless exists $columns->{$col};
315 $columns->{$col} = $column_info;
317 push @{ $self->_ordered_columns }, @added;
321 sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
327 =item Arguments: $colname
329 =item Return value: 1/0 (true/false)
333 if ($source->has_column($colname)) { ... }
335 Returns true if the source has a column of this name, false otherwise.
340 my ($self, $column) = @_;
341 return exists $self->_columns->{$column};
348 =item Arguments: $colname
350 =item Return value: Hashref of info
354 my $info = $source->column_info($col);
356 Returns the column metadata hashref for a column, as originally passed
357 to L</add_columns>. See L</add_columns> above for information on the
358 contents of the hashref.
363 my ($self, $column) = @_;
364 $self->throw_exception("No such column $column")
365 unless exists $self->_columns->{$column};
367 if ( ! $self->_columns->{$column}{data_type}
368 and ! $self->{_columns_info_loaded}
369 and $self->column_info_from_storage
370 and $self->schema and my $stor = $self->storage )
372 $self->{_columns_info_loaded}++;
374 # try for the case of storage without table
376 my $info = $stor->columns_info_for( $self->from );
378 { (lc $_) => $info->{$_} }
382 foreach my $col ( keys %{$self->_columns} ) {
383 $self->_columns->{$col} = {
384 %{ $self->_columns->{$col} },
385 %{ $info->{$col} || $lc_info->{lc $col} || {} }
391 return $self->_columns->{$column};
398 =item Arguments: None
400 =item Return value: Ordered list of column names
404 my @column_names = $source->columns;
406 Returns all column names in the order they were declared to L</add_columns>.
412 $self->throw_exception(
413 "columns() is a read-only accessor, did you mean add_columns()?"
415 return @{$self->{_ordered_columns}||[]};
422 =item Arguments: \@colnames ?
424 =item Return value: Hashref of column name/info pairs
428 my $columns_info = $source->columns_info;
430 Like L</column_info> but returns information for the requested columns. If
431 the optional column-list arrayref is ommitted it returns info on all columns
432 currently defined on the ResultSource via L</add_columns>.
437 my ($self, $columns) = @_;
439 my $colinfo = $self->_columns;
442 first { ! $_->{data_type} } values %$colinfo
444 ! $self->{_columns_info_loaded}
446 $self->column_info_from_storage
450 my $stor = $self->storage
452 $self->{_columns_info_loaded}++;
454 # try for the case of storage without table
456 my $info = $stor->columns_info_for( $self->from );
458 { (lc $_) => $info->{$_} }
462 foreach my $col ( keys %$colinfo ) {
464 %{ $colinfo->{$col} },
465 %{ $info->{$col} || $lc_info->{lc $col} || {} }
475 if (my $inf = $colinfo->{$_}) {
479 $self->throw_exception( sprintf (
480 "No such column '%s' on source %s",
494 =head2 remove_columns
498 =item Arguments: @colnames
500 =item Return value: undefined
504 $source->remove_columns(qw/col1 col2 col3/);
506 Removes the given list of columns by name, from the result source.
508 B<Warning>: Removing a column that is also used in the sources primary
509 key, or in one of the sources unique constraints, B<will> result in a
510 broken result source.
516 =item Arguments: $colname
518 =item Return value: undefined
522 $source->remove_column('col');
524 Remove a single column by name from the result source, similar to
527 B<Warning>: Removing a column that is also used in the sources primary
528 key, or in one of the sources unique constraints, B<will> result in a
529 broken result source.
534 my ($self, @to_remove) = @_;
536 my $columns = $self->_columns
541 delete $columns->{$_};
545 $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
548 sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
550 =head2 set_primary_key
554 =item Arguments: @cols
556 =item Return value: undefined
560 Defines one or more columns as primary key for this source. Must be
561 called after L</add_columns>.
563 Additionally, defines a L<unique constraint|add_unique_constraint>
566 Note: you normally do want to define a primary key on your sources
567 B<even if the underlying database table does not have a primary key>.
569 L<DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
574 sub set_primary_key {
575 my ($self, @cols) = @_;
576 # check if primary key columns are valid columns
577 foreach my $col (@cols) {
578 $self->throw_exception("No such column $col on table " . $self->name)
579 unless $self->has_column($col);
581 $self->_primaries(\@cols);
583 $self->add_unique_constraint(primary => \@cols);
586 =head2 primary_columns
590 =item Arguments: None
592 =item Return value: Ordered list of primary column names
596 Read-only accessor which returns the list of primary keys, supplied by
601 sub primary_columns {
602 return @{shift->_primaries||[]};
605 # a helper method that will automatically die with a descriptive message if
606 # no pk is defined on the source in question. For internal use to save
607 # on if @pks... boilerplate
610 my @pcols = $self->primary_columns
611 or $self->throw_exception (sprintf(
612 "Operation requires a primary key to be declared on '%s' via set_primary_key",
613 # source_name is set only after schema-registration
614 $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
621 Manually define the correct sequence for your table, to avoid the overhead
622 associated with looking up the sequence automatically. The supplied sequence
623 will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
627 =item Arguments: $sequence_name
629 =item Return value: undefined
636 my ($self,$seq) = @_;
638 my $rsrc = $self->result_source;
639 my @pks = $rsrc->primary_columns
642 $_->{sequence} = $seq
643 for values %{ $rsrc->columns_info (\@pks) };
647 =head2 add_unique_constraint
651 =item Arguments: $name?, \@colnames
653 =item Return value: undefined
657 Declare a unique constraint on this source. Call once for each unique
660 # For UNIQUE (column1, column2)
661 __PACKAGE__->add_unique_constraint(
662 constraint_name => [ qw/column1 column2/ ],
665 Alternatively, you can specify only the columns:
667 __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
669 This will result in a unique constraint named
670 C<table_column1_column2>, where C<table> is replaced with the table
673 Unique constraints are used, for example, when you pass the constraint
674 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
675 only columns in the constraint are searched.
677 Throws an error if any of the given column names do not yet exist on
682 sub add_unique_constraint {
686 $self->throw_exception(
687 'add_unique_constraint() does not accept multiple constraints, use '
688 . 'add_unique_constraints() instead'
693 if (ref $cols ne 'ARRAY') {
694 $self->throw_exception (
695 'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
701 $name ||= $self->name_unique_constraint($cols);
703 foreach my $col (@$cols) {
704 $self->throw_exception("No such column $col on table " . $self->name)
705 unless $self->has_column($col);
708 my %unique_constraints = $self->unique_constraints;
709 $unique_constraints{$name} = $cols;
710 $self->_unique_constraints(\%unique_constraints);
713 =head2 add_unique_constraints
717 =item Arguments: @constraints
719 =item Return value: undefined
723 Declare multiple unique constraints on this source.
725 __PACKAGE__->add_unique_constraints(
726 constraint_name1 => [ qw/column1 column2/ ],
727 constraint_name2 => [ qw/column2 column3/ ],
730 Alternatively, you can specify only the columns:
732 __PACKAGE__->add_unique_constraints(
733 [ qw/column1 column2/ ],
734 [ qw/column3 column4/ ]
737 This will result in unique constraints named C<table_column1_column2> and
738 C<table_column3_column4>, where C<table> is replaced with the table name.
740 Throws an error if any of the given column names do not yet exist on
743 See also L</add_unique_constraint>.
747 sub add_unique_constraints {
749 my @constraints = @_;
751 if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
752 # with constraint name
753 while (my ($name, $constraint) = splice @constraints, 0, 2) {
754 $self->add_unique_constraint($name => $constraint);
759 foreach my $constraint (@constraints) {
760 $self->add_unique_constraint($constraint);
765 =head2 name_unique_constraint
769 =item Arguments: \@colnames
771 =item Return value: Constraint name
775 $source->table('mytable');
776 $source->name_unique_constraint(['col1', 'col2']);
780 Return a name for a unique constraint containing the specified
781 columns. The name is created by joining the table name and each column
782 name, using an underscore character.
784 For example, a constraint on a table named C<cd> containing the columns
785 C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
787 This is used by L</add_unique_constraint> if you do not specify the
788 optional constraint name.
792 sub name_unique_constraint {
793 my ($self, $cols) = @_;
795 my $name = $self->name;
796 $name = $$name if (ref $name eq 'SCALAR');
798 return join '_', $name, @$cols;
801 =head2 unique_constraints
805 =item Arguments: None
807 =item Return value: Hash of unique constraint data
811 $source->unique_constraints();
813 Read-only accessor which returns a hash of unique constraints on this
816 The hash is keyed by constraint name, and contains an arrayref of
817 column names as values.
821 sub unique_constraints {
822 return %{shift->_unique_constraints||{}};
825 =head2 unique_constraint_names
829 =item Arguments: None
831 =item Return value: Unique constraint names
835 $source->unique_constraint_names();
837 Returns the list of unique constraint names defined on this source.
841 sub unique_constraint_names {
844 my %unique_constraints = $self->unique_constraints;
846 return keys %unique_constraints;
849 =head2 unique_constraint_columns
853 =item Arguments: $constraintname
855 =item Return value: List of constraint columns
859 $source->unique_constraint_columns('myconstraint');
861 Returns the list of columns that make up the specified unique constraint.
865 sub unique_constraint_columns {
866 my ($self, $constraint_name) = @_;
868 my %unique_constraints = $self->unique_constraints;
870 $self->throw_exception(
871 "Unknown unique constraint $constraint_name on '" . $self->name . "'"
872 ) unless exists $unique_constraints{$constraint_name};
874 return @{ $unique_constraints{$constraint_name} };
877 =head2 sqlt_deploy_callback
881 =item Arguments: $callback
885 __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
887 An accessor to set a callback to be called during deployment of
888 the schema via L<DBIx::Class::Schema/create_ddl_dir> or
889 L<DBIx::Class::Schema/deploy>.
891 The callback can be set as either a code reference or the name of a
892 method in the current result class.
894 If not set, the L</default_sqlt_deploy_hook> is called.
896 Your callback will be passed the $source object representing the
897 ResultSource instance being deployed, and the
898 L<SQL::Translator::Schema::Table> object being created from it. The
899 callback can be used to manipulate the table object or add your own
900 customised indexes. If you need to manipulate a non-table object, use
901 the L<DBIx::Class::Schema/sqlt_deploy_hook>.
903 See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
904 Your SQL> for examples.
906 This sqlt deployment callback can only be used to manipulate
907 SQL::Translator objects as they get turned into SQL. To execute
908 post-deploy statements which SQL::Translator does not currently
909 handle, override L<DBIx::Class::Schema/deploy> in your Schema class
910 and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
912 =head2 default_sqlt_deploy_hook
916 =item Arguments: $source, $sqlt_table
918 =item Return value: undefined
922 This is the sensible default for L</sqlt_deploy_callback>.
924 If a method named C<sqlt_deploy_hook> exists in your Result class, it
925 will be called and passed the current C<$source> and the
926 C<$sqlt_table> being deployed.
930 sub default_sqlt_deploy_hook {
933 my $class = $self->result_class;
935 if ($class and $class->can('sqlt_deploy_hook')) {
936 $class->sqlt_deploy_hook(@_);
940 sub _invoke_sqlt_deploy_hook {
942 if ( my $hook = $self->sqlt_deploy_callback) {
951 =item Arguments: None
953 =item Return value: $resultset
957 Returns a resultset for the given source. This will initially be created
960 $self->resultset_class->new($self, $self->resultset_attributes)
962 but is cached from then on unless resultset_class changes.
964 =head2 resultset_class
968 =item Arguments: $classname
970 =item Return value: $classname
974 package My::Schema::ResultSet::Artist;
975 use base 'DBIx::Class::ResultSet';
978 # In the result class
979 __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
982 $source->resultset_class('My::Schema::ResultSet::Artist');
984 Set the class of the resultset. This is useful if you want to create your
985 own resultset methods. Create your own class derived from
986 L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
987 this method returns the name of the existing resultset class, if one
990 =head2 resultset_attributes
994 =item Arguments: \%attrs
996 =item Return value: \%attrs
1000 # In the result class
1001 __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
1004 $source->resultset_attributes({ order_by => [ 'id' ] });
1006 Store a collection of resultset attributes, that will be set on every
1007 L<DBIx::Class::ResultSet> produced from this result source. For a full
1008 list see L<DBIx::Class::ResultSet/ATTRIBUTES>.
1014 $self->throw_exception(
1015 'resultset does not take any arguments. If you want another resultset, '.
1016 'call it on the schema instead.'
1019 return $self->resultset_class->new(
1022 %{$self->{resultset_attributes}},
1023 %{$self->schema->default_resultset_attributes}
1032 =item Arguments: $source_name
1034 =item Result value: $source_name
1038 Set an alternate name for the result source when it is loaded into a schema.
1039 This is useful if you want to refer to a result source by a name other than
1042 package ArchivedBooks;
1043 use base qw/DBIx::Class/;
1044 __PACKAGE__->table('books_archive');
1045 __PACKAGE__->source_name('Books');
1047 # from your schema...
1048 $schema->resultset('Books')->find(1);
1054 =item Arguments: None
1056 =item Return value: FROM clause
1060 my $from_clause = $source->from();
1062 Returns an expression of the source to be supplied to storage to specify
1063 retrieval from this source. In the case of a database, the required FROM
1070 =item Arguments: None
1072 =item Return value: A schema object
1076 my $schema = $source->schema();
1078 Returns the L<DBIx::Class::Schema> object that this result source
1085 =item Arguments: None
1087 =item Return value: A Storage object
1091 $source->storage->debug(1);
1093 Returns the storage handle for the current schema.
1095 See also: L<DBIx::Class::Storage>
1099 sub storage { shift->schema->storage; }
1101 =head2 add_relationship
1105 =item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ]
1107 =item Return value: 1/true if it succeeded
1111 $source->add_relationship('relname', 'related_source', $cond, $attrs);
1113 L<DBIx::Class::Relationship> describes a series of methods which
1114 create pre-defined useful types of relationships. Look there first
1115 before using this method directly.
1117 The relationship name can be arbitrary, but must be unique for each
1118 relationship attached to this result source. 'related_source' should
1119 be the name with which the related result source was registered with
1120 the current schema. For example:
1122 $schema->source('Book')->add_relationship('reviews', 'Review', {
1123 'foreign.book_id' => 'self.id',
1126 The condition C<$cond> needs to be an L<SQL::Abstract>-style
1127 representation of the join between the tables. For example, if you're
1128 creating a relation from Author to Book,
1130 { 'foreign.author_id' => 'self.id' }
1132 will result in the JOIN clause
1134 author me JOIN book foreign ON foreign.author_id = me.id
1136 You can specify as many foreign => self mappings as necessary.
1138 Valid attributes are as follows:
1144 Explicitly specifies the type of join to use in the relationship. Any
1145 SQL join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in
1146 the SQL command immediately before C<JOIN>.
1150 An arrayref containing a list of accessors in the foreign class to proxy in
1151 the main class. If, for example, you do the following:
1153 CD->might_have(liner_notes => 'LinerNotes', undef, {
1154 proxy => [ qw/notes/ ],
1157 Then, assuming LinerNotes has an accessor named notes, you can do:
1159 my $cd = CD->find(1);
1160 # set notes -- LinerNotes object is created if it doesn't exist
1161 $cd->notes('Notes go here');
1165 Specifies the type of accessor that should be created for the
1166 relationship. Valid values are C<single> (for when there is only a single
1167 related object), C<multi> (when there can be many), and C<filter> (for
1168 when there is a single related object, but you also want the relationship
1169 accessor to double as a column accessor). For C<multi> accessors, an
1170 add_to_* method is also created, which calls C<create_related> for the
1175 Throws an exception if the condition is improperly supplied, or cannot
1180 sub add_relationship {
1181 my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
1182 $self->throw_exception("Can't create relationship without join condition")
1186 # Check foreign and self are right in cond
1187 if ( (ref $cond ||'') eq 'HASH') {
1189 $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
1190 if /\./ && !/^foreign\./;
1194 my %rels = %{ $self->_relationships };
1195 $rels{$rel} = { class => $f_source_name,
1196 source => $f_source_name,
1199 $self->_relationships(\%rels);
1203 # XXX disabled. doesn't work properly currently. skip in tests.
1205 my $f_source = $self->schema->source($f_source_name);
1206 unless ($f_source) {
1207 $self->ensure_class_loaded($f_source_name);
1208 $f_source = $f_source_name->result_source;
1209 #my $s_class = ref($self->schema);
1210 #$f_source_name =~ m/^${s_class}::(.*)$/;
1211 #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
1212 #$f_source = $self->schema->source($f_source_name);
1214 return unless $f_source; # Can't test rel without f_source
1216 try { $self->_resolve_join($rel, 'me', {}, []) }
1218 # If the resolve failed, back out and re-throw the error
1220 $self->_relationships(\%rels);
1221 $self->throw_exception("Error creating relationship $rel: $_");
1227 =head2 relationships
1231 =item Arguments: None
1233 =item Return value: List of relationship names
1237 my @relnames = $source->relationships();
1239 Returns all relationship names for this source.
1244 return keys %{shift->_relationships};
1247 =head2 relationship_info
1251 =item Arguments: $relname
1253 =item Return value: Hashref of relation data,
1257 Returns a hash of relationship information for the specified relationship
1258 name. The keys/values are as specified for L</add_relationship>.
1262 sub relationship_info {
1263 my ($self, $rel) = @_;
1264 return $self->_relationships->{$rel};
1267 =head2 has_relationship
1271 =item Arguments: $rel
1273 =item Return value: 1/0 (true/false)
1277 Returns true if the source has a relationship of this name, false otherwise.
1281 sub has_relationship {
1282 my ($self, $rel) = @_;
1283 return exists $self->_relationships->{$rel};
1286 =head2 reverse_relationship_info
1290 =item Arguments: $relname
1292 =item Return value: Hashref of relationship data
1296 Looks through all the relationships on the source this relationship
1297 points to, looking for one whose condition is the reverse of the
1298 condition on this relationship.
1300 A common use of this is to find the name of the C<belongs_to> relation
1301 opposing a C<has_many> relation. For definition of these look in
1302 L<DBIx::Class::Relationship>.
1304 The returned hashref is keyed by the name of the opposing
1305 relationship, and contains its data in the same manner as
1306 L</relationship_info>.
1310 sub reverse_relationship_info {
1311 my ($self, $rel) = @_;
1312 my $rel_info = $self->relationship_info($rel);
1315 return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
1317 my @cond = keys(%{$rel_info->{cond}});
1318 my @refkeys = map {/^\w+\.(\w+)$/} @cond;
1319 my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
1321 # Get the related result source for this relationship
1322 my $othertable = $self->related_source($rel);
1324 # Get all the relationships for that source that related to this source
1325 # whose foreign column set are our self columns on $rel and whose self
1326 # columns are our foreign columns on $rel.
1327 my @otherrels = $othertable->relationships();
1328 my $otherrelationship;
1329 foreach my $otherrel (@otherrels) {
1330 my $otherrel_info = $othertable->relationship_info($otherrel);
1332 my $back = $othertable->related_source($otherrel);
1333 next unless $back->source_name eq $self->source_name;
1337 if (ref $otherrel_info->{cond} eq 'HASH') {
1338 @othertestconds = ($otherrel_info->{cond});
1340 elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
1341 @othertestconds = @{$otherrel_info->{cond}};
1347 foreach my $othercond (@othertestconds) {
1348 my @other_cond = keys(%$othercond);
1349 my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
1350 my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
1351 next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) ||
1352 !$self->_compare_relationship_keys(\@other_refkeys, \@keys));
1353 $ret->{$otherrel} = $otherrel_info;
1359 sub compare_relationship_keys {
1360 carp 'compare_relationship_keys is a private method, stop calling it';
1362 $self->_compare_relationship_keys (@_);
1365 # Returns true if both sets of keynames are the same, false otherwise.
1366 sub _compare_relationship_keys {
1367 my ($self, $keys1, $keys2) = @_;
1369 # Make sure every keys1 is in keys2
1371 foreach my $key (@$keys1) {
1373 foreach my $prim (@$keys2) {
1374 if ($prim eq $key) {
1382 # Make sure every key2 is in key1
1384 foreach my $prim (@$keys2) {
1386 foreach my $key (@$keys1) {
1387 if ($prim eq $key) {
1399 # Returns the {from} structure used to express JOIN conditions
1401 my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
1403 # we need a supplied one, because we do in-place modifications, no returns
1404 $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
1405 unless ref $seen eq 'HASH';
1407 $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
1408 unless ref $jpath eq 'ARRAY';
1410 $jpath = [@$jpath]; # copy
1412 if (not defined $join) {
1415 elsif (ref $join eq 'ARRAY') {
1418 $self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left);
1421 elsif (ref $join eq 'HASH') {
1424 for my $rel (keys %$join) {
1426 my $rel_info = $self->relationship_info($rel)
1427 or $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1429 my $force_left = $parent_force_left;
1430 $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
1432 # the actual seen value will be incremented by the recursion
1433 my $as = $self->storage->relname_to_table_alias(
1434 $rel, ($seen->{$rel} && $seen->{$rel} + 1)
1438 $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
1439 $self->related_source($rel)->_resolve_join(
1440 $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
1448 $self->throw_exception("No idea how to resolve join reftype ".ref $join);
1451 my $count = ++$seen->{$join};
1452 my $as = $self->storage->relname_to_table_alias(
1453 $join, ($count > 1 && $count)
1456 my $rel_info = $self->relationship_info($join)
1457 or $self->throw_exception("No such relationship $join on " . $self->source_name);
1459 my $rel_src = $self->related_source($join);
1460 return [ { $as => $rel_src->from,
1461 -source_handle => $rel_src->handle,
1462 -join_type => $parent_force_left
1464 : $rel_info->{attrs}{join_type}
1466 -join_path => [@$jpath, { $join => $as } ],
1468 $rel_info->{attrs}{accessor}
1470 first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
1473 -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
1475 $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
1480 carp 'pk_depends_on is a private method, stop calling it';
1482 $self->_pk_depends_on (@_);
1485 # Determines whether a relation is dependent on an object from this source
1486 # having already been inserted. Takes the name of the relationship and a
1487 # hashref of columns of the related object.
1488 sub _pk_depends_on {
1489 my ($self, $relname, $rel_data) = @_;
1491 my $relinfo = $self->relationship_info($relname);
1493 # don't assume things if the relationship direction is specified
1494 return $relinfo->{attrs}{is_foreign_key_constraint}
1495 if exists ($relinfo->{attrs}{is_foreign_key_constraint});
1497 my $cond = $relinfo->{cond};
1498 return 0 unless ref($cond) eq 'HASH';
1500 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
1501 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
1503 # assume anything that references our PK probably is dependent on us
1504 # rather than vice versa, unless the far side is (a) defined or (b)
1506 my $rel_source = $self->related_source($relname);
1508 foreach my $p ($self->primary_columns) {
1509 if (exists $keyhash->{$p}) {
1510 unless (defined($rel_data->{$keyhash->{$p}})
1511 || $rel_source->column_info($keyhash->{$p})
1512 ->{is_auto_increment}) {
1521 sub resolve_condition {
1522 carp 'resolve_condition is a private method, stop calling it';
1524 $self->_resolve_condition (@_);
1527 # Resolves the passed condition to a concrete query fragment. If given an alias,
1528 # returns a join condition; if given an object, inverts that object to produce
1529 # a related conditional from that object.
1530 our $UNRESOLVABLE_CONDITION = \'1 = 0';
1532 sub _resolve_condition {
1533 my ($self, $cond, $as, $for) = @_;
1534 if (ref $cond eq 'HASH') {
1536 foreach my $k (keys %{$cond}) {
1537 my $v = $cond->{$k};
1538 # XXX should probably check these are valid columns
1539 $k =~ s/^foreign\.// ||
1540 $self->throw_exception("Invalid rel cond key ${k}");
1541 $v =~ s/^self\.// ||
1542 $self->throw_exception("Invalid rel cond val ${v}");
1543 if (ref $for) { # Object
1544 #warn "$self $k $for $v";
1545 unless ($for->has_column_loaded($v)) {
1546 if ($for->in_storage) {
1547 $self->throw_exception(sprintf
1548 "Unable to resolve relationship '%s' from object %s: column '%s' not "
1549 . 'loaded from storage (or not passed to new() prior to insert()). You '
1550 . 'probably need to call ->discard_changes to get the server-side defaults '
1551 . 'from the database.',
1557 return $UNRESOLVABLE_CONDITION;
1559 $ret{$k} = $for->get_column($v);
1560 #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
1562 } elsif (!defined $for) { # undef, i.e. "no object"
1564 } elsif (ref $as eq 'HASH') { # reverse hashref
1565 $ret{$v} = $as->{$k};
1566 } elsif (ref $as) { # reverse object
1567 $ret{$v} = $as->get_column($k);
1568 } elsif (!defined $as) { # undef, i.e. "no reverse object"
1571 $ret{"${as}.${k}"} = "${for}.${v}";
1575 } elsif (ref $cond eq 'ARRAY') {
1576 return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
1578 die("Can't handle condition $cond yet :(");
1583 # Accepts one or more relationships for the current source and returns an
1584 # array of column names for each of those relationships. Column names are
1585 # prefixed relative to the current source, in accordance with where they appear
1586 # in the supplied relationships.
1588 sub _resolve_prefetch {
1589 my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
1592 if (not defined $pre) {
1595 elsif( ref $pre eq 'ARRAY' ) {
1597 map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
1600 elsif( ref $pre eq 'HASH' ) {
1603 $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
1604 $self->related_source($_)->_resolve_prefetch(
1605 $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
1610 $self->throw_exception(
1611 "don't know how to resolve prefetch reftype ".ref($pre));
1615 $p = $p->{$_} for (@$pref_path, $pre);
1617 $self->throw_exception (
1618 "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
1619 . join (' -> ', @$pref_path, $pre)
1620 ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
1622 my $as = shift @{$p->{-join_aliases}};
1624 my $rel_info = $self->relationship_info( $pre );
1625 $self->throw_exception( $self->source_name . " has no such relationship '$pre'" )
1627 my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
1628 my $rel_source = $self->related_source($pre);
1630 if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
1631 $self->throw_exception(
1632 "Can't prefetch has_many ${pre} (join cond too complex)")
1633 unless ref($rel_info->{cond}) eq 'HASH';
1634 my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
1635 if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
1636 keys %{$collapse}) {
1637 my ($last) = ($fail =~ /([^\.]+)$/);
1639 "Prefetching multiple has_many rels ${last} and ${pre} "
1640 .(length($as_prefix)
1641 ? "at the same level (${as_prefix}) "
1644 . 'will explode the number of row objects retrievable via ->next or ->all. '
1645 . 'Use at your own risk.'
1648 #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
1649 # values %{$rel_info->{cond}};
1650 $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
1651 # action at a distance. prepending the '.' allows simpler code
1652 # in ResultSet->_collapse_result
1653 my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
1654 keys %{$rel_info->{cond}};
1655 push @$order, map { "${as}.$_" } @key;
1657 if (my $rel_order = $rel_info->{attrs}{order_by}) {
1658 # this is kludgy and incomplete, I am well aware
1659 # but the parent method is going away entirely anyway
1661 my $sql_maker = $self->storage->sql_maker;
1662 my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
1663 my $sep = $sql_maker->name_sep;
1665 # install our own quoter, so we can catch unqualified stuff
1666 local $sql_maker->{quote_char} = ["\x00", "\xFF"];
1668 my $quoted_prefix = "\x00${as}\xFF";
1670 for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
1672 ($chunk, @bind) = @$chunk if ref $chunk;
1674 $chunk = "${quoted_prefix}${sep}${chunk}"
1675 unless $chunk =~ /\Q$sep/;
1677 $chunk =~ s/\x00/$orig_ql/g;
1678 $chunk =~ s/\xFF/$orig_qr/g;
1679 push @$order, \[$chunk, @bind];
1684 return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
1685 $rel_source->columns;
1689 =head2 related_source
1693 =item Arguments: $relname
1695 =item Return value: $source
1699 Returns the result source object for the given relationship.
1703 sub related_source {
1704 my ($self, $rel) = @_;
1705 if( !$self->has_relationship( $rel ) ) {
1706 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1708 return $self->schema->source($self->relationship_info($rel)->{source});
1711 =head2 related_class
1715 =item Arguments: $relname
1717 =item Return value: $classname
1721 Returns the class name for objects in the given relationship.
1726 my ($self, $rel) = @_;
1727 if( !$self->has_relationship( $rel ) ) {
1728 $self->throw_exception("No such relationship '$rel' on " . $self->source_name);
1730 return $self->schema->class($self->relationship_info($rel)->{source});
1735 Obtain a new handle to this source. Returns an instance of a
1736 L<DBIx::Class::ResultSourceHandle>.
1741 return DBIx::Class::ResultSourceHandle->new({
1742 schema => $_[0]->schema,
1743 source_moniker => $_[0]->source_name
1748 my $global_phase_destroy;
1750 END { $global_phase_destroy++ }
1753 return if $global_phase_destroy;
1759 # Under no circumstances shall $_[0] be stored anywhere else (like copied to
1760 # a lexical variable, or shifted, or anything else). Doing so will mess up
1761 # the refcount of this particular result source, and will allow the $schema
1762 # we are trying to save to reattach back to the source we are destroying.
1763 # The relevant code checking refcounts is in ::Schema::DESTROY()
1765 # if we are not a schema instance holder - we don't matter
1767 ! ref $_[0]->{schema}
1769 isweak $_[0]->{schema}
1772 # weaken our schema hold forcing the schema to find somewhere else to live
1773 weaken $_[0]->{schema};
1775 # if schema is still there reintroduce ourselves with strong refs back
1776 if ($_[0]->{schema}) {
1777 my $srcregs = $_[0]->{schema}->source_registrations;
1778 for (keys %$srcregs) {
1779 $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
1785 sub STORABLE_freeze {
1786 my ($self, $cloning) = @_;
1787 nfreeze($self->handle);
1791 my ($self, $cloning, $ice) = @_;
1792 %$self = %{ (thaw $ice)->resolve };
1797 =head2 throw_exception
1799 See L<DBIx::Class::Schema/"throw_exception">.
1803 sub throw_exception {
1806 if (defined $self->schema) {
1807 $self->schema->throw_exception(@_);
1810 DBIx::Class::Exception->throw(@_);
1816 Stores a hashref of per-source metadata. No specific key names
1817 have yet been standardized, the examples below are purely hypothetical
1818 and don't actually accomplish anything on their own:
1820 __PACKAGE__->source_info({
1821 "_tablespace" => 'fast_disk_array_3',
1822 "_engine" => 'InnoDB',
1829 $class->new({attribute_name => value});
1831 Creates a new ResultSource object. Not normally called directly by end users.
1833 =head2 column_info_from_storage
1837 =item Arguments: 1/0 (default: 0)
1839 =item Return value: 1/0
1843 __PACKAGE__->column_info_from_storage(1);
1845 Enables the on-demand automatic loading of the above column
1846 metadata from storage as necessary. This is *deprecated*, and
1847 should not be used. It will be removed before 1.0.
1852 Matt S. Trout <mst@shadowcatsystems.co.uk>
1856 You may distribute this code under the same terms as Perl itself.