Merge 'trunk' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Manual / Cookbook.pod
1 =head1 NAME 
2
3 DBIx::Class::Manual::Cookbook - Miscellaneous recipes
4
5 =head1 RECIPES
6
7 =head2 Searching
8
9 =head3 Paged results
10
11 When you expect a large number of results, you can ask L<DBIx::Class> for a
12 paged resultset, which will fetch only a small number of records at a time:
13
14   my $rs = $schema->resultset('Artist')->search(
15     undef,
16     {
17       page => 1,  # page to return (defaults to 1)
18       rows => 10, # number of results per page
19     },
20   );
21
22   return $rs->all(); # all records for page 1
23
24 The C<page> attribute does not have to be specified in your search:
25
26   my $rs = $schema->resultset('Artist')->search(
27     undef,
28     {
29       rows => 10,
30     }
31   );
32
33   return $rs->page(1); # DBIx::Class::ResultSet containing first 10 records
34
35 In either of the above cases, you can return a L<Data::Page> object for the
36 resultset (suitable for use in e.g. a template) using the C<pager> method:
37
38   return $rs->pager();
39
40 =head3 Complex WHERE clauses
41
42 Sometimes you need to formulate a query using specific operators:
43
44   my @albums = $schema->resultset('Album')->search({
45     artist => { 'like', '%Lamb%' },
46     title  => { 'like', '%Fear of Fours%' },
47   });
48
49 This results in something like the following C<WHERE> clause:
50
51   WHERE artist LIKE '%Lamb%' AND title LIKE '%Fear of Fours%'
52
53 Other queries might require slightly more complex logic:
54
55   my @albums = $schema->resultset('Album')->search({
56     -or => [
57       -and => [
58         artist => { 'like', '%Smashing Pumpkins%' },
59         title  => 'Siamese Dream',
60       ],
61       artist => 'Starchildren',
62     ],
63   });
64
65 This results in the following C<WHERE> clause:
66
67   WHERE ( artist LIKE '%Smashing Pumpkins%' AND title = 'Siamese Dream' )
68     OR artist = 'Starchildren'
69
70 For more information on generating complex queries, see
71 L<SQL::Abstract/WHERE CLAUSES>.
72
73 =head3 Using specific columns
74
75 When you only want selected columns from a table, you can use C<cols> to
76 specify which ones you need:
77
78   my $rs = $schema->resultset('Artist')->search(
79     undef,
80     {
81       columns => [qw/ name /]
82     }
83   );
84
85   # Equivalent SQL:
86   # SELECT artist.name FROM artist
87
88 =head3 Using database functions or stored procedures
89
90 The combination of C<select> and C<as> can be used to return the result of a
91 database function or stored procedure as a column value. You use C<select> to
92 specify the source for your column value (e.g. a column name, function, or
93 stored procedure name). You then use C<as> to set the column name you will use
94 to access the returned value:
95
96   my $rs = $schema->resultset('Artist')->search(
97     undef,
98     {
99       select => [ 'name', { LENGTH => 'name' } ],
100       as     => [qw/ name name_length /],
101     }
102   );
103
104   # Equivalent SQL:
105   # SELECT name name, LENGTH( name ) name_length
106   # FROM artist
107
108 If your alias exists as a column in your base class (i.e. it was added with
109 C<add_columns>), you just access it as normal. Our C<Artist> class has a C<name>
110 column, so we just use the C<name> accessor:
111
112   my $artist = $rs->first();
113   my $name = $artist->name();
114
115 If on the other hand the alias does not correspond to an existing column, you
116 can get the value using the C<get_column> accessor:
117
118   my $name_length = $artist->get_column('name_length');
119
120 If you don't like using C<get_column>, you can always create an accessor for
121 any of your aliases using either of these:
122
123   # Define accessor manually:
124   sub name_length { shift->get_column('name_length'); }
125     
126   # Or use DBIx::Class::AccessorGroup:
127   __PACKAGE__->mk_group_accessors('column' => 'name_length');
128
129 =head3 SELECT DISTINCT with multiple columns
130
131   my $rs = $schema->resultset('Foo')->search(
132     undef,
133     {
134       select => [
135         { distinct => [ $source->columns ] }
136       ],
137       as => [ $source->columns ]
138     }
139   );
140
141   my $count = $rs->next->get_column('count');
142
143 =head3 SELECT COUNT(DISTINCT colname)
144
145   my $rs = $schema->resultset('Foo')->search(
146     undef,
147     {
148       select => [
149         { count => { distinct => 'colname' } }
150       ],
151       as => [ 'count' ]
152     }
153   );
154
155 =head3 Grouping results
156
157 L<DBIx::Class> supports C<GROUP BY> as follows:
158
159   my $rs = $schema->resultset('Artist')->search(
160     undef,
161     {
162       join     => [qw/ cds /],
163       select   => [ 'name', { count => 'cds.cdid' } ],
164       as       => [qw/ name cd_count /],
165       group_by => [qw/ name /]
166     }
167   );
168
169   # Equivalent SQL:
170   # SELECT name, COUNT( cds.cdid ) FROM artist me
171   # LEFT JOIN cd cds ON ( cds.artist = me.artistid )
172   # GROUP BY name
173
174 =head3 Predefined searches
175
176 You can write your own DBIx::Class::ResultSet class by inheriting from it
177 and define often used searches as methods:
178
179   package My::DBIC::ResultSet::CD;
180   use strict;
181   use warnings;
182   use base 'DBIx::Class::ResultSet';
183
184   sub search_cds_ordered {
185       my ($self) = @_;
186
187       return $self->search(
188           {},
189           { order_by => 'name DESC' },
190       );
191   }
192
193   1;
194
195 To use your resultset, first tell DBIx::Class to create an instance of it
196 for you, in your My::DBIC::Schema::CD class:
197
198   __PACKAGE__->resultset_class('My::DBIC::ResultSet::CD');
199
200 Then call your new method in your code:
201
202    my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();
203
204
205 =head3 Predefined searches without writing a ResultSet class
206
207 Alternatively you can automatically generate a DBIx::Class::ResultSet
208 class by using the ResultSetManager component and tagging your method
209 as ResultSet:
210
211   __PACKAGE__->load_components(qw/ ResultSetManager Core /);
212
213   sub search_cds_ordered : ResultSet {
214       my ($self) = @_;
215       return $self->search(
216           {},
217           { order_by => 'name DESC' },
218       );
219   } 
220
221 Then call your method in the same way from your code:
222
223    my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();
224
225 =head2 Using joins and prefetch
226
227 You can use the C<join> attribute to allow searching on, or sorting your
228 results by, one or more columns in a related table. To return all CDs matching
229 a particular artist name:
230
231   my $rs = $schema->resultset('CD')->search(
232     {
233       'artist.name' => 'Bob Marley'    
234     },
235     {
236       join => [qw/artist/], # join the artist table
237     }
238   );
239
240   # Equivalent SQL:
241   # SELECT cd.* FROM cd
242   # JOIN artist ON cd.artist = artist.id
243   # WHERE artist.name = 'Bob Marley'
244
245 If required, you can now sort on any column in the related tables by including
246 it in your C<order_by> attribute:
247
248   my $rs = $schema->resultset('CD')->search(
249     {
250       'artist.name' => 'Bob Marley'
251     },
252     {
253       join     => [qw/ artist /],
254       order_by => [qw/ artist.name /]
255     }
256   };
257
258   # Equivalent SQL:
259   # SELECT cd.* FROM cd
260   # JOIN artist ON cd.artist = artist.id
261   # WHERE artist.name = 'Bob Marley'
262   # ORDER BY artist.name
263
264 Note that the C<join> attribute should only be used when you need to search or
265 sort using columns in a related table. Joining related tables when you only
266 need columns from the main table will make performance worse!
267
268 Now let's say you want to display a list of CDs, each with the name of the
269 artist. The following will work fine:
270
271   while (my $cd = $rs->next) {
272     print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
273   }
274
275 There is a problem however. We have searched both the C<cd> and C<artist> tables
276 in our main query, but we have only returned data from the C<cd> table. To get
277 the artist name for any of the CD objects returned, L<DBIx::Class> will go back
278 to the database:
279
280   SELECT artist.* FROM artist WHERE artist.id = ?
281
282 A statement like the one above will run for each and every CD returned by our
283 main query. Five CDs, five extra queries. A hundred CDs, one hundred extra
284 queries!
285
286 Thankfully, L<DBIx::Class> has a C<prefetch> attribute to solve this problem.
287 This allows you to fetch results from related tables in advance:
288
289   my $rs = $schema->resultset('CD')->search(
290     {
291       'artist.name' => 'Bob Marley'
292     },
293     {
294       join     => [qw/ artist /],
295       order_by => [qw/ artist.name /],
296       prefetch => [qw/ artist /] # return artist data too!
297     }
298   );
299
300   # Equivalent SQL (note SELECT from both "cd" and "artist"):
301   # SELECT cd.*, artist.* FROM cd
302   # JOIN artist ON cd.artist = artist.id
303   # WHERE artist.name = 'Bob Marley'
304   # ORDER BY artist.name
305
306 The code to print the CD list remains the same:
307
308   while (my $cd = $rs->next) {
309     print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
310   }
311
312 L<DBIx::Class> has now prefetched all matching data from the C<artist> table,
313 so no additional SQL statements are executed. You now have a much more
314 efficient query.
315
316 Note that as of L<DBIx::Class> 0.05999_01, C<prefetch> I<can> be used with
317 C<has_many> relationships.
318
319 Also note that C<prefetch> should only be used when you know you will
320 definitely use data from a related table. Pre-fetching related tables when you
321 only need columns from the main table will make performance worse!
322
323 =head3 Multi-step joins
324
325 Sometimes you want to join more than one relationship deep. In this example,
326 we want to find all C<Artist> objects who have C<CD>s whose C<LinerNotes>
327 contain a specific string:
328
329   # Relationships defined elsewhere:
330   # Artist->has_many('cds' => 'CD', 'artist');
331   # CD->has_one('liner_notes' => 'LinerNotes', 'cd');
332
333   my $rs = $schema->resultset('Artist')->search(
334     {
335       'liner_notes.notes' => { 'like', '%some text%' },
336     },
337     {
338       join => {
339         'cds' => 'liner_notes'
340       }
341     }
342   );
343
344   # Equivalent SQL:
345   # SELECT artist.* FROM artist
346   # JOIN ( cd ON artist.id = cd.artist )
347   # JOIN ( liner_notes ON cd.id = liner_notes.cd )
348   # WHERE liner_notes.notes LIKE '%some text%'
349
350 Joins can be nested to an arbitrary level. So if we decide later that we
351 want to reduce the number of Artists returned based on who wrote the liner
352 notes:
353
354   # Relationship defined elsewhere:
355   # LinerNotes->belongs_to('author' => 'Person');
356
357   my $rs = $schema->resultset('Artist')->search(
358     {
359       'liner_notes.notes' => { 'like', '%some text%' },
360       'author.name' => 'A. Writer'
361     },
362     {
363       join => {
364         'cds' => {
365           'liner_notes' => 'author'
366         }
367       }
368     }
369   );
370
371   # Equivalent SQL:
372   # SELECT artist.* FROM artist
373   # JOIN ( cd ON artist.id = cd.artist )
374   # JOIN ( liner_notes ON cd.id = liner_notes.cd )
375   # JOIN ( author ON author.id = liner_notes.author )
376   # WHERE liner_notes.notes LIKE '%some text%'
377   # AND author.name = 'A. Writer'
378
379 =head2 Multi-step prefetch
380
381 From 0.04999_05 onwards, C<prefetch> can be nested more than one relationship
382 deep using the same syntax as a multi-step join:
383
384   my $rs = $schema->resultset('Tag')->search(
385     undef,
386     {
387       prefetch => {
388         cd => 'artist'
389       }
390     }
391   );
392
393   # Equivalent SQL:
394   # SELECT tag.*, cd.*, artist.* FROM tag
395   # JOIN cd ON tag.cd = cd.cdid
396   # JOIN artist ON cd.artist = artist.artistid
397
398 Now accessing our C<cd> and C<artist> relationships does not need additional
399 SQL statements:
400
401   my $tag = $rs->first;
402   print $tag->cd->artist->name;
403
404 =head2 Using relationships
405
406 =head3 Create a new row in a related table
407
408   my $book->create_related('author', { name => 'Fred'});
409
410 =head3 Search in a related table
411
412 Only searches for books named 'Titanic' by the author in $author.
413
414   my $author->search_related('books', { name => 'Titanic' });
415
416 =head3 Delete data in a related table
417
418 Deletes only the book named Titanic by the author in $author.
419
420   my $author->delete_related('books', { name => 'Titanic' });
421
422 =head3 Ordering a relationship result set
423
424 If you always want a relation to be ordered, you can specify this when you 
425 create the relationship.
426
427 To order C<< $book->pages >> by descending page_number.
428
429   Book->has_many('pages' => 'Page', 'book', { order_by => \'page_number DESC'} );
430
431
432
433 =head2 Transactions
434
435 As of version 0.04001, there is improved transaction support in
436 L<DBIx::Class::Storage> and L<DBIx::Class::Schema>.  Here is an
437 example of the recommended way to use it:
438
439   my $genus = $schema->resultset('Genus')->find(12);
440
441   my $coderef2 = sub {
442     $genus->extinct(1);
443     $genus->update;
444   };
445
446   my $coderef1 = sub {
447     $genus->add_to_species({ name => 'troglodyte' });
448     $genus->wings(2);
449     $genus->update;
450     $schema->txn_do($coderef2); # Can have a nested transaction
451     return $genus->species;
452   };
453
454   my $rs;
455   eval {
456     $rs = $schema->txn_do($coderef1);
457   };
458
459   if ($@) {                             # Transaction failed
460     die "the sky is falling!"           #
461       if ($@ =~ /Rollback failed/);     # Rollback failed
462
463     deal_with_failed_transaction();
464   }
465
466 Nested transactions will work as expected. That is, only the outermost
467 transaction will actually issue a commit to the $dbh, and a rollback
468 at any level of any transaction will cause the entire nested
469 transaction to fail. Support for savepoints and for true nested
470 transactions (for databases that support them) will hopefully be added
471 in the future.
472
473 =head2 Many-to-many relationships
474
475 This is straightforward using L<DBIx::Class::Relationship::ManyToMany>:
476
477   package My::DB;
478   # ... set up connection ...
479
480   package My::User;
481   use base 'My::DB';
482   __PACKAGE__->table('user');
483   __PACKAGE__->add_columns(qw/id name/);
484   __PACKAGE__->set_primary_key('id');
485   __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'user');
486   __PACKAGE__->many_to_many('addresses' => 'user_address', 'address');
487
488   package My::UserAddress;
489   use base 'My::DB';
490   __PACKAGE__->table('user_address');
491   __PACKAGE__->add_columns(qw/user address/);
492   __PACKAGE__->set_primary_key(qw/user address/);
493   __PACKAGE__->belongs_to('user' => 'My::User');
494   __PACKAGE__->belongs_to('address' => 'My::Address');
495
496   package My::Address;
497   use base 'My::DB';
498   __PACKAGE__->table('address');
499   __PACKAGE__->add_columns(qw/id street town area_code country/);
500   __PACKAGE__->set_primary_key('id');
501   __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'address');
502   __PACKAGE__->many_to_many('users' => 'user_address', 'user');
503
504   $rs = $user->addresses(); # get all addresses for a user
505   $rs = $address->users(); # get all users for an address
506
507 =head2 Setting default values for a row
508
509 It's as simple as overriding the C<new> method.  Note the use of
510 C<next::method>.
511
512   sub new {
513     my ( $class, $attrs ) = @_;
514
515     $attrs->{foo} = 'bar' unless defined $attrs->{foo};
516
517     $class->next::method($attrs);
518   }
519
520 For more information about C<next::method>, look in the L<Class::C3> 
521 documentation. See also L<DBIx::Class::Manual::Component> for more
522 ways to write your own base classes to do this.
523
524 People looking for ways to do "triggers" with DBIx::Class are probably
525 just looking for this.
526
527 =head2 Stringification
528
529 Employ the standard stringification technique by using the C<overload>
530 module.
531
532 To make an object stringify itself as a single column, use something
533 like this (replace C<foo> with the column/method of your choice):
534
535   use overload '""' => 'foo', fallback => 1;
536
537 For more complex stringification, you can use an anonymous subroutine:
538
539   use overload '""' => sub { $_[0]->name . ", " .
540                              $_[0]->address }, fallback => 1;
541
542 =head3 Stringifcation Example
543
544 Suppose we have two tables: C<Product> and C<Category>. The table
545 specifications are:
546
547   Product(id, Description, category)
548   Category(id, Description)
549
550 C<category> is a foreign key into the Category table.
551
552 If you have a Product object C<$obj> and write something like
553
554   print $obj->category
555
556 things will not work as expected.
557
558 To obtain, for example, the category description, you should add this
559 method to the class defining the Category table:
560
561   use overload "" => sub {
562       my $self = shift;
563
564       return $self->Description;
565   }, fallback => 1;
566
567 =head2 Disconnecting cleanly
568
569 If you find yourself quitting an app with Control-C a lot during
570 development, you might like to put the following signal handler in
571 your main database class to make sure it disconnects cleanly:
572
573   $SIG{INT} = sub {
574     __PACKAGE__->storage->disconnect;
575   };
576
577 =head2 Schema import/export
578
579 This functionality requires you to have L<SQL::Translator> (also known as
580 "SQL Fairy") installed.
581
582 To create a DBIx::Class schema from an existing database:
583
584  sqlt --from DBI
585       --to DBIx::Class::File
586       --prefix "MySchema" > MySchema.pm
587
588 To create a MySQL database from an existing L<DBIx::Class> schema, convert the
589 schema to MySQL's dialect of SQL:
590
591   sqlt --from DBIx::Class --to MySQL --DBIx::Class "MySchema.pm" > Schema1.sql
592   
593 And import using the mysql client:
594
595   mysql -h "host" -D "database" -u "user" -p < Schema1.sql
596
597 =head2 Easy migration from class-based to schema-based setup
598
599 You want to start using the schema-based approach to L<DBIx::Class>
600 (see L<SchemaIntro.pod>), but have an established class-based setup with lots
601 of existing classes that you don't want to move by hand. Try this nifty script
602 instead:
603
604   use MyDB;
605   use SQL::Translator;
606   
607   my $schema = MyDB->schema_instance;
608   
609   my $translator           =  SQL::Translator->new( 
610       debug                => $debug          ||  0,
611       trace                => $trace          ||  0,
612       no_comments          => $no_comments    ||  0,
613       show_warnings        => $show_warnings  ||  0,
614       add_drop_table       => $add_drop_table ||  0,
615       validate             => $validate       ||  0,
616       parser_args          => {
617          'DBIx::Schema'    => $schema,
618                               },
619       producer_args   => {
620           'prefix'         => 'My::Schema',
621                          },
622   );
623   
624   $translator->parser('SQL::Translator::Parser::DBIx::Class');
625   $translator->producer('SQL::Translator::Producer::DBIx::Class::File');
626   
627   my $output = $translator->translate(@args) or die
628           "Error: " . $translator->error;
629   
630   print $output;
631
632 You could use L<Module::Find> to search for all subclasses in the MyDB::*
633 namespace, which is currently left as an exercise for the reader.
634
635 =head2 Schema versioning
636
637 The following example shows simplistically how you might use DBIx::Class to
638 deploy versioned schemas to your customers. The basic process is as follows:
639
640 =over 4
641
642 =item 1.
643
644 Create a DBIx::Class schema
645
646 =item 2.
647
648 Save the schema
649
650 =item 3.
651
652 Deploy to customers
653
654 =item 4.
655
656 Modify schema to change functionality
657
658 =item 5.
659
660 Deploy update to customers
661
662 =back
663
664 =head3 Create a DBIx::Class schema
665
666 This can either be done manually, or generated from an existing database as
667 described under C<Schema import/export>.
668
669 =head3 Save the schema
670
671 Use C<sqlt> to transform your schema into an SQL script suitable for your
672 customer's database. E.g. for MySQL:
673
674   sqlt --from DBIx::Class
675        --to MySQL
676        --DBIx::Class "MySchema.pm" > Schema1.mysql.sql
677
678 If you need to target databases from multiple vendors, just generate an SQL
679 script suitable for each. To support PostgreSQL too:
680
681   sqlt --from DBIx::Class
682        --to PostgreSQL
683        --DBIx::Class "MySchema.pm" > Schema1.pgsql.sql
684
685 =head3 Deploy to customers
686
687 There are several ways you could deploy your schema. These are probably
688 beyond the scope of this recipe, but might include:
689
690 =over 4
691
692 =item 1.
693
694 Require customer to apply manually using their RDBMS.
695
696 =item 2.
697
698 Package along with your app, making database dump/schema update/tests
699 all part of your install.
700
701 =back
702
703 =head3 Modify the schema to change functionality
704
705 As your application evolves, it may be necessary to modify your schema to
706 change functionality. Once the changes are made to your schema in DBIx::Class,
707 export the modified schema as before, taking care not to overwrite the original:
708
709   sqlt --from DBIx::Class
710        --to MySQL
711        --DBIx::Class "Anything.pm" > Schema2.mysql.sql
712
713 Next, use sqlt-diff to create an SQL script that will update the customer's
714 database schema:
715
716   sqlt-diff --to MySQL Schema1=MySQL Schema2=MySQL > SchemaUpdate.mysql.sql
717
718 =head3 Deploy update to customers
719
720 The schema update can be deployed to customers using the same method as before.
721
722 =head2 Setting limit dialect for SQL::Abstract::Limit
723
724 In some cases, SQL::Abstract::Limit cannot determine the dialect of the remote
725 SQL-server by looking at the database-handle. This is a common problem when
726 using the DBD::JDBC, since the DBD-driver only know that in has a Java-driver
727 available, not which JDBC-driver the Java component has loaded.
728 This specifically sets the limit_dialect to Microsoft SQL-server (Se more names
729 in SQL::Abstract::Limit -documentation.
730
731   __PACKAGE__->storage->sql_maker->limit_dialect('mssql');
732
733 The JDBC-bridge is one way of getting access to a MSSQL-server from a platform
734 that Microsoft doesn't deliver native client libraries for. (e.g. Linux)
735
736 =head2 Setting quotes for the generated SQL. 
737
738 If the database contains columnames with spaces and/or reserved words, the
739 SQL-query needs to be quoted. This is done using:
740
741   __PACKAGE__->storage->sql_maker->quote_char([ qw/[ ]/] );
742   __PACKAGE__->storage->sql_maker->name_sep('.');
743
744 The first sets the quotesymbols. If the quote i "symmetric" as " or '
745   
746   __PACKAGE__->storage->sql_maker->quote_char('"');
747
748 is enough. If the left quote differs form the right quote, the first 
749 notation should be used. name_sep needs to be set to allow the 
750 SQL generator to put the quotes the correct place. 
751
752 =head2 Overloading methods
753
754 L<DBIx::Class> uses the L<Class::C3> package, which provides for redispatch of 
755 method calls.  You have to use calls to C<next::method> to overload methods.  
756 More information on using L<Class::C3> with L<DBIx::Class> can be found in 
757 L<DBIx::Class::Manual::Component>.
758
759 =head3 Changing one field whenever another changes
760
761 For example, say that you have three columns, C<id>, C<number>, and 
762 C<squared>.  You would like to make changes to C<number> and have
763 C<squared> be automagically set to the value of C<number> squared.
764 You can accomplish this by overriding C<store_column>:
765
766   sub store_column {
767     my ( $self, $name, $value ) = @_;
768     if ($name eq 'number') {
769       $self->squared($value * $value);
770     }
771     $self->next::method($name, $value);
772   }
773
774 Note that the hard work is done by the call to C<next::method>, which
775 redispatches your call to store_column to the superclass(es).
776
777 =head3 Automatically creating related objects
778
779 You might have a class C<Artist> which has many C<CD>s.  Further, you
780 want to create a C<CD> object every time you insert an C<Artist> object.
781 You can accomplish this by overriding C<insert> on your objects:
782
783   sub insert {
784     my ( $self, @args ) = @_;
785     $self->next::method(@args);
786     $self->cds->new({})->fill_from_artist($self)->insert;
787     return $self;
788   }
789
790 where C<fill_from_artist> is a method you specify in C<CD> which sets
791 values in C<CD> based on the data in the C<Artist> object you pass in.
792
793 =head2 Debugging DBIx::Class objects with Data::Dumper
794
795 L<Data::Dumper> can be a very useful tool for debugging, but sometimes it can
796 be hard to find the pertinent data in all the data it can generate.
797 Specifically, if one naively tries to use it like so,
798
799   use Data::Dumper;
800
801   my $cd = $schema->resultset('CD')->find(1);
802   print Dumper($cd);
803
804 several pages worth of data from the CD object's schema and result source will
805 be dumped to the screen. Since usually one is only interested in a few column
806 values of the object, this is not very helpful.
807
808 Luckily, it is possible to modify the data before L<Data::Dumper> outputs
809 it. Simply define a hook that L<Data::Dumper> will call on the object before
810 dumping it. For example,
811
812   package My::DB::CD;
813
814   sub _dumper_hook {
815     $_[0] = bless {
816       %{ $_[0] },
817       result_source => undef,
818     }, ref($_[0]);
819   }
820
821   [...]
822
823   use Data::Dumper;
824
825   local $Data::Dumper::Freezer = '_dumper_hook';
826
827   my $cd = $schema->resultset('CD')->find(1);
828   print Dumper($cd);
829          # dumps $cd without its ResultSource
830
831 If the structure of your schema is such that there is a common base class for
832 all your table classes, simply put a method similar to C<_dumper_hook> in the
833 base class and set C<$Data::Dumper::Freezer> to its name and L<Data::Dumper>
834 will automagically clean up your data before printing it. See
835 L<Data::Dumper/EXAMPLES> for more information.
836
837 =head2 Retrieving a row object's Schema
838
839 It is possible to get a Schema object from a row object like so,
840
841   my $schema = $cd->result_source->schema;
842   my $artist_rs = $schema->resultset('Artist');
843            # for example
844
845 This can be useful when you don't want to pass around a Schema object to every
846 method.
847
848 =head2 Profiling
849
850 When you enable L<DBIx::Class::Storage>'s debugging it prints the SQL
851 executed as well as notifications of query completion and transaction
852 begin/commit.  If you'd like to profile the SQL you can subclass the
853 L<DBIx::Class::Storage::Statistics> class and write your own profiling
854 mechanism:
855
856   package My::Profiler;
857   use strict;
858
859   use base 'DBIx::Class::Storage::Statistics';
860
861   use Time::HiRes qw(time);
862
863   my $start;
864
865   sub query_start {
866     my $self = shift();
867     my $sql = shift();
868     my $params = @_;
869
870     print "Executing $sql: ".join(', ', @params)."\n";
871     $start = time();
872   }
873
874   sub query_end {
875     my $self = shift();
876     my $sql = shift();
877     my @params = @_;
878
879     printf("Execution took %0.4f seconds.\n", time() - $start);
880     $start = undef;
881   }
882
883   1;
884
885 You can then install that class as the debugging object:
886
887   __PACKAGE__->storage()->debugobj(new My::Profiler());
888   __PACKAGE__->storage()->debug(1);
889
890 A more complicated example might involve storing each execution of SQL in an
891 array:
892
893   sub query_end {
894     my $self = shift();
895     my $sql = shift();
896     my @params = @_;
897
898     my $elapsed = time() - $start;
899     push(@{ $calls{$sql} }, {
900         params => \@params,
901         elapsed => $elapsed
902     });
903   }
904
905 You could then create average, high and low execution times for an SQL
906 statement and dig down to see if certain parameters cause aberrant behavior.
907
908 =head2 Getting the value of the primary key for the last database insert
909
910 AKA getting last_insert_id
911
912 If you are using PK::Auto, this is straightforward:
913
914   my $foo = $rs->create(\%blah);
915   # do more stuff
916   my $id = $foo->id; # foo->my_primary_key_field will also work.
917
918 If you are not using autoincrementing primary keys, this will probably
919 not work, but then you already know the value of the last primary key anyway.
920
921 =head2 Dynamic Sub-classing DBIx::Class proxy classes 
922 (AKA multi-class object inflation from one table) 
923  
924 L<DBIx::Class> classes are proxy classes, therefore some different techniques 
925 need to be employed for more than basic subclassing.  In this example we have  
926 a single user table that carries a boolean bit for admin.  We would like  
927 like to give the admin users objects(L<DBIx::Class::Row>) the same methods as  
928 a regular user but also special admin only methods.  It doesn't make sense to  
929 create two seperate proxy-class files for this.  We would be copying all the  
930 user methods into the Admin class.  There is a cleaner way to accomplish this. 
931
932 Overriding the C<inflate_results()> method within the User proxy-class gives 
933 us the effect we want.  This method is called by L<DBIx::Class::ResultSet> when  
934 inflating a result from storage.  So we grab the object being returned, inspect 
935 the values we are looking for, bless it if it's an admin object, and then  
936 return it.  Running the test file below will confirm this works. 
937  
938 B<Schema Definition> 
939  
940     package DB::Schema; 
941      
942     use base qw/DBIx::Class::Schema/; 
943  
944     __PACKAGE__->load_classes(qw/User/); 
945  
946  
947 B<Proxy-Class definitions> 
948  
949     package DB::Schema::User; 
950      
951     use strict; 
952     use warnings; 
953     use base qw/DBIx::Class/; 
954      
955     ### Defined what our admin class is for ensure_class_loaded 
956     my $admin_class = __PACKAGE__ . '::Admin'; 
957      
958     __PACKAGE__->load_components(qw/PK::Auto Core/); 
959      
960     __PACKAGE__->table('users'); 
961      
962     __PACKAGE__->add_columns(qw/user_id   email    password  
963                                 firstname lastname active 
964                                 admin/); 
965      
966     __PACKAGE__->set_primary_key('user_id'); 
967      
968     sub inflate_result { 
969         my $self = shift;  
970         my $ret = $self->next::method(@_); 
971         if( $ret->admin ) {### If this is an admin rebless for extra functions  
972             $self->ensure_class_loaded( $admin_class ); 
973             bless $ret, $admin_class; 
974         } 
975         return $ret; 
976     } 
977      
978     sub hello { 
979         print "I am a regular user.\n"; 
980         return ; 
981     } 
982      
983      
984     package DB::Schema::User::Admin; 
985      
986     use strict; 
987     use warnings; 
988     use base qw/DB::Schema::User/; 
989      
990     sub hello 
991     { 
992         print "I am an admin.\n"; 
993         return; 
994     } 
995      
996     sub do_admin_stuff 
997     { 
998         print "I am doing admin stuff\n"; 
999         return ; 
1000     } 
1001  
1002 B<Test File> test.pl 
1003  
1004     use warnings; 
1005     use strict; 
1006     use DB::Schema; 
1007      
1008     my $user_data = { email    => 'someguy@place.com',  
1009                       password => 'pass1',  
1010                       admin    => 0 }; 
1011                            
1012     my $admin_data = { email    => 'someadmin@adminplace.com',  
1013                        password => 'pass2',  
1014                        admin    => 1 }; 
1015                            
1016     my $schema = DB::Schema->connection('dbi:Pg:dbname=test'); 
1017      
1018     $schema->resultset('User')->create( $user_data ); 
1019     $schema->resultset('User')->create( $admin_data ); 
1020      
1021     ### Now we search for them 
1022     my $user = $schema->resultset('User')->single( $user_data ); 
1023     my $admin = $schema->resultset('User')->single( $admin_data ); 
1024      
1025     print ref $user, "\n"; 
1026     print ref $admin, "\n"; 
1027      
1028     print $user->password , "\n"; # pass1 
1029     print $admin->password , "\n";# pass2; inherited from User 
1030     print $user->hello , "\n";# I am a regular user. 
1031     print $admin->hello, "\n";# I am an admin. 
1032  
1033     ### The statement below will NOT print 
1034     print "I can do admin stuff\n" if $user->can('do_admin_stuff'); 
1035     ### The statement below will print 
1036     print "I can do admin stuff\n" if $admin->can('do_admin_stuff'); 
1037
1038 =cut