X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FManual%2FCookbook.pod;h=a0bce5e04a0e4b539427187e916e8a65f6449d2d;hb=9e64dfbf92b14c3dac77cf4ed8a8842114cdbfe5;hp=5a857fbb7ca3a3fed073181f0a70fafd6d10231a;hpb=1def34512e92e6b79853aceafec585080ede4960;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Manual/Cookbook.pod b/lib/DBIx/Class/Manual/Cookbook.pod index 5a857fb..a0bce5e 100644 --- a/lib/DBIx/Class/Manual/Cookbook.pod +++ b/lib/DBIx/Class/Manual/Cookbook.pod @@ -313,9 +313,8 @@ L has now prefetched all matching data from the C table, so no additional SQL statements are executed. You now have a much more efficient query. -Note that as of L 0.04, C cannot be used with -C relationships. You will get an error along the lines of "No -accessor for prefetched ..." if you try. +Note that as of L 0.05999_01, C I be used with +C relationships. Also note that C should only be used when you know you will definitely use data from a related table. Pre-fetching related tables when you @@ -402,6 +401,35 @@ SQL statements: 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' }); + +=head3 Ordering a relationship result set + +If you always want a relation to be ordered, you can specify this when you +create the relationship. + +To order C<< $book->pages >> by descending page_number. + + Book->has_many('pages' => 'Page', 'book', { order_by => \'page_number DESC'} ); + + + =head2 Transactions As of version 0.04001, there is improved transaction support in @@ -410,24 +438,22 @@ example of the recommended way to use it: my $genus = $schema->resultset('Genus')->find(12); + my $coderef2 = sub { + $genus->extinct(1); + $genus->update; + }; + my $coderef1 = sub { - my ($schema, $genus, $code) = @_; $genus->add_to_species({ name => 'troglodyte' }); $genus->wings(2); $genus->update; - $schema->txn_do($code, $genus); # Can have a nested transaction + $schema->txn_do($coderef2); # Can have a nested transaction return $genus->species; }; - my $coderef2 = sub { - my ($genus) = @_; - $genus->extinct(1); - $genus->update; - }; - my $rs; eval { - $rs = $schema->txn_do($coderef1, $schema, $genus, $coderef2); + $rs = $schema->txn_do($coderef1); }; if ($@) { # Transaction failed @@ -719,11 +745,11 @@ redispatches your call to store_column to the superclass(es). You might have a class C which has many Cs. Further, you want to create a C object every time you insert an C object. -You can accomplish this by overriding C: +You can accomplish this by overriding C on your objects: sub insert { - my ( $class, $args_ref ) = @_; - my $self = $class->next::method($args_ref); + my ( $self, @args ) = @_; + $self->next::method(@args); $self->cds->new({})->fill_from_artist($self)->insert; return $self; } @@ -753,18 +779,17 @@ dumping it. For example, package My::DB::CD; sub _dumper_hook { - my $obj = shift; - return bless { - %{ $obj }, + $_[0] = bless { + %{ $_[0] }, result_source => undef, - }, ref($obj); + }, ref($_[0]); } [...] use Data::Dumper; - $Data::Dumper::Freezer = '_dumper_hook'; + local $Data::Dumper::Freezer = '_dumper_hook'; my $cd = $schema->resultset('CD')->find(1); print Dumper($cd); @@ -776,7 +801,6 @@ base class and set C<$Data::Dumper::Freezer> to its name and L will automagically clean up your data before printing it. See L for more information. - =head2 Retrieving a row object's Schema It is possible to get a Schema object from a row object like so, @@ -788,4 +812,194 @@ It is possible to get a Schema object from a row object like so, This can be useful when you don't want to pass around a Schema object to every method. +=head2 Profiling + +When you enable L'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 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 using PK::Auto, this is straightforward: + + my $foo = $rs->create(\%blah); + # do more stuff + my $id = $foo->id; # foo->my_primary_key_field will also work. + +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 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) 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 method within the User proxy-class gives +us the effect we want. This method is called by L 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 + + package DB::Schema; + + use base qw/DBIx::Class::Schema/; + + __PACKAGE__->load_classes(qw/User/); + + +B + + 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.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