Revision history for DBIx::Class
-0.05999_05
+0.06001
+ - Added fix for quoting with single table
+
+0.06000
+ - Lots of documentation improvements
+ - Minor tweak to related_resultset to prevent it storing a searched rs
- Fixup to columns_info_for when database returns type(size)
- Made do_txn respect void context (on the off-chance somebody cares)
- Fix exception text for nonexistent key in ResultSet::find()
- $schema->deploy
- HAVING support
- prefetch for has_many
+ - cache attr for resultsets
- PK::Auto::* no longer required since Storage::DBI::* handle auto-inc
- minor tweak to tests for join edge case
- added cascade_copy relationship attribute
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.05999_04';
+$VERSION = '0.06000';
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
=head1 SYNOPSIS
-Create a base schema class called DB/Main.pm:
+Create a schema class called DB/Main.pm:
package DB::Main;
use base qw/DBIx::Class::Schema/;
1;
-Create a class to represent artists, who have many CDs, in DB/Main/Artist.pm:
+Create a table class to represent artists, who have many CDs, in DB/Main/Artist.pm:
package DB::Main::Artist;
use base qw/DBIx::Class/;
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/ artistid name /);
__PACKAGE__->set_primary_key('artistid');
- __PACKAGE__->has_many('cds' => 'DB::Main::CD');
+ __PACKAGE__->has_many(cds => 'DB::Main::CD');
1;
-A class to represent a CD, which belongs to an artist, in DB/Main/CD.pm:
+A table class to represent a CD, which belongs to an artist, in DB/Main/CD.pm:
package DB::Main::CD;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('cd');
- __PACKAGE__->add_columns(qw/ cdid artist title year/);
+ __PACKAGE__->add_columns(qw/ cdid artist title year /);
__PACKAGE__->set_primary_key('cdid');
- __PACKAGE__->belongs_to('artist' => 'DB::Main::Artist');
+ __PACKAGE__->belongs_to(artist => 'DB::Main::Artist');
1;
Then you can use these classes in your application's code:
# Connect to your database.
- my $ds = DB::Main->connect(@dbi_dsn);
+ use DB::Main;
+ my $schema = DB::Main->connect($dbi_dsn, $user, $pass, \%dbi_params);
# Query for all artists and put them in an array,
# or retrieve them as a result set object.
- my @all_artists = $ds->resultset('Artist')->all;
- my $all_artists_rs = $ds->resultset('Artist');
+ my @all_artists = $schema->resultset('Artist')->all;
+ my $all_artists_rs = $schema->resultset('Artist');
# Create a result set to search for artists.
# This does not query the DB.
- my $johns_rs = $ds->resultset('Artist')->search(
- # Build your WHERE using an SQL::Abstract structure:
- { 'name' => { 'like', 'John%' } }
+ my $johns_rs = $schema->resultset('Artist')->search(
+ # Build your WHERE using an L<SQL::Abstract> structure:
+ { name => { like => 'John%' } }
);
- # This executes a joined query to get the cds
+ # Execute a joined query to get the cds.
my @all_john_cds = $johns_rs->search_related('cds')->all;
- # Queries but only fetches one row so far.
+ # Fetch only the next row.
my $first_john = $johns_rs->next;
+ # Specify ORDER BY on the query.
my $first_john_cds_by_title_rs = $first_john->cds(
undef,
{ order_by => 'title' }
);
- my $millennium_cds_rs = $ds->resultset('CD')->search(
+ # Create a result set that will fetch the artist relationship
+ # at the same time as it fetches CDs, using only one query.
+ my $millennium_cds_rs = $schema->resultset('CD')->search(
{ year => 2000 },
{ prefetch => 'artist' }
);
my $cd = $millennium_cds_rs->next; # SELECT ... FROM cds JOIN artists ...
my $cd_artist_name = $cd->artist->name; # Already has the data so no query
- my $new_cd = $ds->resultset('CD')->new({ title => 'Spoon' });
+ my $new_cd = $schema->resultset('CD')->new({ title => 'Spoon' });
$new_cd->artist($cd->artist);
$new_cd->insert; # Auto-increment primary key filled in after INSERT
$new_cd->title('Fork');
- $ds->txn_do(sub { $new_cd->update }); # Runs the update in a transaction
+ $schema->txn_do(sub { $new_cd->update }); # Runs the update in a transaction
$millennium_cds_rs->update({ year => 2002 }); # Single-query bulk update
DBIx::Class can handle multi-column primary and foreign keys, complex
queries and database-level paging, and does its best to only query the
-database when it actually needs to in order to return something you've directly
-asked for. If a resultset is used as an iterator it only fetches rows off
-the statement handle as requested in order to minimise memory usage. It
-has auto-increment support for SQLite, MySQL, PostgreSQL, Oracle, SQL
-Server and DB2 and is known to be used in production on at least the first
-four, and is fork- and thread-safe out of the box (although your DBD may not
-be).
+database in order to return something you've directly asked for. If a
+resultset is used as an iterator it only fetches rows off the statement
+handle as requested in order to minimise memory usage. It has auto-increment
+support for SQLite, MySQL, PostgreSQL, Oracle, SQL Server and DB2 and is
+known to be used in production on at least the first four, and is fork-
+and thread-safe out of the box (although your DBD may not be).
This project is still under rapid development, so features added in the
-latest major release may not work 100% yet - check the Changes if you run
+latest major release may not work 100% yet -- check the Changes if you run
into trouble, and beware of anything explicitly marked EXPERIMENTAL. Failing
test cases are *always* welcome and point releases are put out rapidly as
bugs are found and fixed.
Even so, we do our best to maintain full backwards compatibility for published
-APIs since DBIx::Class is used in production in a number of organisations;
-the test suite is now fairly substantial and several developer releases are
+APIs, since DBIx::Class is used in production in a number of organisations.
+The test suite is quite substantial, and several developer releases are
generally made to CPAN before the -current branch is merged back to trunk for
a major release.
-The community can be found via -
+The community can be found via:
Mailing list: http://lists.rawmode.org/mailman/listinfo/dbix-class/
scotty: Scotty Allen <scotty@scottyallen.com>
+sszabo: Stephan Szabo <sszabo@bigpanda.com>
+
Todd Lipcon
wdh: Will Hawes
CDBICompat::MightHave
/);
-=head1 Components
+=head1 COMPONENTS
=over 4
=item HasA
-Responsible for HasA relationships.
-
=item HasMany
-Responsible for HasMany relationships.
-
=item ImaDBI
=item LazyLoading
=item MightHave
-Responsible for MightHave relationships.
-
=item ObjIndexStubs
=item ReadOnly
=item Triggers
-This class implements the trigger functionality.
-
=item PassThrough
=back
=over 4
+=item L<DBIx::Class::Serialize::Storable>
+
=item L<DBIx::Class::InflateColumn>
=item L<DBIx::Class::Relationship>
=head2 new
-=back
-
Virtual method. Returns a new L<DBIx::Class::Cursor> object.
=cut
=head2 next
-=back
-
Virtual method. Advances the cursor to the next row.
=cut
=head2 reset
-=back
-
Virtual method. Resets the cursor to the beginning.
=cut
=head2 all
-=back
-
Virtual method. Returns all rows in the L<DBIx::Class::ResultSet>.
=cut
=over 4
-=item Arguments: ('relname', 'Foreign::Class', $cond, $attrs)
+=item Arguments: 'relname', 'Foreign::Class', $cond, $attrs
=back
=over 4
-=item Arguments: ($relname, $rel_info)
+=item Arguments: $relname, $rel_info
=back
=over 4
-=item Arguments: ($relationship_name)
+=item Arguments: $relationship_name
-=item Returns: $related_resultset
+=item Return Value: $related_resultset
=back
=item Return Value: $rs
-=item
-
=back
The resultset constructor. Takes a source object (usually a
# year = 2005 OR year = 2004
If you need to pass in additional attributes but no additional condition,
-call it as C<search(undef, \%attrs);>.
+call it as C<search(undef, \%attrs)>.
# "SELECT name, artistid FROM $artist_table"
my @all_artists = $schema->resultset('Artist')->search(undef, {
=over 4
-=item Arguments: (@values | \%cols), \%attrs?
+=item Arguments: @values | \%cols, \%attrs?
=item Return Value: $row_object
name => 'Emo-R-Us',
});
-Search the specified relationship, optionally specify a condition and
+Searches the specified relationship, optionally specifying a condition and
attributes for matching records. See L</ATTRIBUTES> for more information.
=cut
# WHERE title LIKE '%blue%'
$cd_rs = $rs->search_like({ title => '%blue%'});
-Perform a search, but use C<LIKE> instead of C<=> as the condition. Note
+Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
that this is simply a convenience method. You most likely want to use
L</search> with specific operators.
=back
Returns a resultset or object list representing a subset of elements from the
-resultset slice is called on. Indexes are from 0 - i.e. to get the first
-three records, call
+resultset slice is called on. Indexes are from 0, i.e., to get the first
+three records, call:
my ($one, $two, $three) = $rs->slice(0, 2);
=over 4
-=item Arguments: ($cond, \%attrs?)?
+=item Arguments: $cond, \%attrs??
=item Return Value: $count
=back
Resets the resultset and returns an object for the first result (if the
-resultset contains anything).
+resultset returns anything).
=cut
=back
-Fetches all objects and updates them one at a time. Note that C<update_all>
-will run cascade triggers while L</update> will not.
+Fetches all objects and updates them one at a time. Note that C<update_all>
+will run DBIC cascade triggers, while L</update> will not.
=cut
=back
Deletes the contents of the resultset from its result source. Note that this
-will not run cascade triggers. See L</delete_all> if you need triggers to run.
+will not run DBIC cascade triggers. See L</delete_all> if you need triggers
+to run.
=cut
=back
-Fetches all objects and deletes them one at a time. Note that C<delete_all>
-will run cascade triggers while L</delete> will not.
+Fetches all objects and deletes them one at a time. Note that C<delete_all>
+will run DBIC cascade triggers, while L</delete> will not.
=cut
Returns a resultset for the $page_number page of the resultset on which page
is called, where each page contains a number of rows equal to the 'rows'
-attribute set on the resultset, or 10 by default
+attribute set on the resultset (10 by default).
=cut
$class->update_or_create({ col => $val, ... });
-First, search for an existing row matching one of the unique constraints
-(including the primary key) on the source of this resultset. If a row is
-found, update it with the other given column values. Otherwise, create a new
+First, searches for an existing row matching one of the unique constraints
+(including the primary key) on the source of this resultset. If a row is
+found, updates it with the other given column values. Otherwise, creates a new
row.
Takes an optional C<key> attribute to search on a specific unique constraint.
If no C<key> is specified, it searches on all unique constraints defined on the
source, including the primary key.
-If the C<key> is specified as C<primary>, search only on the primary key.
+If the C<key> is specified as C<primary>, it searches only on the primary key.
See also L</find> and L</find_or_create>.
=back
-Gets the contents of the cache for the resultset if the cache is set
+Gets the contents of the cache for the resultset, if the cache is set.
=cut
=item Value: ($order_by | \@order_by)
+=back
+
Which column(s) to order the results by. This is currently passed
through directly to SQL, so you can give e.g. C<year DESC> for a
descending order on the column `year'.
In simple terms, C<from> works as follows:
[
- { <alias> => <table>, -join-type => 'inner|left|right' }
+ { <alias> => <table>, -join_type => 'inner|left|right' }
[] # nested JOIN (optional)
{ <table.column> => <foreign_table.foreign_key> }
]
from => [
{ child => 'person' },
[
- { father => 'person', -join-type => 'inner' },
+ { father => 'person', -join_type => 'inner' },
{ 'father.id' => 'child.father_id' }
],
]
$table->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.
+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.
-Repeated calls of this method will add more columns, not replace them.
-
-The contents of the column_info are not set in stone, the following
-keys are currently recognised/used by DBIx::Class.
+The contents of the column_info are not set in stone. The following
+keys are currently recognised/used by DBIx::Class:
=over 4
=item data_type
-This contains the column type, it is automatically filled by the
+This contains the column type. It is automatically filled by the
L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
-L<DBIx::Class::Schema::Loader> module. If you do not enter the
+L<DBIx::Class::Schema::Loader> module. If you do not enter a
data_type, DBIx::Class will attempt to retrieve it from the
-database for you, using L<DBI>s column_info method. The values of this
+database for you, using L<DBI>'s column_info method. The values of this
key are typically upper-cased.
-Currently there is no standard set of values for the data_type, use
-whatever your database(s) support.
+Currently there is no standard set of values for the data_type. Use
+whatever your database supports.
=item size
=item is_nullable
-If the column is allowed to contain NULL values, set a true value
-(typically 1), here. This is currently not used by DBIx::Class.
+Set this to a true value for a columns that is allowed to contain
+NULL values. This is currently not used by DBIx::Class.
=item is_auto_increment
-Set this to a true value if this is a column that is somehow
-automatically filled. This is used to determine which columns to empty
+Set this to a true value for a column whose value is somehow
+automatically set. This is used to determine which columns to empty
when cloning objects using C<copy>.
=item is_foreign_key
-Set this to a true value if this column represents a key from a
+Set this to a true value for a column that contains a key from a
foreign table. This is currently not used by DBIx::Class.
=item default_value
-Set this to the default value which will be inserted into this column
-by the database. Can contain either values or functions. This is
+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 not used by DBIx::Class.
=item sequence
-Sets the name of the sequence to use to generate values. If not
-specified, L<DBIx::Class::PK::Auto> will attempt to retrieve the
-name of the sequence from the database automatically.
+Set this on a primary key column to the name of the sequence used to
+generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
+will attempt to retrieve the name of the sequence from the database
+automatically.
=back
$table->add_column('col' => \%info?);
-Convenience alias to add_columns
+Convenience alias to add_columns.
=cut
if ($obj->has_column($col)) { ... }
-Returns 1 if the source has a column of this name, 0 otherwise.
+Returns true if the source has a column of this name, false otherwise.
=cut
my @column_names = $obj->columns;
-Returns all column names in the order they were declared to add_columns
+Returns all column names in the order they were declared to add_columns.
=cut
=over 4
-=item Arguments: (@cols)
+=item Arguments: @cols
=back
Declare a unique constraint on this source. Call once for each unique
constraint. Unique constraints are used when you call C<find> on a
-L<DBIx::Class::ResultSet>, only columns in the constraint are searched,
-
-e.g.,
+L<DBIx::Class::ResultSet>. Only columns in the constraint are searched,
+for example:
# For UNIQUE (column1, column2)
__PACKAGE__->add_unique_constraint(
=head2 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.
+retrieval from this source. In the case of a database, the required FROM
+clause contents.
=cut
'foreign.book_id' => 'self.id',
});
-The condition C<$cond> needs to be an SQL::Abstract-style
+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,
Then, assuming LinerNotes has an accessor named notes, you can do:
my $cd = CD->find(1);
- $cd->notes('Notes go here'); # set notes -- LinerNotes object is
- # created if it doesn't exist
+ # set notes -- LinerNotes object is created if it doesn't exist
+ $cd->notes('Notes go here');
=item accessor
=head2 relationships
-Returns all valid relationship names for this source
+Returns all relationship names for this source.
=cut
=over 4
-=item Arguments: ($relname)
+=item Arguments: $relname
=back
-Returns the relationship information for the specified relationship name
+Returns a hash of relationship information for the specified relationship
+name.
=cut
=over 4
-=item Arguments: ($rel)
+=item Arguments: $rel
=back
-Returns 1 if the source has a relationship of this name, 0 otherwise.
+Returns true if the source has a relationship of this name, false otherwise.
=cut
=over 4
-=item Arguments: ($relation)
+=item Arguments: $relation
=back
-Returns the join structure required for the related result source
+Returns the join structure required for the related result source.
=cut
=over 4
-=item Arguments: ($cond, $as, $alias|$object)
+=item Arguments: $cond, $as, $alias|$object
=back
=over 4
-=item Arguments: (hashref/arrayref/scalar)
+=item Arguments: hashref/arrayref/scalar
=back
=over 4
-=item Arguments: ($relname)
+=item Arguments: $relname
=back
-Returns the result source object for the given relationship
+Returns the result source object for the given relationship.
=cut
=over 4
-=item Arguments: ($relname)
+=item Arguments: $relname
=back
-Returns the class object for the given relationship
+Returns the class name for objects in the given relationship.
=cut
=head2 throw_exception
-See throw_exception in L<DBIx::Class::Schema>.
+See L<DBIx::Class::Schema/"throw_exception">.
=cut
}
}
-
=head1 AUTHORS
Matt S. Trout <mst@shadowcatsystems.co.uk>
=over 4
-=item Arguments: ($column, $column_info)
+=item Arguments: $column, $column_info
=back
with your classes.
NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
-carefully as DBIx::Class does things a little differently. Note in
+carefully, as DBIx::Class does things a little differently. Note in
particular which module inherits off which.
=head1 METHODS
=over 4
-=item Arguments: ($moniker, $component_class)
+=item Arguments: $moniker, $component_class
=back
Registers a class which isa L<DBIx::Class::ResultSourceProxy>. Equivalent to
-calling
+calling:
$schema->register_source($moniker, $component_class->result_source_instance);
=over 4
-=item Arguments: ($moniker, $result_source)
+=item Arguments: $moniker, $result_source
=back
=over 4
-=item Arguments: ($moniker)
+=item Arguments: $moniker
-=item Returns: $classname
+=item Return Value: $classname
=back
-Retrieves the result class name for the given moniker.
-
-e.g.,
+Retrieves the result class name for the given moniker. For example:
my $class = $schema->class('CD');
=over 4
-=item Arguments: ($moniker)
+=item Arguments: $moniker
-=item Returns: $result_source
+=item Return Value: $result_source
=back
=over 4
-=item Returns: @source_monikers
+=item Return Value: @source_monikers
=back
Returns the source monikers of all source registrations on this schema.
-
-e.g.,
+For example:
my @source_monikers = $schema->sources;
=over 4
-=item Arguments: ($moniker)
+=item Arguments: $moniker
-=item Returns: $result_set
+=item Return Value: $result_set
=back
the schema's namespace. Otherwise, this method loads the classes you specify
(using L<use>), and registers them (using L</"register_class">).
-It is possible to comment out classes with a leading '#', but note that perl
-will think it's a mistake (trying to use a comment in a qw list) so you'll
-need to add "no warnings 'qw';" before your load_classes call.
+It is possible to comment out classes with a leading C<#>, but note that perl
+will think it's a mistake (trying to use a comment in a qw list), so you'll
+need to add C<no warnings 'qw';> before your load_classes call.
-e.g.,
+Example:
My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
# etc. (anything under the My::Schema namespace)
=over 4
-=item Arguments: ($target_namespace, @db_info)
+=item Arguments: $target_namespace, @db_info
-=item Returns: $new_schema
+=item Return Value: $new_schema
=back
-Calls L<DBIx::Class::schema/"compose_namespace"> to the target namespace,
-calls L<DBIx::Class::Schema/connection>(@db_info) on the new schema, then
-injects the L<DBix::Class::ResultSetProxy> component and a resultset_instance
-classdata entry on all the new classes in order to support
+Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
+calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
+then injects the L<DBix::Class::ResultSetProxy> component and a
+resultset_instance classdata entry on all the new classes, in order to support
$target_namespaces::$class->search(...) method calls.
This is primarily useful when you have a specific need for class method access
=item Arguments: $target_namespace, $additional_base_class?
-=item Returns: $new_schema
+=item Return Value: $new_schema
=back
classes will inherit from first the corresponding classe from the current
schema then the base class.
-e.g. (for a schema with My::Schema::CD and My::Schema::Artist classes),
+For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
$schema->compose_namespace('My::DB', 'Base::Class');
print join (', ', @My::DB::CD::ISA) . "\n";
print join (', ', @My::DB::Artist::ISA) ."\n";
-Will produce the output
+will produce the output
My::Schema::CD, Base::Class
My::Schema::Artist, Base::Class
=over 4
-=item Arguments: ($target, @info)
+=item Arguments: $target, @info
=back
=over 4
-=item Arguments: (@args)
+=item Arguments: @args
-=item Returns: $new_schema
+=item Return Value: $new_schema
=back
=over 4
-=item Arguments: (@info)
+=item Arguments: @info
-=item Returns: $new_schema
+=item Return Value: $new_schema
=back
=over 4
-=item Arguments: (C<$coderef>, @coderef_args?)
+=item Arguments: C<$coderef>, @coderef_args?
-=item Returns: The return value of $coderef
+=item Return Value: The return value of $coderef
=back
=over 4
-=item Returns: $new_schema
+=item Return Value: $new_schema
=back
=over 4
-=item Arguments: ($moniker, \@data);
+=item Arguments: $moniker, \@data;
=back
=over 4
-=item Arguments: ($message)
+=item Arguments: $message
=back
=over 4
-=item Arguments: ($sqlt_args)
+=item Arguments: $sqlt_args
=back
=head1 NAME
DBIx::Class::Serialize::Storable - hooks for Storable freeze/thaw
- (EXPERIMENTAL)
=head1 SYNOPSIS
# meanwhile, in a nearby piece of code
my $cd = $schema->resultset('CD')->find(12);
- $cache->set($cd->ID, $cd); # if the cache uses Storable, this
- # will work automatically
+ # if the cache uses Storable, this will work automatically
+ $cache->set($cd->ID, $cd);
=head1 DESCRIPTION
This component adds hooks for Storable so that row objects can be
serialized. It assumes that your row object class (C<result_class>) is
-the same as your table class, which is the normal situation. However,
-this code is not yet well tested, and so should be considered
-experimental.
+the same as your table class, which is the normal situation.
=head1 AUTHORS
sub select {
my ($self, $table, $fields, $where, $order, @rest) = @_;
+ $table = $self->_quote($table) unless ref($table);
@rest = (-1) unless defined $rest[0];
local $self->{having_bind} = [];
my ($sql, @ret) = $self->SUPER::select(
return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
}
+sub insert {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::insert($table, @_);
+}
+
+sub update {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::update($table, @_);
+}
+
+sub delete {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::delete($table, @_);
+}
+
sub _emulate_limit {
my $self = shift;
if ($_[3] == -1) {
} elsif (ref $from eq 'HASH') {
return $self->_make_as($from);
} else {
- return $from;
+ return $from; # would love to quote here but _table ends up getting called
+ # twice during an ->select without a limit clause due to
+ # the way S::A::Limit->select works. should maybe consider
+ # bypassing this and doing S::A::select($self, ...) in
+ # our select method above. meantime, quoting shims have
+ # been added to select/insert/update/delete here
}
}
$self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n");
}
my $sth = $self->sth($sql,$op);
- $self->throw_exception("no sth generated via sql: $sql") unless $sth;
+ $self->throw_exception('no sth generated via sql (' . $self->_dbh->errstr . "): $sql") unless $sth;
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv;
if ($sth) {
sub deploy {
my ($self, $schema, $type, $sqltargs) = @_;
- my @statements = $self->deployment_statements($schema, $type, $sqltargs);
- foreach(split(";\n", @statements)) {
- $self->debugfh->print("$_\n") if $self->debug;
- $self->dbh->do($_) or warn "SQL was:\n $_";
+ foreach my $statement ( $self->deployment_statements($schema, $type, $sqltargs) ) {
+ for ( split(";\n", $statement)) {
+ $self->debugfh->print("$_\n") if $self->debug;
+ $self->dbh->do($_) or warn "SQL was:\n $_";
+ }
}
}
=head2 new
-=back
-
Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
=cut
=over 4
-=item Arguments: (none)
+=item Arguments: none
-=item Returns: \@row_columns
+=item Return Value: \@row_columns
=back
=over 4
-=item Arguments: (none)
+=item Arguments: none
-=item Returns: \@row_columns+
+=item Return Value: \@row_columns+
=back
=head2 reset
-=back
-
Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
=cut
=head1 NAME
-DBIx::Class::UUIDMaker::Win32:::Guidgen - Create uuids using Win32::Guidgen
+DBIx::Class::UUIDMaker::Win32::Guidgen - Create uuids using Win32::Guidgen
=head1 SYNOPSIS
=head1 NAME
-DBIx::Class::UUIDMaker::Win32API:::GUID - Create uuids using Win32API::GUID
+DBIx::Class::UUIDMaker::Win32API::GUID - Create uuids using Win32API::GUID
=head1 SYNOPSIS
foreach my $rel (@rels)
{
my $rel_info = $source->relationship_info($rel);
- next if(!exists $rel_info->{attrs}{accessor} ||
- $rel_info->{attrs}{accessor} eq 'multi');
- # Going by the accessor type isn't such a good idea (yes, I know
- # I suggested it). I think the best way to tell if something is a
- # foreign key constraint is to assume if it doesn't include our
- # primaries then it is (dumb but it'll do). Ignore any rel cond
- # that isn't a straight hash, but get both sets of keys in full
- # so you don't barf on multi-primaries. Oh, and a dog-simple
- # deploy method to chuck the results of this exercise at a db
- # for testing is
- # $schema->storage->dbh->do($_) for split(";\n", $sql);
- # -- mst (03:42 local time, please excuse any mistakes)
+
my $rel_table = $source->related_source($rel)->name;
- my $cond = (keys (%{$rel_info->{cond}}))[0];
- my ($refkey) = $cond =~ /^\w+\.(\w+)$/;
- my ($key) = $rel_info->{cond}->{$cond} =~ /^\w+\.(\w+)$/;
- if($rel_table && $refkey)
+
+ # Ignore any rel cond that isn't a straight hash
+ next unless ref $rel_info->{cond} eq 'HASH';
+
+ # Get the key information, mapping off the foreign/self markers
+ my @cond = keys(%{$rel_info->{cond}});
+ my @refkeys = map {/^\w+\.(\w+)$/} @cond;
+ my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
+
+ if($rel_table)
{
- $table->add_constraint(
- type => 'foreign_key',
- name => "fk_${key}",
- fields => $key,
- reference_fields => $refkey,
- reference_table => $rel_table,
- );
+
+ #Decide if this is a foreign key based on whether the self
+ #items are our primary columns.
+
+ # Make sure every self key is in the primary key list
+ my $found;
+ foreach my $key (@keys) {
+ $found = 0;
+ foreach my $prim ($source->primary_columns) {
+ if ($prim eq $key) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+
+ # Make sure every primary key column is in the self keys
+ if ($found) {
+ foreach my $prim ($source->primary_columns) {
+ $found = 0;
+ foreach my $key (@keys) {
+ if ($prim eq $key) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+ }
+
+ # if $found then the two sets are equal.
+
+ # If the sets are different, then we assume it's a foreign key from
+ # us to another table.
+ if (!$found) {
+ $table->add_constraint(
+ type => 'foreign_key',
+ name => "fk_$keys[0]",
+ fields => \@keys,
+ reference_fields => \@refkeys,
+ reference_table => $rel_table,
+ );
+ }
}
}
}
-
+ return 1;
}
1;
eval "use Test::Pod 1.14";
plan skip_all => 'Test::Pod 1.14 required' if $@;
-plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
all_pod_files_ok();
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 6 );
+ : ( tests => 7 );
}
use lib qw(t/lib);
{ join => 'artist' });
cmp_ok($rs->count,'==', 1,"join quoted with brackets.");
+my %data = (
+ name => 'Bill',
+ order => '12'
+);
+DBICTest->schema->storage->sql_maker->quote_char('`');
+DBICTest->schema->storage->sql_maker->name_sep('.');
+cmp_ok(DBICTest->schema->storage->sql_maker->update('group', \%data), 'eq', 'UPDATE `group` SET `name` = ?, `order` = ?', "quoted table names for UPDATE");
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+eval "use SQL::Translator";
+plan skip_all => 'SQL::Translator required' if $@;
+
+my $schema = DBICTest::Schema;
+
+plan tests => 27;
+
+my $translator = SQL::Translator->new(
+ parser_args => {
+ 'DBIx::Schema' => $schema,
+ },
+ producer_args => {
+ },
+);
+
+$translator->parser('SQL::Translator::Parser::DBIx::Class');
+$translator->producer('SQLite');
+
+my $output = $translator->translate();
+
+my @constraints =
+ (
+ {'display' => 'twokeys->cd',
+ 'selftable' => 'twokeys', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'twokeys->artist',
+ 'selftable' => 'twokeys', 'foreigntable' => 'artist',
+ 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'cd_to_producer->cd',
+ 'selftable' => 'cd_to_producer', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'cd_to_producer->producer',
+ 'selftable' => 'cd_to_producer', 'foreigntable' => 'producer',
+ 'selfcols' => ['producer'], 'foreigncols' => ['producerid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'self_ref_alias -> self_ref for self_ref',
+ 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
+ 'selfcols' => ['self_ref'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'self_ref_alias -> self_ref for alias',
+ 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
+ 'selfcols' => ['alias'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'cd -> artist',
+ 'selftable' => 'cd', 'foreigntable' => 'artist',
+ 'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'artist_undirected_map -> artist for id1',
+ 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
+ 'selfcols' => ['id1'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'artist_undirected_map -> artist for id2',
+ 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
+ 'selfcols' => ['id2'], 'foreigncols' => ['artistid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'track->cd',
+ 'selftable' => 'track', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 2, on_delete => '', on_update => ''},
+ {'display' => 'treelike -> treelike for parent',
+ 'selftable' => 'treelike', 'foreigntable' => 'treelike',
+ 'selfcols' => ['parent'], 'foreigncols' => ['id'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'twokeytreelike -> twokeytreelike for parent1,parent2',
+ 'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike',
+ 'selfcols' => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ {'display' => 'tags -> cd',
+ 'selftable' => 'tags', 'foreigntable' => 'cd',
+ 'selfcols' => ['cd'], 'foreigncols' => ['cdid'],
+ 'needed' => 1, on_delete => '', on_update => ''},
+ );
+
+my $tschema = $translator->schema();
+for my $table ($tschema->get_tables) {
+ my $table_name = $table->name;
+ for my $c ( $table->get_constraints ) {
+ next unless $c->type eq 'FOREIGN KEY';
+
+ ok(check($table_name, scalar $c->fields,
+ $c->reference_table, scalar $c->reference_fields,
+ $c->on_delete, $c->on_update), "Constraint on $table_name matches an expected constraint");
+ }
+}
+
+my $i;
+for ($i = 0; $i <= $#constraints; ++$i) {
+ ok(!$constraints[$i]->{'needed'}, "Constraint $constraints[$i]->{display}");
+}
+
+sub check {
+ my ($selftable, $selfcol, $foreigntable, $foreigncol, $ondel, $onupd) = @_;
+
+ $ondel = '' if (!defined($ondel));
+ $onupd = '' if (!defined($onupd));
+
+ my $i;
+ for ($i = 0; $i <= $#constraints; ++$i) {
+ if ($selftable eq $constraints[$i]->{'selftable'} &&
+ $foreigntable eq $constraints[$i]->{'foreigntable'} &&
+ ($ondel eq $constraints[$i]->{on_delete}) &&
+ ($onupd eq $constraints[$i]->{on_update})) {
+ # check columns
+
+ my $found = 0;
+ for (my $j = 0; $j <= $#$selfcol; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#{$constraints[$i]->{'selfcols'}}; ++$k) {
+ if ($selfcol->[$j] eq $constraints[$i]->{'selfcols'}->[$k] &&
+ $foreigncol->[$j] eq $constraints[$i]->{'foreigncols'}->[$k]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+
+ if ($found) {
+ for (my $j = 0; $j <= $#{$constraints[$i]->{'selfcols'}}; ++$j) {
+ $found = 0;
+ for (my $k = 0; $k <= $#$selfcol; ++$k) {
+ if ($selfcol->[$k] eq $constraints[$i]->{'selfcols'}->[$j] &&
+ $foreigncol->[$k] eq $constraints[$i]->{'foreigncols'}->[$j]) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+ }
+
+ if ($found) {
+ --$constraints[$i]->{needed};
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
'Producer',
'CD_to_Producer',
),
- qw/SelfRefAlias TreeLike/
+ qw/SelfRefAlias TreeLike TwoKeyTreeLike/
);
1;
--- /dev/null
+package # hide from PAUSE
+ DBICTest::Schema::TwoKeyTreeLike;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/Core/);
+
+__PACKAGE__->table('twokeytreelike');
+__PACKAGE__->add_columns(
+ 'id1' => { data_type => 'integer' },
+ 'id2' => { data_type => 'integer' },
+ 'parent1' => { data_type => 'integer' },
+ 'parent2' => { data_type => 'integer' },
+ 'name' => { data_type => 'varchar',
+ size => 100,
+ },
+);
+__PACKAGE__->set_primary_key(qw/id1 id2/);
+__PACKAGE__->belongs_to('parent', 'TwoKeyTreeLike',
+ { 'foreign.id1' => 'self.parent1', 'foreign.id2' => 'self.parent2'});
+
+1;
projects / dbsrgits/DBIx-Class.git / commitdiff