X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=bb178fc16eb1adf0e11028a8d247fd0ce889386b;hb=a4fcda000aa9833874693ea9bc940a92abbe1b6f;hp=7c3add824d68e516ff2ae1bdddbd30024f393509;hpb=c00b00deb4354de9c59e46bd83f4a2b23b953425;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 7c3add8..bb178fc 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -13,7 +13,7 @@ use base qw/DBIx::Class/; __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships column_info_from_storage source_info - source_name/); + source_name sqlt_deploy_callback/); __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/); @@ -29,18 +29,12 @@ DBIx::Class::ResultSource - Result source object A ResultSource is a component of a schema from which results can be directly retrieved, most usually a table (see L) +Basic view support also exists, see L<. + =head1 METHODS =pod -=head2 new - - $class->new(); - - $class->new({attribute_name => value}); - -Creates a new ResultSource object. Not normally called directly by end users. - =cut sub new { @@ -55,34 +49,32 @@ sub new { $new->{_relationships} = { %{$new->{_relationships}||{}} }; $new->{name} ||= "!!NAME NOT SET!!"; $new->{_columns_info_loaded} ||= 0; + $new->{sqlt_deploy_callback} ||= "default_sqlt_deploy_hook"; return $new; } =pod -=head2 source_info +=head2 add_columns -Stores a hashref of per-source metadata. No specific key names -have yet been standardized, the examples below are purely hypothetical -and don't actually accomplish anything on their own: +=over - __PACKAGE__->source_info({ - "_tablespace" => 'fast_disk_array_3', - "_engine" => 'InnoDB', - }); +=item Arguments: @columns -=head2 add_columns +=item Return value: The ResultSource object + +=back - $table->add_columns(qw/col1 col2 col3/); + $source->add_columns(qw/col1 col2 col3/); - $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...); + $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...); Adds columns to the result source. If supplied key => hashref pairs, uses the hashref as the column_info for that column. Repeated calls of this method will add more columns, not replace them. The column names given will be created as accessor methods on your -L objects, you can change the name of the accessor +L objects. You can change the name of the accessor by supplying an L in the column_info hash. The contents of the column_info are not set in stone. The following @@ -133,8 +125,12 @@ L. =item default_value Set this to the default value which will be inserted into a column -by the database. Can contain either a value or a function. This is -currently only used by L. +by the database. Can contain either a value or a function (use a +reference to a scalar e.g. C<\'now()'> if you want a function). This +is currently only used by L. + +See the note on L for more information about possible +issues related to db-side default values. =item sequence @@ -146,7 +142,7 @@ automatically. =item auto_nextval Set this to a true value for a column whose value is retrieved -automatically from an oracle sequence. If you do not use an oracle +automatically from an oracle sequence. If you do not use an Oracle trigger to get the nextval, you have to set sequence as well. =item extra @@ -161,9 +157,18 @@ L. =head2 add_column - $table->add_column('col' => \%info?); +=over + +=item Arguments: $colname, [ \%columninfo ] -Convenience alias to add_columns. +=item Return value: 1/0 (true/false) + +=back + + $source->add_column('col' => \%info?); + +Add a single column and optional column info. Uses the same column +info keys as L. =cut @@ -188,7 +193,15 @@ sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB =head2 has_column - if ($obj->has_column($col)) { ... } +=over + +=item Arguments: $colname + +=item Return value: 1/0 (true/false) + +=back + + if ($source->has_column($colname)) { ... } Returns true if the source has a column of this name, false otherwise. @@ -201,10 +214,19 @@ sub has_column { =head2 column_info - my $info = $obj->column_info($col); +=over + +=item Arguments: $colname + +=item Return value: Hashref of info + +=back -Returns the column metadata hashref for a column. See the description -of add_column for information on the contents of the hashref. + my $info = $source->column_info($col); + +Returns the column metadata hashref for a column, as originally passed +to L. See the description of L for information +on the contents of the hashref. =cut @@ -238,19 +260,19 @@ sub column_info { return $self->_columns->{$column}; } -=head2 column_info_from_storage +=head2 columns -Enables the on-demand automatic loading of the above column -metadata from storage as neccesary. This is *deprecated*, and -should not be used. It will be removed before 1.0. +=over - __PACKAGE__->column_info_from_storage(1); +=item Arguments: None -=head2 columns +=item Return value: Ordered list of column names - my @column_names = $obj->columns; +=back -Returns all column names in the order they were declared to add_columns. + my @column_names = $source->columns; + +Returns all column names in the order they were declared to L. =cut @@ -264,35 +286,56 @@ sub columns { =head2 remove_columns - $table->remove_columns(qw/col1 col2 col3/); +=over + +=item Arguments: @colnames -Removes columns from the result source. +=item Return value: undefined + +=back + + $source->remove_columns(qw/col1 col2 col3/); + +Removes the given list of columns by name, from the result source. + +B: Removing a column that is also used in the sources primary +key, or in one of the sources unique constraints, B result in a +broken result source. =head2 remove_column - $table->remove_column('col'); +=over -Convenience alias to remove_columns. +=item Arguments: $colname -=cut +=item Return value: undefined -sub remove_columns { - my ($self, @cols) = @_; +=back - return unless $self->_ordered_columns; + $source->remove_column('col'); - my $columns = $self->_columns; - my @remaining; +Remove a single column by name from the result source, similar to +L. - foreach my $col (@{$self->_ordered_columns}) { - push @remaining, $col unless grep(/$col/, @cols); - } +B: Removing a column that is also used in the sources primary +key, or in one of the sources unique constraints, B result in a +broken result source. - foreach (@cols) { +=cut + +sub remove_columns { + my ($self, @to_remove) = @_; + + my $columns = $self->_columns + or return; + + my %to_remove; + for (@to_remove) { delete $columns->{$_}; - }; + ++$to_remove{$_}; + } - $self->_ordered_columns(\@remaining); + $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]); } sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB @@ -303,12 +346,15 @@ sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB =item Arguments: @cols +=item Return value: undefined + =back Defines one or more columns as primary key for this source. Should be -called after C. +called after L. -Additionally, defines a unique constraint named C. +Additionally, defines a L +named C. The primary key columns are used by L to retrieve automatically created values from the database. @@ -329,7 +375,16 @@ sub set_primary_key { =head2 primary_columns -Read-only accessor which returns the list of primary keys. +=over 4 + +=item Arguments: None + +=item Return value: Ordered list of primary column names + +=back + +Read-only accessor which returns the list of primary keys, supplied by +L. =cut @@ -339,6 +394,14 @@ sub primary_columns { =head2 add_unique_constraint +=over 4 + +=item Arguments: [ $name ], \@colnames + +=item Return value: undefined + +=back + Declare a unique constraint on this source. Call once for each unique constraint. @@ -357,6 +420,9 @@ C is replaced with the table name. Unique constraints are used, for example, when you call L. Only columns in the constraint are searched. +Throws an error if any of the given column names do not yet exist on +the result source. + =cut sub add_unique_constraint { @@ -378,12 +444,29 @@ sub add_unique_constraint { =head2 name_unique_constraint -Return a name for a unique constraint containing the specified columns. These -names consist of the table name and each column name, separated by underscores. +=over 4 + +=item Arguments: @colnames + +=item Return value: Constraint name + +=back + + $source->table('mytable'); + $source->name_unique_constraint('col1', 'col2'); + # returns + 'mytable_col1_col2' + +Return a name for a unique constraint containing the specified +columns. The name is created by joining the table name and each column +name, using an underscore character. For example, a constraint on a table named C containing the columns C and C would result in a constraint name of C<cd_artist_title>. +This is used by L</add_unique_constraint> if you do not specify the +optional constraint name. + =cut sub name_unique_constraint { @@ -394,7 +477,20 @@ sub name_unique_constraint { =head2 unique_constraints -Read-only accessor which returns the list of unique constraints on this source. +=over 4 + +=item Arguments: None + +=item Return value: Hash of unique constraint data + +=back + + $source->unique_constraints(); + +Read-only accessor which returns a hash of unique constraints on this source. + +The hash is keyed by constraint name, and contains an arrayref of +column names as values. =cut @@ -404,6 +500,16 @@ sub unique_constraints { =head2 unique_constraint_names +=over 4 + +=item Arguments: None + +=item Return value: Unique constraint names + +=back + + $source->unique_constraint_names(); + Returns the list of unique constraint names defined on this source. =cut @@ -418,6 +524,16 @@ sub unique_constraint_names { =head2 unique_constraint_columns +=over 4 + +=item Arguments: $constraintname + +=item Return value: List of constraint columns + +=back + + $source->unique_constraint_columns('myconstraint'); + Returns the list of columns that make up the specified unique constraint. =cut @@ -434,19 +550,214 @@ sub unique_constraint_columns { return @{ $unique_constraints{$constraint_name} }; } +=head2 sqlt_deploy_callback + +=over + +=item Arguments: $callback + +=back + + __PACKAGE__->sqlt_deploy_callback('mycallbackmethod'); + +An accessor to set a callback to be called during deployment of +the schema via L<DBIx::Class::Schema/create_ddl_dir> or +L<DBIx::Class::Schema/deploy>. + +The callback can be set as either a code reference or the name of a +method in the current result class. + +If not set, the L</default_sqlt_deploy_hook> is called. + +Your callback will be passed the $source object representing the +ResultSource instance being deployed, and the +L<SQL::Translator::Schema::Table> object being created from it. The +callback can be used to manipulate the table object or add your own +customised indexes. If you need to manipulate a non-table object, use +the L<DBIx::Class::Schema/sqlt_deploy_hook>. + +See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To +Your SQL> for examples. + +This sqlt deployment callback can only be used to manipulate +SQL::Translator objects as they get turned into SQL. To execute +post-deploy statements which SQL::Translator does not currently +handle, override L<DBIx::Class::Schema/deploy> in your Schema class +and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>. + +=head2 default_sqlt_deploy_hook + +=over + +=item Arguments: $source, $sqlt_table + +=item Return value: undefined + +=back + +This is the sensible default for L</sqlt_deploy_callback>. + +If a method named C<sqlt_deploy_hook> exists in your Result class, it +will be called and passed the current C<$source> and the +C<$sqlt_table> being deployed. + +=cut + +sub default_sqlt_deploy_hook { + my $self = shift; + + my $class = $self->result_class; + + if ($class and $class->can('sqlt_deploy_hook')) { + $class->sqlt_deploy_hook(@_); + } +} + +sub _invoke_sqlt_deploy_hook { + my $self = shift; + if ( my $hook = $self->sqlt_deploy_callback) { + $self->$hook(@_); + } +} + +=head2 resultset + +=over 4 + +=item Arguments: None + +=item Return value: $resultset + +=back + +Returns a resultset for the given source. This will initially be created +on demand by calling + + $self->resultset_class->new($self, $self->resultset_attributes) + +but is cached from then on unless resultset_class changes. + +=head2 resultset_class + +=over 4 + +=item Arguments: $classname + +=item Return value: $classname + +=back + + package My::ResultSetClass; + use base 'DBIx::Class::ResultSet'; + ... + + $source->resultset_class('My::ResultSet::Class'); + +Set the class of the resultset. This is useful if you want to create your +own resultset methods. Create your own class derived from +L<DBIx::Class::ResultSet>, and set it here. If called with no arguments, +this method returns the name of the existing resultset class, if one +exists. + +=head2 resultset_attributes + +=over 4 + +=item Arguments: \%attrs + +=item Return value: \%attrs + +=back + + $source->resultset_attributes({ order_by => [ 'id' ] }); + +Store a collection of resultset attributes, that will be set on every +L<DBIx::Class::ResultSet> produced from this result source. For a full +list see L<DBIx::Class::ResultSet/ATTRIBUTES>. + +=cut + +sub resultset { + my $self = shift; + $self->throw_exception( + 'resultset does not take any arguments. If you want another resultset, '. + 'call it on the schema instead.' + ) if scalar @_; + + return $self->resultset_class->new( + $self, + { + %{$self->{resultset_attributes}}, + %{$self->schema->default_resultset_attributes} + }, + ); +} + +=head2 source_name + +=over 4 + +=item Arguments: $source_name + +=item Result value: $source_name + +=back + +Set an alternate name for the result source when it is loaded into a schema. +This is useful if you want to refer to a result source by a name other than +its class name. + + package ArchivedBooks; + use base qw/DBIx::Class/; + __PACKAGE__->table('books_archive'); + __PACKAGE__->source_name('Books'); + + # from your schema... + $schema->resultset('Books')->find(1); + =head2 from +=over 4 + +=item Arguments: None + +=item Return value: FROM clause + +=back + + my $from_clause = $source->from(); + Returns an expression of the source to be supplied to storage to specify retrieval from this source. In the case of a database, the required FROM clause contents. =head2 schema +=over 4 + +=item Arguments: None + +=item Return value: A schema object + +=back + + my $schema = $source->schema(); + Returns the L<DBIx::Class::Schema> object that this result source -belongs too. +belongs to. =head2 storage +=over 4 + +=item Arguments: None + +=item Return value: A Storage object + +=back + + $source->storage->debug(1); + Returns the storage handle for the current schema. See also: L<DBIx::Class::Storage> @@ -457,8 +768,20 @@ sub storage { shift->schema->storage; } =head2 add_relationship +=over 4 + +=item Arguments: $relname, $related_source_name, \%cond, [ \%attrs ] + +=item Return value: 1/true if it succeeded + +=back + $source->add_relationship('relname', 'related_source', $cond, $attrs); +L<DBIx::Class::Relationship> describes a series of methods which +create pre-defined useful types of relationships. Look there first +before using this method directly. + The relationship name can be arbitrary, but must be unique for each relationship attached to this result source. 'related_source' should be the name with which the related result source was registered with @@ -470,7 +793,7 @@ the current schema. For example: The condition C<$cond> needs to be an L<SQL::Abstract>-style representation of the join between the tables. For example, if you're -creating a rel from Author to Book, +creating a relation from Author to Book, { 'foreign.author_id' => 'self.id' } @@ -517,6 +840,9 @@ relationship. =back +Throws an exception if the condition is improperly supplied, or cannot +be resolved using L</resolve_join>. + =cut sub add_relationship { @@ -567,6 +893,16 @@ sub add_relationship { =head2 relationships +=over 4 + +=item Arguments: None + +=item Return value: List of relationship names + +=back + + my @relnames = $source->relationships(); + Returns all relationship names for this source. =cut @@ -581,10 +917,12 @@ sub relationships { =item Arguments: $relname +=item Return value: Hashref of relation data, + =back Returns a hash of relationship information for the specified relationship -name. +name. The keys/values are as specified for L</add_relationship>. =cut @@ -599,6 +937,8 @@ sub relationship_info { =item Arguments: $rel +=item Return value: 1/0 (true/false) + =back Returns true if the source has a relationship of this name, false otherwise. @@ -616,10 +956,21 @@ sub has_relationship { =item Arguments: $relname +=item Return value: Hashref of relationship data + =back -Returns an array of hash references of relationship information for -the other side of the specified relationship name. +Looks through all the relationships on the source this relationship +points to, looking for one whose condition is the reverse of the +condition on this relationship. + +A common use of this is to find the name of the C<belongs_to> relation +opposing a C<has_many> relation. For definition of these look in +L<DBIx::Class::Relationship>. + +The returned hashref is keyed by the name of the opposing +relationship, and contains it's data in the same manner as +L</relationship_info>. =cut @@ -676,7 +1027,9 @@ sub reverse_relationship_info { =over 4 -=item Arguments: $keys1, $keys2 +=item Arguments: \@keys1, \@keys2 + +=item Return value: 1/0 (true/false) =back @@ -723,6 +1076,8 @@ sub compare_relationship_keys { =item Arguments: $relation +=item Return value: Join condition arrayref + =back Returns the join structure required for the related result source. @@ -774,20 +1129,18 @@ sub resolve_join { =item Arguments: $relname, $rel_data +=item Return value: 1/0 (true/false) + =back Determines whether a relation is dependent on an object from this source having already been inserted. Takes the name of the relationship and a -hashref of already known columns of the related object. +hashref of columns of the related object. =cut -## true if: our PK depends on the data from the given rel -## AND its not yet in the rel_data passed -## pk_still_unsolved? pk_has_unmet_deps? sub pk_depends_on { - my ($self, $relname, $rel_data, $existing_data) = @_; -# print STDERR "Rel $relname on ", $self->source_name, " ", Data::Dumper::Dumper($self->relationship_info($relname)); + my ($self, $relname, $rel_data) = @_; my $cond = $self->relationship_info($relname)->{cond}; return 0 unless ref($cond) eq 'HASH'; @@ -803,81 +1156,16 @@ sub pk_depends_on { my $rel_source = $self->related_source($relname); foreach my $p ($self->primary_columns) { -# print "Checking if $p is still needed\n"; - - if (exists $keyhash->{$p}) { - my $rel_val = $keyhash->{$p}; -# print STDERR "PK col $p, val=$rel_val\n"; - # This column of self is autoinc. It is never needed. - if ($self->column_info($p)->{is_auto_increment}) { -# print STDERR "$p is autoinc, already resolved\n"; - next; - } - - # This column already has data provided. (Existing_data should - # be hard data only, not refs to things not yet there!) - if (defined $existing_data->{$p}) { -# print STDERR "$p is in existing data, already resolved\n"; - next; - } - - # Already is provided for by this relationship. - if (defined $rel_data->{$rel_val}) { -# print STDERR "$p is already resolved by this relationship (to $relname.$rel_val)\n"; - next; - } - - # Can be provided by the relationship that we are currently - # looking at. Money-shot. - if ($rel_source->column_info($rel_val)->{is_auto_increment}) { -# print STDERR "$p *WOULD BE* resolved by this relationship (but isn't yet).\n"; - return 1; - } - - # Can this be provided by the relationship that we are - # currently looking at? Well, first the thing this is - # related to needs to be able to provide it for - # itself... which is what the function we are now writing is - # supposed to find out. Recurse. - for ($rel_source->relationships) { - # We need to skip the reverse relationship, or we will - # often recurse infinitely. - next if $_ eq (keys %{$self->reverse_relationship_info($relname)})[0]; - # Do we need to skip the entire call stack's worth of - # backrelationships? If so, we need a skiplist argument - # to this function -- easy to do, since we don't have - # any final arguments. - if ($rel_source->pk_depends_on($_, {}, $rel_data)) { - # If this relationship can resolve it, then this pk field - # can be resolved by $relname. -# print "$p *WOULD BE* resolved by this relationship (but isn't yet).\n"; - return 1; - } - } - - # Bad, we are dependent. -# print "Unresolved PK column $p, but it cannot be resolved by this relationship\n"; - return 0; -# unless (defined($rel_data->{$keyhash->{$p}}) -# # foreign col might be an fk itself, and not auto-inc! -# || $rel_source->column_info($keyhash->{$p}) -# ->{is_auto_increment} -# # but only if its not an fk to the one we were asking about! -# || ( $rel_source->column_info($keyhash->{$p}) -# ->{is_foreign_key} -# && $self->relationship_info($relname)->{attrs}{accessor} eq 'single' -# )) { -# # This needs to be true if this col is an fk on rel_source -# # || !$rel_source->relationship_info($p) ) { -# print STDERR "not dependant\n"; -# return 0; -# # return $p; -# } + if (exists $keyhash->{$p}) { + unless (defined($rel_data->{$keyhash->{$p}}) + || $rel_source->column_info($keyhash->{$p}) + ->{is_auto_increment}) { + return 0; } + } } -# print STDERR "not dependant\n"; - return 0; + return 1; } =head2 resolve_condition @@ -912,7 +1200,11 @@ sub resolve_condition { #warn "$self $k $for $v"; unless ($for->has_column_loaded($v)) { if ($for->in_storage) { - $self->throw_exception("Column ${v} not loaded on ${for} trying to resolve relationship"); + $self->throw_exception( + "Column ${v} not loaded or not passed to new() prior to insert()" + ." on ${for} trying to resolve relationship (maybe you forgot " + ."to call ->reload_from_storage to get defaults from the db)" + ); } return $UNRESOLVABLE_CONDITION; } @@ -1069,6 +1361,8 @@ sub resolve_prefetch { =item Arguments: $relname +=item Return value: $source + =back Returns the result source object for the given relationship. @@ -1089,6 +1383,8 @@ sub related_source { =item Arguments: $relname +=item Return value: $classname + =back Returns the class name for objects in the given relationship. @@ -1103,75 +1399,6 @@ sub related_class { return $self->schema->class($self->relationship_info($rel)->{source}); } -=head2 resultset - -Returns a resultset for the given source. This will initially be created -on demand by calling - - $self->resultset_class->new($self, $self->resultset_attributes) - -but is cached from then on unless resultset_class changes. - -=head2 resultset_class - -` package My::ResultSetClass; - use base 'DBIx::Class::ResultSet'; - ... - - $source->resultset_class('My::ResultSet::Class'); - -Set the class of the resultset, this is useful if you want to create your -own resultset methods. Create your own class derived from -L<DBIx::Class::ResultSet>, and set it here. If called with no arguments, -this method returns the name of the existing resultset class, if one -exists. - -=head2 resultset_attributes - - $source->resultset_attributes({ order_by => [ 'id' ] }); - -Specify here any attributes you wish to pass to your specialised -resultset. For a full list of these, please see -L<DBIx::Class::ResultSet/ATTRIBUTES>. - -=cut - -sub resultset { - my $self = shift; - $self->throw_exception( - 'resultset does not take any arguments. If you want another resultset, '. - 'call it on the schema instead.' - ) if scalar @_; - - return $self->resultset_class->new( - $self, - { - %{$self->{resultset_attributes}}, - %{$self->schema->default_resultset_attributes} - }, - ); -} - -=head2 source_name - -=over 4 - -=item Arguments: $source_name - -=back - -Set the name of the result source when it is loaded into a schema. -This is usefull if you want to refer to a result source by a name other than -its class name. - - package ArchivedBooks; - use base qw/DBIx::Class/; - __PACKAGE__->table('books_archive'); - __PACKAGE__->source_name('Books'); - - # from your schema... - $schema->resultset('Books')->find(1); - =head2 handle Obtain a new handle to this source. Returns an instance of a @@ -1201,14 +1428,41 @@ sub throw_exception { } } -=head2 sqlt_deploy_hook($sqlt_table) +=head2 source_info + +Stores a hashref of per-source metadata. No specific key names +have yet been standardized, the examples below are purely hypothetical +and don't actually accomplish anything on their own: + + __PACKAGE__->source_info({ + "_tablespace" => 'fast_disk_array_3', + "_engine" => 'InnoDB', + }); + +=head2 new + + $class->new(); + + $class->new({attribute_name => value}); -An optional sub which you can declare in your own Schema class that will get -passed the L<SQL::Translator::Schema::Table> object when you deploy the schema -via L</create_ddl_dir> or L</deploy>. +Creates a new ResultSource object. Not normally called directly by end users. + +=head2 column_info_from_storage + +=over + +=item Arguments: 1/0 (default: 0) + +=item Return value: 1/0 + +=back + + __PACKAGE__->column_info_from_storage(1); + +Enables the on-demand automatic loading of the above column +metadata from storage as neccesary. This is *deprecated*, and +should not be used. It will be removed before 1.0. -For an example of what you can do with this, see -L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>. =head1 AUTHORS