3 DBIx::Class::Manual::Cookbook - Miscellaneous recipes
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:
14 my $rs = $schema->resultset('Artist')->search(
17 page => 1, # page to return (defaults to 1)
18 rows => 10, # number of results per page
22 return $rs->all(); # all records for page 1
24 The C<page> attribute does not have to be specified in your search:
26 my $rs = $schema->resultset('Artist')->search(
33 return $rs->page(1); # DBIx::Class::ResultSet containing first 10 records
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:
40 =head3 Complex WHERE clauses
42 Sometimes you need to formulate a query using specific operators:
44 my @albums = $schema->resultset('Album')->search({
45 artist => { 'like', '%Lamb%' },
46 title => { 'like', '%Fear of Fours%' },
49 This results in something like the following C<WHERE> clause:
51 WHERE artist LIKE '%Lamb%' AND title LIKE '%Fear of Fours%'
53 Other queries might require slightly more complex logic:
55 my @albums = $schema->resultset('Album')->search({
58 artist => { 'like', '%Smashing Pumpkins%' },
59 title => 'Siamese Dream',
61 artist => 'Starchildren',
65 This results in the following C<WHERE> clause:
67 WHERE ( artist LIKE '%Smashing Pumpkins%' AND title = 'Siamese Dream' )
68 OR artist = 'Starchildren'
70 For more information on generating complex queries, see
71 L<SQL::Abstract/WHERE CLAUSES>.
73 =head3 Using specific columns
75 When you only want specific columns from a table, you can use
76 C<columns> to specify which ones you need. This is useful to avoid
77 loading columns with large amounts of data that you aren't about to
80 my $rs = $schema->resultset('Artist')->search(
83 columns => [qw/ name /]
88 # SELECT artist.name FROM artist
90 This is a shortcut for C<select> and C<as>, see below. C<columns>
91 cannot be used together with C<select> and C<as>.
93 =head3 Using database functions or stored procedures
95 The combination of C<select> and C<as> can be used to return the result of a
96 database function or stored procedure as a column value. You use C<select> to
97 specify the source for your column value (e.g. a column name, function, or
98 stored procedure name). You then use C<as> to set the column name you will use
99 to access the returned value:
101 my $rs = $schema->resultset('Artist')->search(
104 select => [ 'name', { LENGTH => 'name' } ],
105 as => [qw/ name name_length /],
110 # SELECT name name, LENGTH( name ) name_length
113 If your alias exists as a column in your base class (i.e. it was added
114 with C<add_columns>), you just access it as normal. Our C<Artist>
115 class has a C<name> column, so we just use the C<name> accessor:
117 my $artist = $rs->first();
118 my $name = $artist->name();
120 If on the other hand the alias does not correspond to an existing column, you
121 have to fetch the value using the C<get_column> accessor:
123 my $name_length = $artist->get_column('name_length');
125 If you don't like using C<get_column>, you can always create an accessor for
126 any of your aliases using either of these:
128 # Define accessor manually:
129 sub name_length { shift->get_column('name_length'); }
131 # Or use DBIx::Class::AccessorGroup:
132 __PACKAGE__->mk_group_accessors('column' => 'name_length');
134 =head3 SELECT DISTINCT with multiple columns
136 my $rs = $schema->resultset('Foo')->search(
140 { distinct => [ $source->columns ] }
142 as => [ $source->columns ]
146 my $count = $rs->next->get_column('count');
148 =head3 SELECT COUNT(DISTINCT colname)
150 my $rs = $schema->resultset('Foo')->search(
154 { count => { distinct => 'colname' } }
160 =head3 Grouping results
162 L<DBIx::Class> supports C<GROUP BY> as follows:
164 my $rs = $schema->resultset('Artist')->search(
168 select => [ 'name', { count => 'cds.cdid' } ],
169 as => [qw/ name cd_count /],
170 group_by => [qw/ name /]
175 # SELECT name, COUNT( cds.cdid ) FROM artist me
176 # LEFT JOIN cd cds ON ( cds.artist = me.artistid )
179 =head3 Predefined searches
181 You can write your own L<DBIx::Class::ResultSet> class by inheriting from it
182 and define often used searches as methods:
184 package My::DBIC::ResultSet::CD;
187 use base 'DBIx::Class::ResultSet';
189 sub search_cds_ordered {
192 return $self->search(
194 { order_by => 'name DESC' },
200 To use your resultset, first tell DBIx::Class to create an instance of it
201 for you, in your My::DBIC::Schema::CD class:
203 __PACKAGE__->resultset_class('My::DBIC::ResultSet::CD');
205 Then call your new method in your code:
207 my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();
210 =head3 Predefined searches without writing a ResultSet class
212 Alternatively you can automatically generate a DBIx::Class::ResultSet
213 class by using the ResultSetManager component and tagging your method
216 __PACKAGE__->load_components(qw/ ResultSetManager Core /);
218 sub search_cds_ordered : ResultSet {
220 return $self->search(
222 { order_by => 'name DESC' },
226 Then call your method in the same way from your code:
228 my $ordered_cds = $schema->resultset('CD')->search_cds_ordered();
230 =head2 Using joins and prefetch
232 You can use the C<join> attribute to allow searching on, or sorting your
233 results by, one or more columns in a related table. To return all CDs matching
234 a particular artist name:
236 my $rs = $schema->resultset('CD')->search(
238 'artist.name' => 'Bob Marley'
241 join => [qw/artist/], # join the artist table
246 # SELECT cd.* FROM cd
247 # JOIN artist ON cd.artist = artist.id
248 # WHERE artist.name = 'Bob Marley'
250 If required, you can now sort on any column in the related tables by including
251 it in your C<order_by> attribute:
253 my $rs = $schema->resultset('CD')->search(
255 'artist.name' => 'Bob Marley'
258 join => [qw/ artist /],
259 order_by => [qw/ artist.name /]
264 # SELECT cd.* FROM cd
265 # JOIN artist ON cd.artist = artist.id
266 # WHERE artist.name = 'Bob Marley'
267 # ORDER BY artist.name
269 Note that the C<join> attribute should only be used when you need to search or
270 sort using columns in a related table. Joining related tables when you only
271 need columns from the main table will make performance worse!
273 Now let's say you want to display a list of CDs, each with the name of the
274 artist. The following will work fine:
276 while (my $cd = $rs->next) {
277 print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
280 There is a problem however. We have searched both the C<cd> and C<artist> tables
281 in our main query, but we have only returned data from the C<cd> table. To get
282 the artist name for any of the CD objects returned, L<DBIx::Class> will go back
285 SELECT artist.* FROM artist WHERE artist.id = ?
287 A statement like the one above will run for each and every CD returned by our
288 main query. Five CDs, five extra queries. A hundred CDs, one hundred extra
291 Thankfully, L<DBIx::Class> has a C<prefetch> attribute to solve this problem.
292 This allows you to fetch results from related tables in advance:
294 my $rs = $schema->resultset('CD')->search(
296 'artist.name' => 'Bob Marley'
299 join => [qw/ artist /],
300 order_by => [qw/ artist.name /],
301 prefetch => [qw/ artist /] # return artist data too!
305 # Equivalent SQL (note SELECT from both "cd" and "artist"):
306 # SELECT cd.*, artist.* FROM cd
307 # JOIN artist ON cd.artist = artist.id
308 # WHERE artist.name = 'Bob Marley'
309 # ORDER BY artist.name
311 The code to print the CD list remains the same:
313 while (my $cd = $rs->next) {
314 print "CD: " . $cd->title . ", Artist: " . $cd->artist->name;
317 L<DBIx::Class> has now prefetched all matching data from the C<artist> table,
318 so no additional SQL statements are executed. You now have a much more
321 Note that as of L<DBIx::Class> 0.05999_01, C<prefetch> I<can> be used with
322 C<has_many> relationships.
324 Also note that C<prefetch> should only be used when you know you will
325 definitely use data from a related table. Pre-fetching related tables when you
326 only need columns from the main table will make performance worse!
328 =head3 Multi-step joins
330 Sometimes you want to join more than one relationship deep. In this example,
331 we want to find all C<Artist> objects who have C<CD>s whose C<LinerNotes>
332 contain a specific string:
334 # Relationships defined elsewhere:
335 # Artist->has_many('cds' => 'CD', 'artist');
336 # CD->has_one('liner_notes' => 'LinerNotes', 'cd');
338 my $rs = $schema->resultset('Artist')->search(
340 'liner_notes.notes' => { 'like', '%some text%' },
344 'cds' => 'liner_notes'
350 # SELECT artist.* FROM artist
351 # JOIN ( cd ON artist.id = cd.artist )
352 # JOIN ( liner_notes ON cd.id = liner_notes.cd )
353 # WHERE liner_notes.notes LIKE '%some text%'
355 Joins can be nested to an arbitrary level. So if we decide later that we
356 want to reduce the number of Artists returned based on who wrote the liner
359 # Relationship defined elsewhere:
360 # LinerNotes->belongs_to('author' => 'Person');
362 my $rs = $schema->resultset('Artist')->search(
364 'liner_notes.notes' => { 'like', '%some text%' },
365 'author.name' => 'A. Writer'
370 'liner_notes' => 'author'
377 # SELECT artist.* FROM artist
378 # JOIN ( cd ON artist.id = cd.artist )
379 # JOIN ( liner_notes ON cd.id = liner_notes.cd )
380 # JOIN ( author ON author.id = liner_notes.author )
381 # WHERE liner_notes.notes LIKE '%some text%'
382 # AND author.name = 'A. Writer'
384 =head2 Multi-step prefetch
386 From 0.04999_05 onwards, C<prefetch> can be nested more than one relationship
387 deep using the same syntax as a multi-step join:
389 my $rs = $schema->resultset('Tag')->search(
399 # SELECT tag.*, cd.*, artist.* FROM tag
400 # JOIN cd ON tag.cd = cd.cdid
401 # JOIN artist ON cd.artist = artist.artistid
403 Now accessing our C<cd> and C<artist> relationships does not need additional
406 my $tag = $rs->first;
407 print $tag->cd->artist->name;
409 =head2 Using relationships
411 =head3 Create a new row in a related table
413 my $book->create_related('author', { name => 'Fred'});
415 =head3 Search in a related table
417 Only searches for books named 'Titanic' by the author in $author.
419 my $author->search_related('books', { name => 'Titanic' });
421 =head3 Delete data in a related table
423 Deletes only the book named Titanic by the author in $author.
425 my $author->delete_related('books', { name => 'Titanic' });
427 =head3 Ordering a relationship result set
429 If you always want a relation to be ordered, you can specify this when you
430 create the relationship.
432 To order C<< $book->pages >> by descending page_number.
434 Book->has_many('pages' => 'Page', 'book', { order_by => \'page_number DESC'} );
440 As of version 0.04001, there is improved transaction support in
441 L<DBIx::Class::Storage::DBI> and L<DBIx::Class::Schema>. Here is an
442 example of the recommended way to use it:
444 my $genus = $schema->resultset('Genus')->find(12);
452 $genus->add_to_species({ name => 'troglodyte' });
455 $schema->txn_do($coderef2); # Can have a nested transaction
456 return $genus->species;
461 $rs = $schema->txn_do($coderef1);
464 if ($@) { # Transaction failed
465 die "the sky is falling!" #
466 if ($@ =~ /Rollback failed/); # Rollback failed
468 deal_with_failed_transaction();
471 Nested transactions will work as expected. That is, only the outermost
472 transaction will actually issue a commit to the $dbh, and a rollback
473 at any level of any transaction will cause the entire nested
474 transaction to fail. Support for savepoints and for true nested
475 transactions (for databases that support them) will hopefully be added
478 =head2 Many-to-many relationships
480 This is straightforward using L<DBIx::Class::Relationship::ManyToMany>:
483 # ... set up connection ...
487 __PACKAGE__->table('user');
488 __PACKAGE__->add_columns(qw/id name/);
489 __PACKAGE__->set_primary_key('id');
490 __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'user');
491 __PACKAGE__->many_to_many('addresses' => 'user_address', 'address');
493 package My::UserAddress;
495 __PACKAGE__->table('user_address');
496 __PACKAGE__->add_columns(qw/user address/);
497 __PACKAGE__->set_primary_key(qw/user address/);
498 __PACKAGE__->belongs_to('user' => 'My::User');
499 __PACKAGE__->belongs_to('address' => 'My::Address');
503 __PACKAGE__->table('address');
504 __PACKAGE__->add_columns(qw/id street town area_code country/);
505 __PACKAGE__->set_primary_key('id');
506 __PACKAGE__->has_many('user_address' => 'My::UserAddress', 'address');
507 __PACKAGE__->many_to_many('users' => 'user_address', 'user');
509 $rs = $user->addresses(); # get all addresses for a user
510 $rs = $address->users(); # get all users for an address
512 =head2 Setting default values for a row
514 It's as simple as overriding the C<new> method. Note the use of
518 my ( $class, $attrs ) = @_;
520 $attrs->{foo} = 'bar' unless defined $attrs->{foo};
522 $class->next::method($attrs);
525 For more information about C<next::method>, look in the L<Class::C3>
526 documentation. See also L<DBIx::Class::Manual::Component> for more
527 ways to write your own base classes to do this.
529 People looking for ways to do "triggers" with DBIx::Class are probably
530 just looking for this.
532 =head2 Stringification
534 Employ the standard stringification technique by using the C<overload>
537 To make an object stringify itself as a single column, use something
538 like this (replace C<foo> with the column/method of your choice):
540 use overload '""' => 'foo', fallback => 1;
542 For more complex stringification, you can use an anonymous subroutine:
544 use overload '""' => sub { $_[0]->name . ", " .
545 $_[0]->address }, fallback => 1;
547 =head3 Stringification Example
549 Suppose we have two tables: C<Product> and C<Category>. The table
552 Product(id, Description, category)
553 Category(id, Description)
555 C<category> is a foreign key into the Category table.
557 If you have a Product object C<$obj> and write something like
561 things will not work as expected.
563 To obtain, for example, the category description, you should add this
564 method to the class defining the Category table:
566 use overload "" => sub {
569 return $self->Description;
572 =head2 Disconnecting cleanly
574 If you find yourself quitting an app with Control-C a lot during
575 development, you might like to put the following signal handler in
576 your main database class to make sure it disconnects cleanly:
579 __PACKAGE__->storage->disconnect;
582 =head2 Schema import/export
584 This functionality requires you to have L<SQL::Translator> (also known as
585 "SQL Fairy") installed.
587 To create a DBIx::Class schema from an existing database:
590 --to DBIx::Class::File
591 --prefix "MySchema" > MySchema.pm
593 To create a MySQL database from an existing L<DBIx::Class> schema, convert the
594 schema to MySQL's dialect of SQL:
596 sqlt --from SQL::Translator::Parser::DBIx::Class
598 --DBIx::Class "MySchema.pm" > Schema1.sql
600 And import using the mysql client:
602 mysql -h "host" -D "database" -u "user" -p < Schema1.sql
604 =head2 Easy migration from class-based to schema-based setup
606 You want to start using the schema-based approach to L<DBIx::Class>
607 (see L<SchemaIntro.pod>), but have an established class-based setup with lots
608 of existing classes that you don't want to move by hand. Try this nifty script
614 my $schema = MyDB->schema_instance;
616 my $translator = SQL::Translator->new(
617 debug => $debug || 0,
618 trace => $trace || 0,
619 no_comments => $no_comments || 0,
620 show_warnings => $show_warnings || 0,
621 add_drop_table => $add_drop_table || 0,
622 validate => $validate || 0,
624 'DBIx::Schema' => $schema,
627 'prefix' => 'My::Schema',
631 $translator->parser('SQL::Translator::Parser::DBIx::Class');
632 $translator->producer('SQL::Translator::Producer::DBIx::Class::File');
634 my $output = $translator->translate(@args) or die
635 "Error: " . $translator->error;
639 You could use L<Module::Find> to search for all subclasses in the MyDB::*
640 namespace, which is currently left as an exercise for the reader.
642 =head2 Schema versioning
644 The following example shows simplistically how you might use DBIx::Class to
645 deploy versioned schemas to your customers. The basic process is as follows:
651 Create a DBIx::Class schema
663 Modify schema to change functionality
667 Deploy update to customers
671 =head3 Create a DBIx::Class schema
673 This can either be done manually, or generated from an existing database as
674 described under C<Schema import/export>.
676 =head3 Save the schema
678 Use C<sqlt> to transform your schema into an SQL script suitable for your
679 customer's database. E.g. for MySQL:
681 sqlt --from SQL::Translator::Parser::DBIx::Class
683 --DBIx::Class "MySchema.pm" > Schema1.mysql.sql
685 If you need to target databases from multiple vendors, just generate an SQL
686 script suitable for each. To support PostgreSQL too:
688 sqlt --from SQL::Translator::DBIx::Class
690 --DBIx::Class "MySchema.pm" > Schema1.pgsql.sql
692 =head3 Deploy to customers
694 There are several ways you could deploy your schema. These are probably
695 beyond the scope of this recipe, but might include:
701 Require customer to apply manually using their RDBMS.
705 Package along with your app, making database dump/schema update/tests
706 all part of your install.
710 =head3 Modify the schema to change functionality
712 As your application evolves, it may be necessary to modify your schema to
713 change functionality. Once the changes are made to your schema in DBIx::Class,
714 export the modified schema as before, taking care not to overwrite the original:
716 sqlt --from SQL::Translator::DBIx::Class
718 --DBIx::Class "Anything.pm" > Schema2.mysql.sql
720 Next, use sqlt-diff to create an SQL script that will update the customer's
723 sqlt-diff --to MySQL Schema1=MySQL Schema2=MySQL > SchemaUpdate.mysql.sql
725 =head3 Deploy update to customers
727 The schema update can be deployed to customers using the same method as before.
729 =head2 Setting limit dialect for SQL::Abstract::Limit
731 In some cases, SQL::Abstract::Limit cannot determine the dialect of
732 the remote SQL server by looking at the database handle. This is a
733 common problem when using the DBD::JDBC, since the DBD-driver only
734 know that in has a Java-driver available, not which JDBC driver the
735 Java component has loaded. This specifically sets the limit_dialect
736 to Microsoft SQL-server (See more names in SQL::Abstract::Limit
739 __PACKAGE__->storage->sql_maker->limit_dialect('mssql');
741 The JDBC bridge is one way of getting access to a MSSQL server from a platform
742 that Microsoft doesn't deliver native client libraries for. (e.g. Linux)
744 =head2 Setting quoting for the generated SQL.
746 If the database contains column names with spaces and/or reserved words, they
747 need to be quoted in the SQL queries. This is done using:
749 __PACKAGE__->storage->sql_maker->quote_char([ qw/[ ]/] );
750 __PACKAGE__->storage->sql_maker->name_sep('.');
752 The first sets the quote characters. Either a pair of matching
753 brackets, or a C<"> or C<'>:
755 __PACKAGE__->storage->sql_maker->quote_char('"');
757 Check the documentation of your database for the correct quote
758 characters to use. C<name_sep> needs to be set to allow the SQL
759 generator to put the quotes the correct place.
761 =head2 Overloading methods
763 L<DBIx::Class> uses the L<Class::C3> package, which provides for redispatch of
764 method calls. You have to use calls to C<next::method> to overload methods.
765 More information on using L<Class::C3> with L<DBIx::Class> can be found in
766 L<DBIx::Class::Manual::Component>.
768 =head3 Changing one field whenever another changes
770 For example, say that you have three columns, C<id>, C<number>, and
771 C<squared>. You would like to make changes to C<number> and have
772 C<squared> be automagically set to the value of C<number> squared.
773 You can accomplish this by overriding C<store_column>:
776 my ( $self, $name, $value ) = @_;
777 if ($name eq 'number') {
778 $self->squared($value * $value);
780 $self->next::method($name, $value);
783 Note that the hard work is done by the call to C<next::method>, which
784 redispatches your call to store_column in the superclass(es).
786 =head3 Automatically creating related objects
788 You might have a class C<Artist> which has many C<CD>s. Further, if you
789 want to create a C<CD> object every time you insert an C<Artist> object.
790 You can accomplish this by overriding C<insert> on your objects:
793 my ( $self, @args ) = @_;
794 $self->next::method(@args);
795 $self->cds->new({})->fill_from_artist($self)->insert;
799 where C<fill_from_artist> is a method you specify in C<CD> which sets
800 values in C<CD> based on the data in the C<Artist> object you pass in.
802 =head2 Debugging DBIx::Class objects with Data::Dumper
804 L<Data::Dumper> can be a very useful tool for debugging, but sometimes it can
805 be hard to find the pertinent data in all the data it can generate.
806 Specifically, if one naively tries to use it like so,
810 my $cd = $schema->resultset('CD')->find(1);
813 several pages worth of data from the CD object's schema and result source will
814 be dumped to the screen. Since usually one is only interested in a few column
815 values of the object, this is not very helpful.
817 Luckily, it is possible to modify the data before L<Data::Dumper> outputs
818 it. Simply define a hook that L<Data::Dumper> will call on the object before
819 dumping it. For example,
826 result_source => undef,
834 local $Data::Dumper::Freezer = '_dumper_hook';
836 my $cd = $schema->resultset('CD')->find(1);
838 # dumps $cd without its ResultSource
840 If the structure of your schema is such that there is a common base class for
841 all your table classes, simply put a method similar to C<_dumper_hook> in the
842 base class and set C<$Data::Dumper::Freezer> to its name and L<Data::Dumper>
843 will automagically clean up your data before printing it. See
844 L<Data::Dumper/EXAMPLES> for more information.
846 =head2 Retrieving a row object's Schema
848 It is possible to get a Schema object from a row object like so:
850 my $schema = $cd->result_source->schema;
851 # use the schema as normal:
852 my $artist_rs = $schema->resultset('Artist');
854 This can be useful when you don't want to pass around a Schema object to every
859 When you enable L<DBIx::Class::Storage::DBI>'s debugging it prints the SQL
860 executed as well as notifications of query completion and transaction
861 begin/commit. If you'd like to profile the SQL you can subclass the
862 L<DBIx::Class::Storage::Statistics> class and write your own profiling
865 package My::Profiler;
868 use base 'DBIx::Class::Storage::Statistics';
870 use Time::HiRes qw(time);
879 print "Executing $sql: ".join(', ', @params)."\n";
888 printf("Execution took %0.4f seconds.\n", time() - $start);
894 You can then install that class as the debugging object:
896 __PACKAGE__->storage()->debugobj(new My::Profiler());
897 __PACKAGE__->storage()->debug(1);
899 A more complicated example might involve storing each execution of SQL in an
907 my $elapsed = time() - $start;
908 push(@{ $calls{$sql} }, {
914 You could then create average, high and low execution times for an SQL
915 statement and dig down to see if certain parameters cause aberrant behavior.
917 =head2 Getting the value of the primary key for the last database insert
919 AKA getting last_insert_id
921 If you are using PK::Auto, this is straightforward:
923 my $foo = $rs->create(\%blah);
925 my $id = $foo->id; # foo->my_primary_key_field will also work.
927 If you are not using autoincrementing primary keys, this will probably
928 not work, but then you already know the value of the last primary key anyway.
930 =head2 Dynamic Sub-classing DBIx::Class proxy classes
931 (AKA multi-class object inflation from one table)
933 L<DBIx::Class> classes are proxy classes, therefore some different
934 techniques need to be employed for more than basic subclassing. In
935 this example we have a single user table that carries a boolean bit
936 for admin. We would like like to give the admin users
937 objects(L<DBIx::Class::Row>) the same methods as a regular user but
938 also special admin only methods. It doesn't make sense to create two
939 seperate proxy-class files for this. We would be copying all the user
940 methods into the Admin class. There is a cleaner way to accomplish
943 Overriding the C<inflate_results()> method within the User proxy-class
944 gives us the effect we want. This method is called by
945 L<DBIx::Class::ResultSet> when inflating a result from storage. So we
946 grab the object being returned, inspect the values we are looking for,
947 bless it if it's an admin object, and then return it. See the example
954 use base qw/DBIx::Class::Schema/;
956 __PACKAGE__->load_classes(qw/User/);
959 B<Proxy-Class definitions>
961 package DB::Schema::User;
965 use base qw/DBIx::Class/;
967 ### Defined what our admin class is for ensure_class_loaded
968 my $admin_class = __PACKAGE__ . '::Admin';
970 __PACKAGE__->load_components(qw/Core/);
972 __PACKAGE__->table('users');
974 __PACKAGE__->add_columns(qw/user_id email password
975 firstname lastname active
978 __PACKAGE__->set_primary_key('user_id');
982 my $ret = $self->next::method(@_);
983 if( $ret->admin ) {### If this is an admin rebless for extra functions
984 $self->ensure_class_loaded( $admin_class );
985 bless $ret, $admin_class;
991 print "I am a regular user.\n";
996 package DB::Schema::User::Admin;
1000 use base qw/DB::Schema::User/;
1004 print "I am an admin.\n";
1010 print "I am doing admin stuff\n";
1014 B<Test File> test.pl
1020 my $user_data = { email => 'someguy@place.com',
1021 password => 'pass1',
1024 my $admin_data = { email => 'someadmin@adminplace.com',
1025 password => 'pass2',
1028 my $schema = DB::Schema->connection('dbi:Pg:dbname=test');
1030 $schema->resultset('User')->create( $user_data );
1031 $schema->resultset('User')->create( $admin_data );
1033 ### Now we search for them
1034 my $user = $schema->resultset('User')->single( $user_data );
1035 my $admin = $schema->resultset('User')->single( $admin_data );
1037 print ref $user, "\n";
1038 print ref $admin, "\n";
1040 print $user->password , "\n"; # pass1
1041 print $admin->password , "\n";# pass2; inherited from User
1042 print $user->hello , "\n";# I am a regular user.
1043 print $admin->hello, "\n";# I am an admin.
1045 ### The statement below will NOT print
1046 print "I can do admin stuff\n" if $user->can('do_admin_stuff');
1047 ### The statement below will print
1048 print "I can do admin stuff\n" if $admin->can('do_admin_stuff');