Add make_column_dirty to Row (per request from #dbix-class questions)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Manual / Cookbook.pod
CommitLineData
3b44ccc6 1=head1 NAME
9c82c181 2
40dbc108 3DBIx::Class::Manual::Cookbook - Miscellaneous recipes
ee38fa40 4
d2f3e87b 5=head1 SEARCHING
2913b2d3 6
d2f3e87b 7=head2 Paged results
faf62551 8
bade79c4 9When you expect a large number of results, you can ask L<DBIx::Class> for a
264f1571 10paged resultset, which will fetch only a defined number of records at a time:
faf62551 11
bade79c4 12 my $rs = $schema->resultset('Artist')->search(
5e8b1b2a 13 undef,
bade79c4 14 {
15 page => 1, # page to return (defaults to 1)
16 rows => 10, # number of results per page
17 },
18 );
faf62551 19
bade79c4 20 return $rs->all(); # all records for page 1
faf62551 21
bade79c4 22The C<page> attribute does not have to be specified in your search:
23
24 my $rs = $schema->resultset('Artist')->search(
5e8b1b2a 25 undef,
bade79c4 26 {
27 rows => 10,
28 }
29 );
faf62551 30
bade79c4 31 return $rs->page(1); # DBIx::Class::ResultSet containing first 10 records
faf62551 32
264f1571 33In either of the above cases, you can get a L<Data::Page> object for the
bade79c4 34resultset (suitable for use in e.g. a template) using the C<pager> method:
faf62551 35
bade79c4 36 return $rs->pager();
faf62551 37
d2f3e87b 38=head2 Complex WHERE clauses
2913b2d3 39
40dbc108 40Sometimes you need to formulate a query using specific operators:
41
ea6309e2 42 my @albums = $schema->resultset('Album')->search({
35d4fe78 43 artist => { 'like', '%Lamb%' },
44 title => { 'like', '%Fear of Fours%' },
45 });
40dbc108 46
47This results in something like the following C<WHERE> clause:
48
35d4fe78 49 WHERE artist LIKE '%Lamb%' AND title LIKE '%Fear of Fours%'
40dbc108 50
51Other queries might require slightly more complex logic:
52
ea6309e2 53 my @albums = $schema->resultset('Album')->search({
35d4fe78 54 -or => [
55 -and => [
56 artist => { 'like', '%Smashing Pumpkins%' },
57 title => 'Siamese Dream',
58 ],
59 artist => 'Starchildren',
60 ],
61 });
40dbc108 62
63This results in the following C<WHERE> clause:
64
35d4fe78 65 WHERE ( artist LIKE '%Smashing Pumpkins%' AND title = 'Siamese Dream' )
66 OR artist = 'Starchildren'
40dbc108 67
68For more information on generating complex queries, see
69L<SQL::Abstract/WHERE CLAUSES>.
ee38fa40 70
d2f3e87b 71=head2 Arbitrary SQL through a custom ResultSource
321d9634 72
73Sometimes you have to run arbitrary SQL because your query is too complex
74(e.g. it contains Unions, Sub-Selects, Stored Procedures, etc.) or has to
75be optimized for your database in a special way, but you still want to
76get the results as a L<DBIx::Class::ResultSet>.
77The recommended way to accomplish this is by defining a separate ResultSource
78for your query. You can then inject complete SQL statements using a scalar
79reference (this is a feature of L<SQL::Abstract>).
80
81Say you want to run a complex custom query on your user data, here's what
82you have to add to your User class:
83
84 package My::Schema::User;
85
86 use base qw/DBIx::Class/;
87
88 # ->load_components, ->table, ->add_columns, etc.
89
90 # Make a new ResultSource based on the User class
91 my $source = __PACKAGE__->result_source_instance();
92 my $new_source = $source->new( $source );
93 $new_source->source_name( 'UserFriendsComplex' );
94
95 # Hand in your query as a scalar reference
96 # It will be added as a sub-select after FROM,
97 # so pay attention to the surrounding brackets!
98 $new_source->name( \<<SQL );
99 ( SELECT u.* FROM user u
100 INNER JOIN user_friends f ON u.id = f.user_id
101 WHERE f.friend_user_id = ?
102 UNION
103 SELECT u.* FROM user u
104 INNER JOIN user_friends f ON u.id = f.friend_user_id
105 WHERE f.user_id = ? )
106 SQL
107
108 # Finally, register your new ResultSource with your Schema
109 My::Schema->register_source( 'UserFriendsComplex' => $new_source );
110
111Next, you can execute your complex query using bind parameters like this:
112
113 my $friends = [ $schema->resultset( 'UserFriendsComplex' )->search( {},
114 {
115 bind => [ 12345, 12345 ]
116 }
117 ) ];
118
119... and you'll get back a perfect L<DBIx::Class::ResultSet>.
120
d2f3e87b 121=head2 Using specific columns
faf62551 122
324572ca 123When you only want specific columns from a table, you can use
124C<columns> to specify which ones you need. This is useful to avoid
125loading columns with large amounts of data that you aren't about to
126use anyway:
faf62551 127
bade79c4 128 my $rs = $schema->resultset('Artist')->search(
5e8b1b2a 129 undef,
bade79c4 130 {
5e8b1b2a 131 columns => [qw/ name /]
bade79c4 132 }
133 );
faf62551 134
bade79c4 135 # Equivalent SQL:
136 # SELECT artist.name FROM artist
faf62551 137
324572ca 138This is a shortcut for C<select> and C<as>, see below. C<columns>
139cannot be used together with C<select> and C<as>.
140
d2f3e87b 141=head2 Using database functions or stored procedures
faf62551 142
bade79c4 143The combination of C<select> and C<as> can be used to return the result of a
144database function or stored procedure as a column value. You use C<select> to
145specify the source for your column value (e.g. a column name, function, or
146stored procedure name). You then use C<as> to set the column name you will use
147to access the returned value:
faf62551 148
bade79c4 149 my $rs = $schema->resultset('Artist')->search(
324572ca 150 {},
bade79c4 151 {
152 select => [ 'name', { LENGTH => 'name' } ],
153 as => [qw/ name name_length /],
154 }
155 );
faf62551 156
bade79c4 157 # Equivalent SQL:
98b65433 158 # SELECT name name, LENGTH( name )
bade79c4 159 # FROM artist
faf62551 160
d676881f 161Note that the C< as > attribute has absolutely nothing to with the sql
162syntax C< SELECT foo AS bar > (see the documentation in
163L<DBIx::Class::ResultSet/ATTRIBUTES>). If your alias exists as a
164column in your base class (i.e. it was added with C<add_columns>), you
165just access it as normal. Our C<Artist> class has a C<name> column, so
166we just use the C<name> accessor:
faf62551 167
bade79c4 168 my $artist = $rs->first();
169 my $name = $artist->name();
faf62551 170
171If on the other hand the alias does not correspond to an existing column, you
324572ca 172have to fetch the value using the C<get_column> accessor:
faf62551 173
bade79c4 174 my $name_length = $artist->get_column('name_length');
faf62551 175
bade79c4 176If you don't like using C<get_column>, you can always create an accessor for
faf62551 177any of your aliases using either of these:
178
bade79c4 179 # Define accessor manually:
180 sub name_length { shift->get_column('name_length'); }
faf62551 181
bade79c4 182 # Or use DBIx::Class::AccessorGroup:
183 __PACKAGE__->mk_group_accessors('column' => 'name_length');
faf62551 184
d2f3e87b 185=head2 SELECT DISTINCT with multiple columns
faf62551 186
bade79c4 187 my $rs = $schema->resultset('Foo')->search(
324572ca 188 {},
bade79c4 189 {
190 select => [
191 { distinct => [ $source->columns ] }
192 ],
d676881f 193 as => [ $source->columns ] # remember 'as' is not the same as SQL AS :-)
bade79c4 194 }
195 );
faf62551 196
286f32b3 197 my $count = $rs->next->get_column('count');
198
d2f3e87b 199=head2 SELECT COUNT(DISTINCT colname)
6607ee1b 200
bade79c4 201 my $rs = $schema->resultset('Foo')->search(
324572ca 202 {},
bade79c4 203 {
204 select => [
205 { count => { distinct => 'colname' } }
206 ],
207 as => [ 'count' ]
208 }
209 );
6607ee1b 210
d2f3e87b 211=head2 Grouping results
bade79c4 212
213L<DBIx::Class> supports C<GROUP BY> as follows:
214
215 my $rs = $schema->resultset('Artist')->search(
324572ca 216 {},
bade79c4 217 {
218 join => [qw/ cds /],
219 select => [ 'name', { count => 'cds.cdid' } ],
220 as => [qw/ name cd_count /],
221 group_by => [qw/ name /]
222 }
223 );
6607ee1b 224
bade79c4 225 # Equivalent SQL:
226 # SELECT name, COUNT( cds.cdid ) FROM artist me
227 # LEFT JOIN cd cds ON ( cds.artist = me.artistid )
228 # GROUP BY name
6607ee1b 229
d676881f 230Please see L<DBIx::Class::ResultSet/ATTRIBUTES> documentation if you
231are in any way unsure about the use of the attributes above (C< join
232>, C< select >, C< as > and C< group_by >).
233
d2f3e87b 234=head2 Predefined searches
74dc2edc 235
324572ca 236You can write your own L<DBIx::Class::ResultSet> class by inheriting from it
74dc2edc 237and define often used searches as methods:
238
239 package My::DBIC::ResultSet::CD;
240 use strict;
241 use warnings;
242 use base 'DBIx::Class::ResultSet';
243
244 sub search_cds_ordered {
245 my ($self) = @_;
246
247 return $self->search(
248 {},
249 { order_by => 'name DESC' },
250 );
251 }
252
253 1;
254
255To use your resultset, first tell DBIx::Class to create an instance of it
256for you, in your My::DBIC::Schema::CD class:
257
258 __PACKAGE__->resultset_class('My::DBIC::ResultSet::CD');
259
260Then call your new method in your code:
261
262 my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();
263
d2f3e87b 264=head2 Using SQL functions on the left hand side of a comparison
1c133e22 265
266Using SQL functions on the left hand side of a comparison is generally
267not a good idea since it requires a scan of the entire table. However,
268it can be accomplished with C<DBIx::Class> when necessary.
269
270If you do not have quoting on, simply include the function in your search
271specification as you would any column:
272
273 $rs->search({ 'YEAR(date_of_birth)' => 1979 });
274
275With quoting on, or for a more portable solution, use the C<where>
276attribute:
277
278 $rs->search({}, { where => \'YEAR(date_of_birth) = 1979' });
279
280=begin hidden
281
282(When the bind args ordering bug is fixed, this technique will be better
283and can replace the one above.)
284
285With quoting on, or for a more portable solution, use the C<where> and
286C<bind> attributes:
287
288 $rs->search({}, {
289 where => \'YEAR(date_of_birth) = ?',
290 bind => [ 1979 ]
291 });
292
293=end hidden
294
d2f3e87b 295=head1 JOINS AND PREFETCHING
296
87980de7 297=head2 Using joins and prefetch
298
bade79c4 299You can use the C<join> attribute to allow searching on, or sorting your
300results by, one or more columns in a related table. To return all CDs matching
301a particular artist name:
ea6309e2 302
bade79c4 303 my $rs = $schema->resultset('CD')->search(
304 {
305 'artist.name' => 'Bob Marley'
306 },
307 {
308 join => [qw/artist/], # join the artist table
309 }
310 );
311
312 # Equivalent SQL:
313 # SELECT cd.* FROM cd
314 # JOIN artist ON cd.artist = artist.id
315 # WHERE artist.name = 'Bob Marley'
316
317If required, you can now sort on any column in the related tables by including
318it in your C<order_by> attribute:
319
320 my $rs = $schema->resultset('CD')->search(
321 {
322 'artist.name' => 'Bob Marley'
323 },
324 {
325 join => [qw/ artist /],
326 order_by => [qw/ artist.name /]
327 }
2f81ed0f 328 );
ea6309e2 329
bade79c4 330 # Equivalent SQL:
331 # SELECT cd.* FROM cd
332 # JOIN artist ON cd.artist = artist.id
333 # WHERE artist.name = 'Bob Marley'
334 # ORDER BY artist.name
ea6309e2 335
bade79c4 336Note that the C<join> attribute should only be used when you need to search or
337sort using columns in a related table. Joining related tables when you only
338need columns from the main table will make performance worse!
ea6309e2 339
bade79c4 340Now let's say you want to display a list of CDs, each with the name of the
341artist. The following will work fine:
ea6309e2 342
bade79c4 343 while (my $cd = $rs->next) {
344 print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
345 }
ea6309e2 346
bade79c4 347There is a problem however. We have searched both the C<cd> and C<artist> tables
348in our main query, but we have only returned data from the C<cd> table. To get
349the artist name for any of the CD objects returned, L<DBIx::Class> will go back
350to the database:
ea6309e2 351
bade79c4 352 SELECT artist.* FROM artist WHERE artist.id = ?
ea6309e2 353
354A statement like the one above will run for each and every CD returned by our
355main query. Five CDs, five extra queries. A hundred CDs, one hundred extra
356queries!
357
bade79c4 358Thankfully, L<DBIx::Class> has a C<prefetch> attribute to solve this problem.
897342e4 359This allows you to fetch results from related tables in advance:
ea6309e2 360
bade79c4 361 my $rs = $schema->resultset('CD')->search(
362 {
363 'artist.name' => 'Bob Marley'
364 },
365 {
366 join => [qw/ artist /],
367 order_by => [qw/ artist.name /],
368 prefetch => [qw/ artist /] # return artist data too!
369 }
370 );
ea6309e2 371
bade79c4 372 # Equivalent SQL (note SELECT from both "cd" and "artist"):
373 # SELECT cd.*, artist.* FROM cd
374 # JOIN artist ON cd.artist = artist.id
375 # WHERE artist.name = 'Bob Marley'
376 # ORDER BY artist.name
ea6309e2 377
378The code to print the CD list remains the same:
379
bade79c4 380 while (my $cd = $rs->next) {
381 print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
382 }
ea6309e2 383
bade79c4 384L<DBIx::Class> has now prefetched all matching data from the C<artist> table,
ea6309e2 385so no additional SQL statements are executed. You now have a much more
386efficient query.
387
77d6b403 388Note that as of L<DBIx::Class> 0.05999_01, C<prefetch> I<can> be used with
389C<has_many> relationships.
ea6309e2 390
bade79c4 391Also note that C<prefetch> should only be used when you know you will
ea6309e2 392definitely use data from a related table. Pre-fetching related tables when you
393only need columns from the main table will make performance worse!
394
d2f3e87b 395=head2 Multi-step joins
ea6309e2 396
397Sometimes you want to join more than one relationship deep. In this example,
bade79c4 398we want to find all C<Artist> objects who have C<CD>s whose C<LinerNotes>
399contain a specific string:
400
401 # Relationships defined elsewhere:
402 # Artist->has_many('cds' => 'CD', 'artist');
403 # CD->has_one('liner_notes' => 'LinerNotes', 'cd');
404
405 my $rs = $schema->resultset('Artist')->search(
406 {
407 'liner_notes.notes' => { 'like', '%some text%' },
408 },
409 {
410 join => {
411 'cds' => 'liner_notes'
412 }
413 }
414 );
ea6309e2 415
bade79c4 416 # Equivalent SQL:
417 # SELECT artist.* FROM artist
418 # JOIN ( cd ON artist.id = cd.artist )
419 # JOIN ( liner_notes ON cd.id = liner_notes.cd )
420 # WHERE liner_notes.notes LIKE '%some text%'
ea6309e2 421
422Joins can be nested to an arbitrary level. So if we decide later that we
423want to reduce the number of Artists returned based on who wrote the liner
424notes:
425
bade79c4 426 # Relationship defined elsewhere:
427 # LinerNotes->belongs_to('author' => 'Person');
428
429 my $rs = $schema->resultset('Artist')->search(
430 {
431 'liner_notes.notes' => { 'like', '%some text%' },
432 'author.name' => 'A. Writer'
433 },
434 {
435 join => {
436 'cds' => {
437 'liner_notes' => 'author'
ea6309e2 438 }
bade79c4 439 }
440 }
441 );
ea6309e2 442
bade79c4 443 # Equivalent SQL:
444 # SELECT artist.* FROM artist
445 # JOIN ( cd ON artist.id = cd.artist )
446 # JOIN ( liner_notes ON cd.id = liner_notes.cd )
447 # JOIN ( author ON author.id = liner_notes.author )
448 # WHERE liner_notes.notes LIKE '%some text%'
449 # AND author.name = 'A. Writer'
87980de7 450
897342e4 451=head2 Multi-step prefetch
452
453From 0.04999_05 onwards, C<prefetch> can be nested more than one relationship
454deep using the same syntax as a multi-step join:
455
456 my $rs = $schema->resultset('Tag')->search(
ac2803ef 457 {},
897342e4 458 {
459 prefetch => {
460 cd => 'artist'
461 }
462 }
463 );
464
465 # Equivalent SQL:
466 # SELECT tag.*, cd.*, artist.* FROM tag
467 # JOIN cd ON tag.cd = cd.cdid
468 # JOIN artist ON cd.artist = artist.artistid
469
470Now accessing our C<cd> and C<artist> relationships does not need additional
471SQL statements:
472
473 my $tag = $rs->first;
474 print $tag->cd->artist->name;
475
d2f3e87b 476=head1 ROW-LEVEL OPERATIONS
477
478=head2 Retrieving a row object's Schema
479
480It is possible to get a Schema object from a row object like so:
481
482 my $schema = $cd->result_source->schema;
483 # use the schema as normal:
484 my $artist_rs = $schema->resultset('Artist');
485
486This can be useful when you don't want to pass around a Schema object to every
487method.
488
489=head2 Getting the value of the primary key for the last database insert
490
491AKA getting last_insert_id
492
493If you are using PK::Auto (which is a core component as of 0.07), this is
494straightforward:
495
496 my $foo = $rs->create(\%blah);
497 # do more stuff
498 my $id = $foo->id; # foo->my_primary_key_field will also work.
499
500If you are not using autoincrementing primary keys, this will probably
501not work, but then you already know the value of the last primary key anyway.
502
503=head2 Stringification
504
505Employ the standard stringification technique by using the C<overload>
506module.
507
508To make an object stringify itself as a single column, use something
509like this (replace C<foo> with the column/method of your choice):
510
511 use overload '""' => sub { shift->name}, fallback => 1;
512
513For more complex stringification, you can use an anonymous subroutine:
514
515 use overload '""' => sub { $_[0]->name . ", " .
516 $_[0]->address }, fallback => 1;
517
518=head3 Stringification Example
519
520Suppose we have two tables: C<Product> and C<Category>. The table
521specifications are:
522
523 Product(id, Description, category)
524 Category(id, Description)
525
526C<category> is a foreign key into the Category table.
527
528If you have a Product object C<$obj> and write something like
529
530 print $obj->category
531
532things will not work as expected.
533
534To obtain, for example, the category description, you should add this
535method to the class defining the Category table:
536
537 use overload "" => sub {
538 my $self = shift;
539
540 return $self->Description;
541 }, fallback => 1;
542
543=head2 Want to know if find_or_create found or created a row?
544
545Just use C<find_or_new> instead, then check C<in_storage>:
546
547 my $obj = $rs->find_or_new({ blah => 'blarg' });
548 unless ($obj->in_storage) {
549 $obj->insert;
550 # do whatever else you wanted if it was a new row
551 }
552
553=head2 Dynamic Sub-classing DBIx::Class proxy classes
554
555AKA multi-class object inflation from one table
556
557L<DBIx::Class> classes are proxy classes, therefore some different
558techniques need to be employed for more than basic subclassing. In
559this example we have a single user table that carries a boolean bit
560for admin. We would like like to give the admin users
561objects(L<DBIx::Class::Row>) the same methods as a regular user but
562also special admin only methods. It doesn't make sense to create two
563seperate proxy-class files for this. We would be copying all the user
564methods into the Admin class. There is a cleaner way to accomplish
565this.
566
567Overriding the C<inflate_result> method within the User proxy-class
568gives us the effect we want. This method is called by
569L<DBIx::Class::ResultSet> when inflating a result from storage. So we
570grab the object being returned, inspect the values we are looking for,
571bless it if it's an admin object, and then return it. See the example
572below:
573
574B<Schema Definition>
575
576 package DB::Schema;
577
578 use base qw/DBIx::Class::Schema/;
579
580 __PACKAGE__->load_classes(qw/User/);
581
582
583B<Proxy-Class definitions>
584
585 package DB::Schema::User;
586
587 use strict;
588 use warnings;
589 use base qw/DBIx::Class/;
590
591 ### Defined what our admin class is for ensure_class_loaded
592 my $admin_class = __PACKAGE__ . '::Admin';
593
594 __PACKAGE__->load_components(qw/Core/);
595
596 __PACKAGE__->table('users');
597
598 __PACKAGE__->add_columns(qw/user_id email password
599 firstname lastname active
600 admin/);
601
602 __PACKAGE__->set_primary_key('user_id');
603
604 sub inflate_result {
605 my $self = shift;
606 my $ret = $self->next::method(@_);
607 if( $ret->admin ) {### If this is an admin rebless for extra functions
608 $self->ensure_class_loaded( $admin_class );
609 bless $ret, $admin_class;
610 }
611 return $ret;
612 }
613
614 sub hello {
615 print "I am a regular user.\n";
616 return ;
617 }
618
619
620 package DB::Schema::User::Admin;
621
622 use strict;
623 use warnings;
624 use base qw/DB::Schema::User/;
625
626 sub hello
627 {
628 print "I am an admin.\n";
629 return;
630 }
631
632 sub do_admin_stuff
633 {
634 print "I am doing admin stuff\n";
635 return ;
636 }
637
638B<Test File> test.pl
639
640 use warnings;
641 use strict;
642 use DB::Schema;
643
644 my $user_data = { email => 'someguy@place.com',
645 password => 'pass1',
646 admin => 0 };
647
648 my $admin_data = { email => 'someadmin@adminplace.com',
649 password => 'pass2',
650 admin => 1 };
651
652 my $schema = DB::Schema->connection('dbi:Pg:dbname=test');
653
654 $schema->resultset('User')->create( $user_data );
655 $schema->resultset('User')->create( $admin_data );
656
657 ### Now we search for them
658 my $user = $schema->resultset('User')->single( $user_data );
659 my $admin = $schema->resultset('User')->single( $admin_data );
660
661 print ref $user, "\n";
662 print ref $admin, "\n";
663
664 print $user->password , "\n"; # pass1
665 print $admin->password , "\n";# pass2; inherited from User
666 print $user->hello , "\n";# I am a regular user.
667 print $admin->hello, "\n";# I am an admin.
668
669 ### The statement below will NOT print
670 print "I can do admin stuff\n" if $user->can('do_admin_stuff');
671 ### The statement below will print
672 print "I can do admin stuff\n" if $admin->can('do_admin_stuff');
673
674=head2 Skip object creation for faster results
675
676DBIx::Class is not built for speed, it's built for convenience and
677ease of use, but sometimes you just need to get the data, and skip the
678fancy objects.
679
680To do this simply use L<DBIx::Class::ResultClass::HashRefInflator>.
681
682 my $rs = $schema->resultset('CD');
683
684 $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
685
686 my $hash_ref = $rs->find(1);
687
688Wasn't that easy?
689
690=head2 Get raw data for blindingly fast results
691
692If the L<HashRefInflator|DBIx::Class::ResultClass::HashRefInflator> solution
693above is not fast enough for you, you can use a DBIx::Class to return values
694exactly as they come out of the data base with none of the convenience methods
695wrapped round them.
696
697This is used like so:-
698
699 my $cursor = $rs->cursor
700 while (my @vals = $cursor->next) {
701 # use $val[0..n] here
702 }
703
704You will need to map the array offsets to particular columns (you can
705use the I<select> attribute of C<search()> to force ordering).
706
707=head1 RESULTSET OPERATIONS
708
709=head2 Getting Schema from a ResultSet
710
711To get the schema object from a result set, do the following:
712
713 $rs->result_source->schema
714
715=head2 Getting Columns Of Data
716
717AKA Aggregating Data
ac2803ef 718
719If you want to find the sum of a particular column there are several
720ways, the obvious one is to use search:
721
722 my $rs = $schema->resultset('Items')->search(
723 {},
724 {
725 select => [ { sum => 'Cost' } ],
d676881f 726 as => [ 'total_cost' ], # remember this 'as' is for DBIx::Class::ResultSet not SQL
ac2803ef 727 }
728 );
729 my $tc = $rs->first->get_column('total_cost');
730
731Or, you can use the L<DBIx::Class::ResultSetColumn>, which gets
732returned when you ask the C<ResultSet> for a column using
733C<get_column>:
734
735 my $cost = $schema->resultset('Items')->get_column('Cost');
736 my $tc = $cost->sum;
737
738With this you can also do:
739
740 my $minvalue = $cost->min;
741 my $maxvalue = $cost->max;
742
743Or just iterate through the values of this column only:
744
745 while ( my $c = $cost->next ) {
746 print $c;
747 }
748
749 foreach my $c ($cost->all) {
750 print $c;
751 }
752
709353af 753C<ResultSetColumn> only has a limited number of built-in functions, if
754you need one that it doesn't have, then you can use the C<func> method
755instead:
756
757 my $avg = $cost->func('AVERAGE');
758
759This will cause the following SQL statement to be run:
760
761 SELECT AVERAGE(Cost) FROM Items me
762
763Which will of course only work if your database supports this function.
ac2803ef 764See L<DBIx::Class::ResultSetColumn> for more documentation.
765
204e5c03 766=head2 Creating a result set from a set of rows
767
768Sometimes you have a (set of) row objects that you want to put into a
769resultset without the need to hit the DB again. You can do that by using the
770L<set_cache|DBIx::Class::Resultset/set_cache> method:
771
2d7a4e46 772 my @uploadable_groups;
204e5c03 773 while (my $group = $groups->next) {
774 if ($group->can_upload($self)) {
775 push @uploadable_groups, $group;
776 }
777 }
778 my $new_rs = $self->result_source->resultset;
779 $new_rs->set_cache(\@uploadable_groups);
780 return $new_rs;
781
782
d2f3e87b 783=head1 USING RELATIONSHIPS
acee4e4d 784
d2f3e87b 785=head2 Create a new row in a related table
acee4e4d 786
6f1434fd 787 my $author = $book->create_related('author', { name => 'Fred'});
acee4e4d 788
d2f3e87b 789=head2 Search in a related table
acee4e4d 790
791Only searches for books named 'Titanic' by the author in $author.
792
6f1434fd 793 my $books_rs = $author->search_related('books', { name => 'Titanic' });
acee4e4d 794
d2f3e87b 795=head2 Delete data in a related table
acee4e4d 796
797Deletes only the book named Titanic by the author in $author.
798
6f1434fd 799 $author->delete_related('books', { name => 'Titanic' });
acee4e4d 800
d2f3e87b 801=head2 Ordering a relationship result set
f8bad769 802
803If you always want a relation to be ordered, you can specify this when you
804create the relationship.
805
6f1434fd 806To order C<< $book->pages >> by descending page_number, create the relation
807as follows:
f8bad769 808
6f1434fd 809 __PACKAGE__->has_many('pages' => 'Page', 'book', { order_by => \'page_number DESC'} );
f8bad769 810
d2f3e87b 811=head2 Many-to-many relationships
f8bad769 812
d2f3e87b 813This is straightforward using L<ManyToMany|DBIx::Class::Relationship/many_to_many>:
f8bad769 814
d2f3e87b 815 package My::User;
6f1434fd 816 use base 'DBIx::Class';
817 __PACKAGE__->load_components('Core');
d2f3e87b 818 __PACKAGE__->table('user');
819 __PACKAGE__->add_columns(qw/id name/);
820 __PACKAGE__->set_primary_key('id');
821 __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'user');
822 __PACKAGE__->many_to_many('addresses' => 'user_address', 'address');
87980de7 823
d2f3e87b 824 package My::UserAddress;
6f1434fd 825 use base 'DBIx::Class';
826 __PACKAGE__->load_components('Core');
d2f3e87b 827 __PACKAGE__->table('user_address');
828 __PACKAGE__->add_columns(qw/user address/);
829 __PACKAGE__->set_primary_key(qw/user address/);
830 __PACKAGE__->belongs_to('user' => 'My::User');
831 __PACKAGE__->belongs_to('address' => 'My::Address');
181a28f4 832
d2f3e87b 833 package My::Address;
6f1434fd 834 use base 'DBIx::Class';
835 __PACKAGE__->load_components('Core');
d2f3e87b 836 __PACKAGE__->table('address');
837 __PACKAGE__->add_columns(qw/id street town area_code country/);
838 __PACKAGE__->set_primary_key('id');
839 __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'address');
840 __PACKAGE__->many_to_many('users' => 'user_address', 'user');
841
842 $rs = $user->addresses(); # get all addresses for a user
843 $rs = $address->users(); # get all users for an address
844
845=head1 TRANSACTIONS
846
847As of version 0.04001, there is improved transaction support in
848L<DBIx::Class::Storage> and L<DBIx::Class::Schema>. Here is an
849example of the recommended way to use it:
850
851 my $genus = $schema->resultset('Genus')->find(12);
852
853 my $coderef2 = sub {
854 $genus->extinct(1);
855 $genus->update;
856 };
70634260 857
181a28f4 858 my $coderef1 = sub {
35d4fe78 859 $genus->add_to_species({ name => 'troglodyte' });
860 $genus->wings(2);
861 $genus->update;
6f1434fd 862 $schema->txn_do($coderef2); # Can have a nested transaction. Only the outer will actualy commit
181a28f4 863 return $genus->species;
864 };
865
181a28f4 866 my $rs;
867 eval {
70634260 868 $rs = $schema->txn_do($coderef1);
181a28f4 869 };
870
871 if ($@) { # Transaction failed
872 die "the sky is falling!" #
873 if ($@ =~ /Rollback failed/); # Rollback failed
874
875 deal_with_failed_transaction();
35d4fe78 876 }
87980de7 877
181a28f4 878Nested transactions will work as expected. That is, only the outermost
879transaction will actually issue a commit to the $dbh, and a rollback
880at any level of any transaction will cause the entire nested
881transaction to fail. Support for savepoints and for true nested
40dbc108 882transactions (for databases that support them) will hopefully be added
883in the future.
ee38fa40 884
d2f3e87b 885=head1 SQL
ee38fa40 886
d2f3e87b 887=head2 Creating Schemas From An Existing Database
ea6309e2 888
d2f3e87b 889L<DBIx::Class::Schema::Loader> will connect to a database and create a
890L<DBIx::Class::Schema> and associated sources by examining the database.
bade79c4 891
d2f3e87b 892The recommend way of achieving this is to use the
893L<make_schema_at|DBIx::Class::Schema::Loader/make_schema_at> method:
bade79c4 894
6f1434fd 895 perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib \
896 -e 'make_schema_at("My::Schema", { debug => 1 }, [ "dbi:Pg:dbname=foo","postgres" ])'
362500af 897
d2f3e87b 898This will create a tree of files rooted at C<./lib/My/Schema/> containing
899source definitions for all the tables found in the C<foo> database.
362500af 900
d2f3e87b 901=head2 Creating DDL SQL
362500af 902
264f1571 903The following functionality requires you to have L<SQL::Translator>
904(also known as "SQL Fairy") installed.
362500af 905
264f1571 906To create a set of database-specific .sql files for the above schema:
362500af 907
264f1571 908 my $schema = My::Schema->connect($dsn);
909 $schema->create_ddl_dir(['MySQL', 'SQLite', 'PostgreSQL'],
910 '0.1',
d2f3e87b 911 './dbscriptdir/'
264f1571 912 );
913
914By default this will create schema files in the current directory, for
915MySQL, SQLite and PostgreSQL, using the $VERSION from your Schema.pm.
916
917To create a new database using the schema:
918
919 my $schema = My::Schema->connect($dsn);
920 $schema->deploy({ add_drop_tables => 1});
921
922To import created .sql files using the mysql client:
923
924 mysql -h "host" -D "database" -u "user" -p < My_Schema_1.0_MySQL.sql
925
926To create C<ALTER TABLE> conversion scripts to update a database to a
927newer version of your schema at a later point, first set a new
d2f3e87b 928C<$VERSION> in your Schema file, then:
264f1571 929
930 my $schema = My::Schema->connect($dsn);
931 $schema->create_ddl_dir(['MySQL', 'SQLite', 'PostgreSQL'],
932 '0.2',
933 '/dbscriptdir/',
934 '0.1'
935 );
936
937This will produce new database-specific .sql files for the new version
938of the schema, plus scripts to convert from version 0.1 to 0.2. This
939requires that the files for 0.1 as created above are available in the
940given directory to diff against.
362500af 941
6f1434fd 942=head2 Select from dual
16cd5b28 943
944Dummy tables are needed by some databases to allow calling functions
945or expressions that aren't based on table content, for examples of how
946this applies to various database types, see:
947L<http://troels.arvin.dk/db/rdbms/#other-dummy_table>.
948
949Note: If you're using Oracles dual table don't B<ever> do anything
950other than a select, if you CRUD on your dual table you *will* break
951your database.
952
953Make a table class as you would for any other table
954
955 package MyAppDB::Dual;
956 use strict;
957 use warnings;
958 use base 'DBIx::Class';
959 __PACKAGE__->load_components("Core");
960 __PACKAGE__->table("Dual");
961 __PACKAGE__->add_columns(
962 "dummy",
963 { data_type => "VARCHAR2", is_nullable => 0, size => 1 },
964 );
965
966Once you've loaded your table class select from it using C<select>
967and C<as> instead of C<columns>
968
969 my $rs = $schema->resultset('Dual')->search(undef,
970 { select => [ 'sydate' ],
971 as => [ 'now' ]
972 },
973 );
974
975All you have to do now is be careful how you access your resultset, the below
976will not work because there is no column called 'now' in the Dual table class
977
978 while (my $dual = $rs->next) {
979 print $dual->now."\n";
980 }
6f1434fd 981 # Can't locate object method "now" via package "MyAppDB::Dual" at headshot.pl line 23.
16cd5b28 982
983You could of course use 'dummy' in C<as> instead of 'now', or C<add_columns> to
984your Dual class for whatever you wanted to select from dual, but that's just
985silly, instead use C<get_column>
986
987 while (my $dual = $rs->next) {
988 print $dual->get_column('now')."\n";
989 }
990
991Or use C<cursor>
992
993 my $cursor = $rs->cursor;
994 while (my @vals = $cursor->next) {
995 print $vals[0]."\n";
996 }
997
998Or use L<DBIx::Class::ResultClass::HashRefInflator>
999
1000 $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1001 while ( my $dual = $rs->next ) {
1002 print $dual->{now}."\n";
1003 }
1004
1005Here are some example C<select> conditions to illustrate the different syntax
1006you could use for doing stuff like
1007C<oracles.heavily(nested(functions_can('take', 'lots'), OF), 'args')>
1008
1009 # get a sequence value
1010 select => [ 'A_SEQ.nextval' ],
1011
1012 # get create table sql
1013 select => [ { 'dbms_metadata.get_ddl' => [ "'TABLE'", "'ARTIST'" ]} ],
1014
1015 # get a random num between 0 and 100
1016 select => [ { "trunc" => [ { "dbms_random.value" => [0,100] } ]} ],
1017
1018 # what year is it?
1019 select => [ { 'extract' => [ \'year from sysdate' ] } ],
1020
1021 # do some math
1022 select => [ {'round' => [{'cos' => [ \'180 * 3.14159265359/180' ]}]}],
1023
1024 # which day of the week were you born on?
6f1434fd 1025 select => [{'to_char' => [{'to_date' => [ "'25-DEC-1980'", "'dd-mon-yyyy'" ]}, "'day'"]}],
16cd5b28 1026
1027 # select 16 rows from dual
1028 select => [ "'hello'" ],
1029 as => [ 'world' ],
1030 group_by => [ 'cube( 1, 2, 3, 4 )' ],
1031
1032
1033
d2f3e87b 1034=head2 Adding Indexes And Functions To Your SQL
362500af 1035
d2f3e87b 1036Often you will want indexes on columns on your table to speed up searching. To
1037do this, create a method called C<sqlt_deploy_hook> in the relevant source
1038class:
b0a20454 1039
d2f3e87b 1040 package My::Schema::Artist;
b0a20454 1041
d2f3e87b 1042 __PACKAGE__->table('artist');
1043 __PACKAGE__->add_columns(id => { ... }, name => { ... })
b0a20454 1044
d2f3e87b 1045 sub sqlt_deploy_hook {
1046 my ($self, $sqlt_table) = @_;
1047
1048 $sqlt_table->add_index(name => 'idx_name', fields => ['name']);
1049 }
1050
1051 1;
1052
1053Sometimes you might want to change the index depending on the type of the
1054database for which SQL is being generated:
1055
1056 my ($db_type = $sqlt_table->schema->translator->producer_type)
1057 =~ s/^SQL::Translator::Producer:://;
1058
1059You can also add hooks to the schema level to stop certain tables being
1060created:
1061
1062 package My::Schema;
1063
1064 ...
1065
1066 sub sqlt_deploy_hook {
1067 my ($self, $sqlt_schema) = @_;
1068
1069 $sqlt_schema->drop_table('table_name');
1070 }
1071
1072You could also add views or procedures to the output using
1073L<SQL::Translator::Schema/add_view> or
1074L<SQL::Translator::Schema/add_procedure>.
b0a20454 1075
362500af 1076=head2 Schema versioning
1077
1078The following example shows simplistically how you might use DBIx::Class to
1079deploy versioned schemas to your customers. The basic process is as follows:
1080
da4779ad 1081=over 4
1082
1083=item 1.
1084
1085Create a DBIx::Class schema
1086
1087=item 2.
1088
1089Save the schema
1090
1091=item 3.
1092
1093Deploy to customers
1094
1095=item 4.
1096
1097Modify schema to change functionality
1098
1099=item 5.
1100
1101Deploy update to customers
1102
1103=back
362500af 1104
d2f3e87b 1105B<Create a DBIx::Class schema>
362500af 1106
1107This can either be done manually, or generated from an existing database as
d2f3e87b 1108described under L</Creating Schemas From An Existing Database>
362500af 1109
d2f3e87b 1110B<Save the schema>
362500af 1111
d2f3e87b 1112Call L<DBIx::Class::Schema/create_ddl_dir> as above under L</Creating DDL SQL>.
362500af 1113
d2f3e87b 1114B<Deploy to customers>
362500af 1115
1116There are several ways you could deploy your schema. These are probably
1117beyond the scope of this recipe, but might include:
1118
da4779ad 1119=over 4
1120
1121=item 1.
1122
1123Require customer to apply manually using their RDBMS.
1124
1125=item 2.
1126
1127Package along with your app, making database dump/schema update/tests
362500af 1128all part of your install.
1129
da4779ad 1130=back
1131
d2f3e87b 1132B<Modify the schema to change functionality>
362500af 1133
264f1571 1134As your application evolves, it may be necessary to modify your schema
1135to change functionality. Once the changes are made to your schema in
1136DBIx::Class, export the modified schema and the conversion scripts as
d2f3e87b 1137in L</Creating DDL SQL>.
362500af 1138
d2f3e87b 1139B<Deploy update to customers>
362500af 1140
264f1571 1141Add the L<DBIx::Class::Schema::Versioned> schema component to your
1142Schema class. This will add a new table to your database called
ecea7937 1143C<dbix_class_schema_vesion> which will keep track of which version is installed
264f1571 1144and warn if the user trys to run a newer schema version than the
1145database thinks it has.
1146
1147Alternatively, you can send the conversion sql scripts to your
1148customers as above.
362500af 1149
d2f3e87b 1150=head2 Setting quoting for the generated SQL.
1151
1152If the database contains column names with spaces and/or reserved words, they
1153need to be quoted in the SQL queries. This is done using:
1154
1155 __PACKAGE__->storage->sql_maker->quote_char([ qw/[ ]/] );
1156 __PACKAGE__->storage->sql_maker->name_sep('.');
1157
1158The first sets the quote characters. Either a pair of matching
1159brackets, or a C<"> or C<'>:
1160
1161 __PACKAGE__->storage->sql_maker->quote_char('"');
1162
1163Check the documentation of your database for the correct quote
1164characters to use. C<name_sep> needs to be set to allow the SQL
1165generator to put the quotes the correct place.
1166
1167In most cases you should set these as part of the arguments passed to
1168L<DBIx::Class::Schema/conect>:
1169
1170 my $schema = My::Schema->connect(
1171 'dbi:mysql:my_db',
1172 'db_user',
1173 'db_password',
1174 {
1175 quote_char => '"',
1176 name_sep => '.'
1177 }
1178 )
1179
7be93b07 1180=head2 Setting limit dialect for SQL::Abstract::Limit
1181
324572ca 1182In some cases, SQL::Abstract::Limit cannot determine the dialect of
1183the remote SQL server by looking at the database handle. This is a
1184common problem when using the DBD::JDBC, since the DBD-driver only
1185know that in has a Java-driver available, not which JDBC driver the
1186Java component has loaded. This specifically sets the limit_dialect
1187to Microsoft SQL-server (See more names in SQL::Abstract::Limit
1188-documentation.
7be93b07 1189
1190 __PACKAGE__->storage->sql_maker->limit_dialect('mssql');
1191
324572ca 1192The JDBC bridge is one way of getting access to a MSSQL server from a platform
7be93b07 1193that Microsoft doesn't deliver native client libraries for. (e.g. Linux)
1194
d2f3e87b 1195The limit dialect can also be set at connect time by specifying a
1196C<limit_dialect> key in the final hash as shown above.
2437a1e3 1197
d2f3e87b 1198=head1 BOOTSTRAPPING/MIGRATING
2437a1e3 1199
d2f3e87b 1200=head2 Easy migration from class-based to schema-based setup
2437a1e3 1201
d2f3e87b 1202You want to start using the schema-based approach to L<DBIx::Class>
1203(see L<SchemaIntro.pod>), but have an established class-based setup with lots
1204of existing classes that you don't want to move by hand. Try this nifty script
1205instead:
1206
1207 use MyDB;
1208 use SQL::Translator;
1209
1210 my $schema = MyDB->schema_instance;
2437a1e3 1211
d2f3e87b 1212 my $translator = SQL::Translator->new(
1213 debug => $debug || 0,
1214 trace => $trace || 0,
1215 no_comments => $no_comments || 0,
1216 show_warnings => $show_warnings || 0,
1217 add_drop_table => $add_drop_table || 0,
1218 validate => $validate || 0,
1219 parser_args => {
1220 'DBIx::Schema' => $schema,
1221 },
1222 producer_args => {
1223 'prefix' => 'My::Schema',
1224 },
1225 );
1226
1227 $translator->parser('SQL::Translator::Parser::DBIx::Class');
1228 $translator->producer('SQL::Translator::Producer::DBIx::Class::File');
1229
1230 my $output = $translator->translate(@args) or die
1231 "Error: " . $translator->error;
1232
1233 print $output;
2437a1e3 1234
d2f3e87b 1235You could use L<Module::Find> to search for all subclasses in the MyDB::*
1236namespace, which is currently left as an exercise for the reader.
2437a1e3 1237
d2f3e87b 1238=head1 OVERLOADING METHODS
086b93a2 1239
ab872312 1240L<DBIx::Class> uses the L<Class::C3> package, which provides for redispatch of
1241method calls, useful for things like default values and triggers. You have to
1242use calls to C<next::method> to overload methods. More information on using
1243L<Class::C3> with L<DBIx::Class> can be found in
086b93a2 1244L<DBIx::Class::Manual::Component>.
1245
d2f3e87b 1246=head2 Setting default values for a row
1247
1248It's as simple as overriding the C<new> method. Note the use of
1249C<next::method>.
1250
1251 sub new {
1252 my ( $class, $attrs ) = @_;
1253
1254 $attrs->{foo} = 'bar' unless defined $attrs->{foo};
1255
1256 my $new = $class->next::method($attrs);
1257
1258 return $new;
1259 }
1260
1261For more information about C<next::method>, look in the L<Class::C3>
1262documentation. See also L<DBIx::Class::Manual::Component> for more
1263ways to write your own base classes to do this.
1264
1265People looking for ways to do "triggers" with DBIx::Class are probably
1266just looking for this.
1267
1268=head2 Changing one field whenever another changes
086b93a2 1269
1270For example, say that you have three columns, C<id>, C<number>, and
1271C<squared>. You would like to make changes to C<number> and have
1272C<squared> be automagically set to the value of C<number> squared.
1273You can accomplish this by overriding C<store_column>:
1274
1275 sub store_column {
1276 my ( $self, $name, $value ) = @_;
1277 if ($name eq 'number') {
1278 $self->squared($value * $value);
1279 }
1280 $self->next::method($name, $value);
1281 }
1282
1283Note that the hard work is done by the call to C<next::method>, which
324572ca 1284redispatches your call to store_column in the superclass(es).
086b93a2 1285
d2f3e87b 1286=head2 Automatically creating related objects
086b93a2 1287
324572ca 1288You might have a class C<Artist> which has many C<CD>s. Further, if you
086b93a2 1289want to create a C<CD> object every time you insert an C<Artist> object.
ccbebdbc 1290You can accomplish this by overriding C<insert> on your objects:
086b93a2 1291
1292 sub insert {
ccbebdbc 1293 my ( $self, @args ) = @_;
1294 $self->next::method(@args);
086b93a2 1295 $self->cds->new({})->fill_from_artist($self)->insert;
1296 return $self;
1297 }
1298
1299where C<fill_from_artist> is a method you specify in C<CD> which sets
1300values in C<CD> based on the data in the C<Artist> object you pass in.
1301
d2f3e87b 1302=head2 Wrapping/overloading a column accessor
1303
1304B<Problem:>
1305
1306Say you have a table "Camera" and want to associate a description
1307with each camera. For most cameras, you'll be able to generate the description from
1308the other columns. However, in a few special cases you may want to associate a
1309custom description with a camera.
1310
1311B<Solution:>
1312
1313In your database schema, define a description field in the "Camera" table that
1314can contain text and null values.
1315
1316In DBIC, we'll overload the column accessor to provide a sane default if no
1317custom description is defined. The accessor will either return or generate the
1318description, depending on whether the field is null or not.
1319
1320First, in your "Camera" schema class, define the description field as follows:
1321
1322 __PACKAGE__->add_columns(description => { accessor => '_description' });
1323
1324Next, we'll define the accessor-wrapper subroutine:
1325
1326 sub description {
1327 my $self = shift;
1328
1329 # If there is an update to the column, we'll let the original accessor
1330 # deal with it.
1331 return $self->_description(@_) if @_;
1332
1333 # Fetch the column value.
1334 my $description = $self->_description;
1335
1336 # If there's something in the description field, then just return that.
1337 return $description if defined $description && length $descripton;
1338
1339 # Otherwise, generate a description.
1340 return $self->generate_description;
1341 }
1342
1343=head1 DEBUGGING AND PROFILING
1344
1345=head2 DBIx::Class objects with Data::Dumper
1def3451 1346
1347L<Data::Dumper> can be a very useful tool for debugging, but sometimes it can
1348be hard to find the pertinent data in all the data it can generate.
1349Specifically, if one naively tries to use it like so,
1350
1351 use Data::Dumper;
1352
1353 my $cd = $schema->resultset('CD')->find(1);
1354 print Dumper($cd);
1355
1356several pages worth of data from the CD object's schema and result source will
1357be dumped to the screen. Since usually one is only interested in a few column
1358values of the object, this is not very helpful.
1359
1360Luckily, it is possible to modify the data before L<Data::Dumper> outputs
1361it. Simply define a hook that L<Data::Dumper> will call on the object before
1362dumping it. For example,
1363
1364 package My::DB::CD;
1365
1366 sub _dumper_hook {
99fb1058 1367 $_[0] = bless {
1368 %{ $_[0] },
1def3451 1369 result_source => undef,
99fb1058 1370 }, ref($_[0]);
1def3451 1371 }
1372
1373 [...]
1374
1375 use Data::Dumper;
1376
22139027 1377 local $Data::Dumper::Freezer = '_dumper_hook';
1def3451 1378
1379 my $cd = $schema->resultset('CD')->find(1);
1380 print Dumper($cd);
1381 # dumps $cd without its ResultSource
1382
1383If the structure of your schema is such that there is a common base class for
1384all your table classes, simply put a method similar to C<_dumper_hook> in the
1385base class and set C<$Data::Dumper::Freezer> to its name and L<Data::Dumper>
1386will automagically clean up your data before printing it. See
1387L<Data::Dumper/EXAMPLES> for more information.
1388
4c248161 1389=head2 Profiling
1390
85f78622 1391When you enable L<DBIx::Class::Storage>'s debugging it prints the SQL
4c248161 1392executed as well as notifications of query completion and transaction
1393begin/commit. If you'd like to profile the SQL you can subclass the
1394L<DBIx::Class::Storage::Statistics> class and write your own profiling
1395mechanism:
1396
1397 package My::Profiler;
1398 use strict;
1399
1400 use base 'DBIx::Class::Storage::Statistics';
1401
1402 use Time::HiRes qw(time);
1403
1404 my $start;
1405
1406 sub query_start {
1407 my $self = shift();
1408 my $sql = shift();
1409 my $params = @_;
1410
70f39278 1411 $self->print("Executing $sql: ".join(', ', @params)."\n");
4c248161 1412 $start = time();
1413 }
1414
1415 sub query_end {
1416 my $self = shift();
1417 my $sql = shift();
1418 my @params = @_;
1419
70f39278 1420 my $elapsed = sprintf("%0.4f", time() - $start);
1421 $self->print("Execution took $elapsed seconds.\n");
4c248161 1422 $start = undef;
1423 }
1424
1425 1;
1426
1427You can then install that class as the debugging object:
1428
70f39278 1429 __PACKAGE__->storage->debugobj(new My::Profiler());
1430 __PACKAGE__->storage->debug(1);
4c248161 1431
1432A more complicated example might involve storing each execution of SQL in an
1433array:
1434
1435 sub query_end {
1436 my $self = shift();
1437 my $sql = shift();
1438 my @params = @_;
1439
1440 my $elapsed = time() - $start;
1441 push(@{ $calls{$sql} }, {
1442 params => \@params,
1443 elapsed => $elapsed
1444 });
1445 }
1446
1447You could then create average, high and low execution times for an SQL
1448statement and dig down to see if certain parameters cause aberrant behavior.
70f39278 1449You might want to check out L<DBIx::Class::QueryLog> as well.
4c248161 1450
7aaec96c 1451
40dbc108 1452=cut