my $tag = $rs->first;
print $tag->cd->artist->name;
+=head2 Using relationships
+
+=head3 Create a new row in a related table
+
+ my $book->create_related('author', { name => 'Fred'});
+
+=head3 Search in a related table
+
+Only searches for books named 'Titanic' by the author in $author.
+
+ my $author->search_related('books', { name => 'Titanic' });
+
+=head3 Delete data in a related table
+
+Deletes only the book named Titanic by the author in $author.
+
+ my $author->delete_related('books', { name => 'Titanic' });
+
=head2 Transactions
As of version 0.04001, there is improved transaction support in
use Data::Dumper;
- $Data::Dumper::Freezer = '_dumper_hook';
+ local $Data::Dumper::Freezer = '_dumper_hook';
my $cd = $schema->resultset('CD')->find(1);
print Dumper($cd);
This can be useful when you don't want to pass around a Schema object to every
method.
+=head2 Profiling
+
+When you enable L<DBIx::Class::Storage::DBI>'s debugging it prints the SQL
+executed as well as notifications of query completion and transaction
+begin/commit. If you'd like to profile the SQL you can subclass the
+L<DBIx::Class::Storage::Statistics> class and write your own profiling
+mechanism:
+
+ package My::Profiler;
+ use strict;
+
+ use base 'DBIx::Class::Storage::Statistics';
+
+ use Time::HiRes qw(time);
+
+ my $start;
+
+ sub query_start {
+ my $self = shift();
+ my $sql = shift();
+ my $params = @_;
+
+ print "Executing $sql: ".join(', ', @params)."\n";
+ $start = time();
+ }
+
+ sub query_end {
+ my $self = shift();
+ my $sql = shift();
+ my @params = @_;
+
+ printf("Execution took %0.4f seconds.\n", time() - $start);
+ $start = undef;
+ }
+
+ 1;
+
+You can then install that class as the debugging object:
+
+ __PACKAGE__->storage()->debugobj(new My::Profiler());
+ __PACKAGE__->storage()->debug(1);
+
+A more complicated example might involve storing each execution of SQL in an
+array:
+
+ sub query_end {
+ my $self = shift();
+ my $sql = shift();
+ my @params = @_;
+
+ my $elapsed = time() - $start;
+ push(@{ $calls{$sql} }, {
+ params => \@params,
+ elapsed => $elapsed
+ });
+ }
+
+You could then create average, high and low execution times for an SQL
+statement and dig down to see if certain parameters cause aberrant behavior.
+
=head2 Getting the value of the primary key for the last database insert
AKA getting last_insert_id
If you are not using autoincrementing primary keys, this will probably
not work, but then you already know the value of the last primary key anyway.
+=head2 Dynamic Sub-classing DBIx::Class proxy classes
+(AKA multi-class object inflation from one table)
+
+L<DBIx::Class> classes are proxy classes, therefore some different techniques
+need to be employed for more than basic subclassing. In this example we have
+a single user table that carries a boolean bit for admin. We would like
+like to give the admin users objects(L<DBIx::Class::Row>) the same methods as
+a regular user but also special admin only methods. It doesn't make sense to
+create two seperate proxy-class files for this. We would be copying all the
+user methods into the Admin class. There is a cleaner way to accomplish this.
+
+Overriding the C<inflate_results()> method within the User proxy-class gives
+us the effect we want. This method is called by L<DBIx::Class::ResultSet> when
+inflating a result from storage. So we grab the object being returned, inspect
+the values we are looking for, bless it if it's an admin object, and then
+return it. Running the test file below will confirm this works.
+
+B<Schema Definition>
+
+ package DB::Schema;
+
+ use base qw/DBIx::Class::Schema/;
+
+ __PACKAGE__->load_classes(qw/User/);
+
+
+B<Proxy-Class definitions>
+
+ package DB::Schema::User;
+
+ use strict;
+ use warnings;
+ use base qw/DBIx::Class/;
+
+ ### Defined what our admin class is for ensure_class_loaded
+ my $admin_class = __PACKAGE__ . '::Admin';
+
+ __PACKAGE__->load_components(qw/PK::Auto Core/);
+
+ __PACKAGE__->table('users');
+
+ __PACKAGE__->add_columns(qw/user_id email password
+ firstname lastname active
+ admin/);
+
+ __PACKAGE__->set_primary_key('user_id');
+
+ sub inflate_result {
+ my $self = shift;
+ my $ret = $self->next::method(@_);
+ if( $ret->admin ) {### If this is an admin rebless for extra functions
+ $self->ensure_class_loaded( $admin_class );
+ bless $ret, $admin_class;
+ }
+ return $ret;
+ }
+
+ sub hello {
+ print "I am a regular user.\n";
+ return ;
+ }
+
+
+ package DB::Schema::User::Admin;
+
+ use strict;
+ use warnings;
+ use base qw/DB::Schema::User/;
+
+ sub hello
+ {
+ print "I am an admin.\n";
+ return;
+ }
+
+ sub do_admin_stuff
+ {
+ print "I am doing admin stuff\n";
+ return ;
+ }
+
+B<Test File> test.pl
+
+ use warnings;
+ use strict;
+ use DB::Schema;
+
+ my $user_data = { email => 'someguy@place.com',
+ password => 'pass1',
+ admin => 0 };
+
+ my $admin_data = { email => 'someadmin@adminplace.com',
+ password => 'pass2',
+ admin => 1 };
+
+ my $schema = DB::Schema->connection('dbi:Pg:dbname=test');
+
+ $schema->resultset('User')->create( $user_data );
+ $schema->resultset('User')->create( $admin_data );
+
+ ### Now we search for them
+ my $user = $schema->resultset('User')->single( $user_data );
+ my $admin = $schema->resultset('User')->single( $admin_data );
+
+ print ref $user, "\n";
+ print ref $admin, "\n";
+
+ print $user->password , "\n"; # pass1
+ print $admin->password , "\n";# pass2; inherited from User
+ print $user->hello , "\n";# I am a regular user.
+ print $admin->hello, "\n";# I am an admin.
+
+ ### The statement below will NOT print
+ print "I can do admin stuff\n" if $user->can('do_admin_stuff');
+ ### The statement below will print
+ print "I can do admin stuff\n" if $admin->can('do_admin_stuff');
+
=cut
projects / dbsrgits/DBIx-Class.git / blobdiff