Revision history for DBIx::Class
+ - added remove_column(s) to ResultSource/ResultSourceProxy
+ - added add_column alias to ResultSourceProxy
+ - added source_name to ResultSource
+ - load_classes now uses source_name and sets it if necessary
+
0.06001
+ - minor fix to update in case of undefined rels
+ - fixes for cascade delete
+ - substantial improvements and fixes to deploy
- Added fix for quoting with single table
+ - Substantial fixes and improvements to deploy
+ - slice now uses search directly
+ - fixes for update() on resultset
+ - bugfix to Cursor to avoid error during DESTROY
+ - transaction DBI operations now in debug trace output
0.06000
- Lots of documentation improvements
- remove build dependency on version.pm
0.05004 2006-02-13 20:59:00
- - allow specification of related columns via cols attr when primary
+ - allow specification of related columns via cols attr when primary
keys of the related table are not fetched
- fix count for group_by as scalar
- add horrific fix to make Oracle's retarded limit syntax work
=head1 NAME
- DBIx::Class::Manual::Component - Existing components and how to develop new ones.
+ DBIx::Class::Manual::Component - Developing DBIx::Class Components
+
+ =head1 WHAT IS A COMPONENT
+
+ A component is a module that can be added in to your DBIx::Class
+ classes to provide extra functionality. A good example is the PK::Auto
+ component which automatically retrieves primary keys that the database
+ itself creates, after the insert has happened.
=head1 USING
package My::Thing;
use base qw( DBIx::Class );
- __PACKAGE__->load_components(qw( PK::Auto Core ));
+ __PACKAGE__->load_components(qw/ PK::Auto Core /);
Generally you do not want to specify the full package name
of a component, instead take off the DBIx::Class:: part of
component outside of the normal namespace you can do so
by prepending the component name with a +.
- __PACKAGE__->load_components(qw( +My::Component ));
+ __PACKAGE__->load_components(qw/ +My::Component /);
Once a component is loaded all of it's methods, or otherwise,
that it provides will be available in your class.
mention anything about the order in which you should load
them.
+ =head1 CREATING COMPONENTS
+
+ Making your own component is very easy.
+
+ package DBIx::Class::MyComp;
+ use base qw(DBIx::Class);
+ # Create methods, accessors, load other components, etc.
+ 1;
+
+ When a component is loaded it is included in the calling
+ class' inheritance chain using L<Class::C3>. As well as
+ providing custom utility methods, a component may also
+ override methods provided by other core components, like
+ L<DBIx::Class::Row> and others. For example, you
+ could override the insert and delete methods.
+
+ sub insert {
+ my $self = shift;
+ # Do stuff with $self, like set default values.
+ return $self->next::method( @_ );
+ }
+
+ sub delete {
+ my $self = shift;
+ # Do stuff with $self.
+ return $self->next::method( @_ );
+ }
+
+ Now, the order that a component is loaded is very important. Components
+ that are loaded first are the first ones in the inheritance stack. So, if
+ you override insert() but the DBIx::Class::Row component is loaded first
+ then your insert() will never be called, since the DBIx::Class::Row insert()
+ will be called first. If you are unsure as to why a given method is not
+ being called try printing out the Class::C3 inheritance stack.
+
+ print join ', ' => Class::C3::calculateMRO('YourClass::Name');
+
+ Check out the L<Class::C3> docs for more information about inheritance.
+
=head1 EXISTING COMPONENTS
=head2 Extra
L<DBIx::Class::HTMLWidget> - Like FromForm but with DBIx::Class and HTML::Widget.
+L<DBIx::Class::Ordered> - Modify the position of objects in an ordered list.
+
L<DBIx::Class::PK::Auto> - Retrieve automatically created primary keys upon insert.
L<DBIx::Class::QueriesTime> - Display the amount of time it takes to run queries.
L<DBIx::Class::Row> - Basic row methods.
- =head1 CREATEING COMPONENTS
-
- Making your own component is very easy.
-
- package DBIx::Class::MyComp;
- use base qw(DBIx::Class);
- # Create methods, accessors, load other components, etc.
- 1;
-
- When a component is loaded it is included in the calling
- class' inheritance chain using L<Class::C3>. As well as
- providing custom utility methods, a component may also
- override methods provided by other core components, like
- L<DBIx::Class::Row> and others. For example, you
- could override the insert and delete methods.
-
- sub insert {
- my $self = shift;
- # Do stuff with $self, like set default values.
- return $self->nest::method( @_ );
- }
-
- sub delete {
- my $self = shift;
- # Do stuff with $self.
- return $self->nest::method( @_ );
- }
-
- Now, the order that a component is loaded is very important. Components
- that are loaded first are the first ones in the inheritance stack. So, if
- you override insert() but the DBIx::Class::Row component is loaded first
- then your insert() will never be called, since the DBIx::Class::Row insert()
- will be called first. If you are unsure as to why a given method is not
- being called try printing out the Class::C3 inheritance stack.
-
- print join ', ' => Class::C3::calculateMRO('YourClass::Name');
-
- Check out the L<Class::C3> docs for more information about inheritance.
-
=head1 SEE ALSO
L<DBIx::Class::Manual::Cookbook>
- L<DBIx::Class::Manual::FAQ>
-
=head1 AUTHOR
Aran Clary Deltac <bluefeet@cpan.org>
use Storable;
use Scalar::Util qw/weaken/;
+use DBIx::Class::ResultSetColumn;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
return (@data ? $self->_construct_object(@data) : ());
}
+=head2 get_column
+
+=over 4
+
+=item Arguments: $cond?
+
+=item Return Value: $resultsetcolumn
+
+=back
+
+ my $max_length = $rs->get_column('length')->max;
+
+Returns a ResultSetColumn instance for $column based on $self
+
+=cut
+
+sub get_column {
+ my ($self, $column) = @_;
+
+ my $new = DBIx::Class::ResultSetColumn->new($self, $column);
+ return $new;
+}
=head2 search_like
sub slice {
my ($self, $min, $max) = @_;
- my $attrs = { %{ $self->{attrs} || {} } };
- $attrs->{offset} ||= 0;
+ my $attrs = {}; # = { %{ $self->{attrs} || {} } };
+ $attrs->{offset} = $self->{attrs}{offset} || 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = (ref $self)->new($self->result_source, $attrs);
- return (wantarray ? $slice->all : $slice);
+ return $self->search(undef(), $attrs);
+ #my $slice = (ref $self)->new($self->result_source, $attrs);
+ #return (wantarray ? $slice->all : $slice);
}
=head2 next
print $cd->title;
}
+ Note that you need to store the resultset object, and call C<next> on it.
+ Calling C<< resultset('Table')->next >> repeatedly will always return the
+ first record from the resultset.
+
=cut
sub next {
return $_[0]->reset->next;
}
+ # _cond_for_update_delete
+ #
+ # update/delete require the condition to be modified to handle
+ # the differing SQL syntax available. This transforms the $self->{cond}
+ # appropriately, returning the new condition
+
+ sub _cond_for_update_delete {
+ my ($self) = @_;
+ my $cond = {};
+
+ if (!ref($self->{cond})) {
+ # No-op. No condition, we're update/deleting everything
+ }
+ elsif (ref $self->{cond} eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @{$self->{cond}}
+ ];
+ }
+ elsif (ref $self->{cond} eq 'HASH') {
+ if ((keys %{$self->{cond}})[0] eq '-and') {
+ $cond->{-and} = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @{$self->{cond}{-and}}
+ ];
+ }
+ else {
+ foreach my $key (keys %{$self->{cond}}) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $self->{cond}{$key};
+ }
+ }
+ }
+ else {
+ $self->throw_exception(
+ "Can't update/delete on resultset with condition unless hash or array");
+ }
+ return $cond;
+ }
+
+
=head2 update
=over 4
my ($self, $values) = @_;
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
+
+ my $cond = $self->_cond_for_update_delete;
+
return $self->result_source->storage->update(
- $self->result_source->from, $values, $self->{cond}
+ $self->result_source->from, $values, $cond
);
}
my ($self) = @_;
my $del = {};
- if (!ref($self->{cond})) {
-
- # No-op. No condition, we're deleting everything
-
- } elsif (ref $self->{cond} eq 'ARRAY') {
+ my $cond = $self->_cond_for_update_delete;
- $del = [ map { my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }; \%hash; } @{$self->{cond}} ];
-
- } elsif (ref $self->{cond} eq 'HASH') {
-
- if ((keys %{$self->{cond}})[0] eq '-and') {
-
- $del->{-and} = [ map { my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }; \%hash; } @{$self->{cond}{-and}} ];
-
- } else {
-
- foreach my $key (keys %{$self->{cond}}) {
- $key =~ /([^.]+)$/;
- $del->{$1} = $self->{cond}{$key};
- }
- }
-
- } else {
- $self->throw_exception(
- "Can't delete on resultset with condition unless hash or array"
- );
- }
-
- $self->result_source->storage->delete($self->result_source->from, $del);
+ $self->result_source->storage->delete($self->result_source->from, $cond);
return 1;
}
group_by => [qw/ column1 column2 ... /]
+ =head2 having
+
+ =over 4
+
+ =item Value: $condition
+
+ =back
+
+ HAVING is a select statement attribute that is applied between GROUP BY and
+ ORDER BY. It is applied to the after the grouping calculations have been
+ done.
+
+ having => { 'count(employee)' => { '>=', 100 } }
+
=head2 distinct
=over 4
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' =>
- qw/connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh
+ qw/_connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh
cursor on_connect_do transaction_depth/);
sub new {
=cut
+=head2 connect_info
+
+Connection information arrayref. Can either be the same arguments
+one would pass to DBI->connect, or a code-reference which returns
+a connected database handle. In either case, there is an optional
+final element in the arrayref, which can hold a hashref of
+connection-specific Storage::DBI options. These include
+C<on_connect_do>, and the sql_maker options C<limit_dialect>,
+C<quote_char>, and C<name_sep>. Examples:
+
+ ->connect_info([ 'dbi:SQLite:./foo.db' ]);
+ ->connect_info(sub { DBI->connect(...) });
+ ->connect_info([ 'dbi:Pg:dbname=foo',
+ 'postgres',
+ '',
+ { AutoCommit => 0 },
+ { quote_char => q{`}, name_sep => q{@} },
+ ]);
+
=head2 on_connect_do
Executes the sql statements given as a listref on every db connect.
return $self->_sql_maker;
}
+sub connect_info {
+ my ($self, $info_arg) = @_;
+
+ if($info_arg) {
+ my $info = [ @$info_arg ]; # copy because we can alter it
+ my $last_info = $info->[-1];
+ if(ref $last_info eq 'HASH') {
+ my $used;
+ if(my $on_connect_do = $last_info->{on_connect_do}) {
+ $used = 1;
+ $self->on_connect_do($on_connect_do);
+ }
+ for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
+ if(my $opt_val = $last_info->{$sql_maker_opt}) {
+ $used = 1;
+ $self->sql_maker->$sql_maker_opt($opt_val);
+ }
+ }
+
+ # remove our options hashref if it was there, to avoid confusing
+ # DBI in the case the user didn't use all 4 DBI options, as in:
+ # [ 'dbi:SQLite:foo.db', { quote_char => q{`} } ]
+ pop(@$info) if $used;
+ }
+
+ $self->_connect_info($info);
+ }
+
+ $self->_connect_info;
+}
+
sub _populate_dbh {
my ($self) = @_;
- my @info = @{$self->connect_info || []};
+ my @info = @{$self->_connect_info || []};
$self->_dbh($self->_connect(@info));
my $driver = $self->_dbh->{Driver}->{Name};
eval "require DBIx::Class::Storage::DBI::${driver}";
$DBI::connect_via = 'connect';
}
- if(ref $info[0] eq 'CODE') {
- $dbh = &{$info[0]};
- }
- else {
- $dbh = DBI->connect(@info);
- }
+ eval {
+ if(ref $info[0] eq 'CODE') {
+ $dbh = &{$info[0]};
+ }
+ else {
+ $dbh = DBI->connect(@info);
+ }
+ };
$DBI::connect_via = $old_connect_via if $old_connect_via;
- $self->throw_exception("DBI Connection failed: $DBI::errstr")
- unless $dbh;
+ if (!$dbh || $@) {
+ $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr));
+ }
$dbh;
}
sub txn_begin {
my $self = shift;
- $self->dbh->begin_work
- if $self->{transaction_depth}++ == 0 and $self->dbh->{AutoCommit};
+ if (($self->{transaction_depth}++ == 0) and ($self->dbh->{AutoCommit})) {
+ $self->debugfh->print("BEGIN WORK\n")
+ if ($self->debug);
+ $self->dbh->begin_work;
+ }
}
=head2 txn_commit
sub txn_commit {
my $self = shift;
if ($self->{transaction_depth} == 0) {
- $self->dbh->commit unless $self->dbh->{AutoCommit};
+ unless ($self->dbh->{AutoCommit}) {
+ $self->debugfh->print("COMMIT\n")
+ if ($self->debug);
+ $self->dbh->commit;
+ }
}
else {
- $self->dbh->commit if --$self->{transaction_depth} == 0;
+ if (--$self->{transaction_depth} == 0) {
+ $self->debugfh->print("COMMIT\n")
+ if ($self->debug);
+ $self->dbh->commit;
+ }
}
}
eval {
if ($self->{transaction_depth} == 0) {
- $self->dbh->rollback unless $self->dbh->{AutoCommit};
+ unless ($self->dbh->{AutoCommit}) {
+ $self->debugfh->print("ROLLBACK\n")
+ if ($self->debug);
+ $self->dbh->rollback;
+ }
}
else {
- --$self->{transaction_depth} == 0 ?
- $self->dbh->rollback :
+ if (--$self->{transaction_depth} == 0) {
+ $self->debugfh->print("ROLLBACK\n")
+ if ($self->debug);
+ $self->dbh->rollback;
+ }
+ else {
die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
+ }
}
};
my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
$self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n");
}
- my $sth = $self->sth($sql,$op);
- $self->throw_exception('no sth generated via sql (' . $self->_dbh->errstr . "): $sql") unless $sth;
+ my $sth = eval { $self->sth($sql,$op) };
+
+ if (!$sth || $@) {
+ $self->throw_exception('no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql");
+ }
+
@bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
my $rv;
if ($sth) {
- $rv = $sth->execute(@bind)
- or $self->throw_exception("Error executing '$sql': " . $sth->errstr);
+ $rv = eval { $sth->execute(@bind) };
+
+ if ($@ || !$rv) {
+ $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
+ }
} else {
$self->throw_exception("'$sql' did not generate a statement.");
}
sub run_tests {
my $schema = shift;
- plan tests => 46;
-plan tests => 44;
++plan tests => 49;
+
+ # figure out if we've got a version of sqlite that is older than 3.2.6, in
+ # which case COUNT(DISTINCT()) doesn't work
+ my $is_broken_sqlite = 0;
+ my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) =
+ split /\./, $schema->storage->dbh->get_info(18);
+ if( $schema->storage->dbh->get_info(17) eq 'SQLite' &&
+ ( ($sqlite_major_ver < 3) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) ||
+ ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) {
+ $is_broken_sqlite = 1;
+ }
+
my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
cmp_ok($or_rs->count, '==', 5, 'Search with OR ok');
my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', distinct => 1 });
-
cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok');
+ SKIP: {
+ skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1
+ if $is_broken_sqlite;
+
+ my $tcount = $schema->resultset("Track")->search(
+ {},
+ {
+ select => {count => {distinct => ['position', 'title']}},
+ as => ['count']
+ }
+ );
+ cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok');
+
+ }
my $tag_rs = $schema->resultset('Tag')->search(
[ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]);
cmp_ok($rel_rs->count, '==', 5, 'Related search ok');
cmp_ok($or_rs->next->cdid, '==', $rel_rs->next->cdid, 'Related object ok');
-
+ $or_rs->reset;
+ $rel_rs->reset;
my $tag = $schema->resultset('Tag')->search(
[ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next;
ok($schema->storage(), 'Storage available');
+ #test cascade_delete thru many_many relations
+ my $art_del = $schema->resultset("Artist")->find({ artistid => 1 });
+ $art_del->delete;
+ cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.');
+ cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.');
+
$schema->source("Artist")->{_columns}{'artistid'} = {};
my $typeinfo = $schema->source("Artist")->column_info('artistid');
$schema->source("Artist")->column_info('artistid');
ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set');
+# source_name should be set for normal modules
+is($schema->source('CD')->source_name, 'CD', 'source_name is set to moniker');
+
+# test the result source that uses source_name
+ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists');
+
+my @artsn = $schema->resultset("SourceNameArtists")->search({ }, { order_by => 'name DESC'});
+cmp_ok(@artsn, '==', 4, "Four artists returned");
+
+
+# test removed columns
+is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year/]);
+$schema->source('CD')->remove_columns('year');
+is_deeply([$schema->source('CD')->columns], [qw/cdid artist title/]);
+
}
1;
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff