1# $Id$ 2 3package Data::ObjectDriver; 4use strict; 5use warnings; 6use 5.006_001; 7use Class::Accessor::Fast; 8 9use base qw( Class::Accessor::Fast ); 10use Data::ObjectDriver::Iterator; 11 12__PACKAGE__->mk_accessors(qw( pk_generator txn_active )); 13 14our $VERSION = '0.21'; 15our $DEBUG = $ENV{DOD_DEBUG} || 0; 16our $PROFILE = $ENV{DOD_PROFILE} || 0; 17our $PROFILER; 18our $LOGGER; 19 20sub new { 21 my $class = shift; 22 my $driver = bless {}, $class; 23 $driver->init(@_); 24 $driver; 25} 26 27sub logger { 28 my $class = shift; 29 if ( @_ ) { 30 return $LOGGER = shift; 31 } else { 32 return $LOGGER ||= sub { 33 print STDERR @_; 34 }; 35 } 36} 37 38sub init { 39 my $driver = shift; 40 my %param = @_; 41 $driver->pk_generator($param{pk_generator}); 42 $driver->txn_active(0); 43 $driver; 44} 45 46# Alias record_query to start_query 47*record_query = \*start_query; 48 49sub start_query { 50 my $driver = shift; 51 my($sql, $bind) = @_; 52 53 $driver->debug($sql, $bind) if $DEBUG; 54 $driver->profiler($sql) if $PROFILE; 55 56 return; 57} 58 59sub end_query { } 60 61sub begin_work { 62 my $driver = shift; 63 $driver->txn_active(1); 64 $driver->debug(sprintf("%14s", "BEGIN_WORK") . ": driver=$driver"); 65} 66 67sub commit { 68 my $driver = shift; 69 _end_txn($driver, 'commit'); 70} 71 72sub rollback { 73 my $driver = shift; 74 _end_txn($driver, 'rollback'); 75} 76 77sub _end_txn { 78 my $driver = shift; 79 my $method = shift; 80 $driver->txn_active(0); 81 $driver->debug(sprintf("%14s", uc($method)) . ": driver=$driver"); 82} 83 84sub debug { 85 my $driver = shift; 86 return unless $DEBUG; 87 88 my $class = ref $driver || $driver; 89 my @caller; 90 my $i = 0; 91 while (1) { 92 @caller = caller($i++); 93 last if $caller[0] !~ /^(Data::ObjectDriver|$class)/; 94 } 95 96 my $where = " in file $caller[1] line $caller[2]\n"; 97 98 if (@_ == 1 && !ref($_[0])) { 99 $driver->logger->( @_, $where ); 100 } else { 101 require Data::Dumper; 102 local $Data::Dumper::Indent = 1; 103 $driver->logger->( Data::Dumper::Dumper(@_), $where ); 104 } 105} 106 107sub profiler { 108 my $driver = shift; 109 my ($sql) = @_; 110 local $@; 111 $PROFILER ||= eval { 112 require Data::ObjectDriver::Profiler; 113 Data::ObjectDriver::Profiler->new; 114 }; 115 return $PROFILE = 0 if $@ || !$PROFILER; 116 return $PROFILER unless @_; 117 $PROFILER->record_query($driver, $sql); 118} 119 120sub list_or_iterator { 121 my $driver = shift; 122 my($objs) = @_; 123 124 ## Emulate the standard search behavior of returning an 125 ## iterator in scalar context, and the full list in list context. 126 if (wantarray) { 127 return @{$objs}; 128 } else { 129 my $iter = sub { shift @{$objs} }; 130 return Data::ObjectDriver::Iterator->new($iter); 131 } 132} 133 134sub cache_object { } 135sub uncache_object { } 136 1371; 138__END__ 139 140=head1 NAME 141 142Data::ObjectDriver - Simple, transparent data interface, with caching 143 144=head1 SYNOPSIS 145 146 ## Set up your database driver code. 147 package FoodDriver; 148 sub driver { 149 Data::ObjectDriver::Driver::DBI->new( 150 dsn => 'dbi:mysql:dbname', 151 username => 'username', 152 password => 'password', 153 ) 154 } 155 156 ## Set up the classes for your recipe and ingredient objects. 157 package Recipe; 158 use base qw( Data::ObjectDriver::BaseObject ); 159 __PACKAGE__->install_properties({ 160 columns => [ 'recipe_id', 'title' ], 161 datasource => 'recipe', 162 primary_key => 'recipe_id', 163 driver => FoodDriver->driver, 164 }); 165 166 package Ingredient; 167 use base qw( Data::ObjectDriver::BaseObject ); 168 __PACKAGE__->install_properties({ 169 columns => [ 'ingredient_id', 'recipe_id', 'name', 'quantity' ], 170 datasource => 'ingredient', 171 primary_key => [ 'recipe_id', 'ingredient_id' ], 172 driver => FoodDriver->driver, 173 }); 174 175 ## And now, use them! 176 my $recipe = Recipe->new; 177 $recipe->title('Banana Milkshake'); 178 $recipe->save; 179 180 my $ingredient = Ingredient->new; 181 $ingredient->recipe_id($recipe->id); 182 $ingredient->name('Bananas'); 183 $ingredient->quantity(5); 184 $ingredient->save; 185 186 ## Needs more bananas! 187 $ingredient->quantity(10); 188 $ingredient->save; 189 190 ## Shorthand constructor 191 my $ingredient = Ingredient->new(recipe_id=> $recipe->id, 192 name => 'Milk', 193 quantity => 2); 194 195=head1 DESCRIPTION 196 197I<Data::ObjectDriver> is an object relational mapper, meaning that it maps 198object-oriented design concepts onto a relational database. 199 200It's inspired by, and descended from, the I<MT::ObjectDriver> classes in 201Six Apart's Movable Type and TypePad weblogging products. But it adds in 202caching and partitioning layers, allowing you to spread data across multiple 203physical databases, without your application code needing to know where the 204data is stored. 205 206=head1 METHODOLOGY 207 208I<Data::ObjectDriver> provides you with a framework for building 209database-backed applications. It provides built-in support for object 210caching and database partitioning, and uses a layered approach to allow 211building very sophisticated database interfaces without a lot of code. 212 213You can build a driver that uses any number of caching layers, plus a 214partitioning layer, then a final layer that actually knows how to load 215data from a backend datastore. 216 217For example, the following code: 218 219 my $driver = Data::ObjectDriver::Driver::Cache::Memcached->new( 220 cache => Cache::Memcached->new( 221 servers => [ '127.0.0.1:11211' ], 222 ), 223 fallback => Data::ObjectDriver::Driver::Partition->new( 224 get_driver => \&get_driver, 225 ), 226 ); 227 228creates a new driver that supports both caching (using memcached) and 229partitioning. 230 231It's useful to demonstrate the flow of a sample request through this 232driver framework. The following code: 233 234 my $ingredient = Ingredient->lookup([ $recipe->recipe_id, 1 ]); 235 236would take the following path through the I<Data::ObjectDriver> framework: 237 238=over 4 239 240=item 1. 241 242The caching layer would look up the object with the given primary key in all 243of the specified memcached servers. 244 245If the object was found in the cache, it would be returned immediately. 246 247If the object was not found in the cache, the caching layer would fall back 248to the driver listed in the I<fallback> setting: the partitioning layer. 249 250=item 2. 251 252The partitioning layer does not know how to look up objects by itself--all 253it knows how to do is to give back a driver that I<does> know how to look 254up objects in a backend datastore. 255 256In our example above, imagine that we're partitioning our ingredient data 257based on the recipe that the ingredient is found in. For example, all of 258the ingredients for a "Banana Milkshake" would be found in one partition; 259all of the ingredients for a "Chocolate Sundae" might be found in another 260partition. 261 262So the partitioning layer needs to tell us which partition to look in to 263load the ingredients for I<$recipe-E<gt>recipe_id>. If we store a 264I<partition_id> column along with each I<$recipe> object, that information 265can be loaded very easily, and the partitioning layer will then 266instantiate a I<DBI> driver that knows how to load an ingredient from 267that recipe. 268 269=item 3. 270 271Using the I<DBI> driver that the partitioning layer created, 272I<Data::ObjectDriver> can look up the ingredient with the specified primary 273key. It will return that key back up the chain, giving each layer a chance 274to do something with it. 275 276=item 4. 277 278The caching layer, when it receives the object loaded in Step 3, will 279store the object in memcached. 280 281=item 5. 282 283The object will be passed back to the caller. Subsequent lookups of that 284same object will come from the cache. 285 286=back 287 288=head1 HOW IS IT DIFFERENT? 289 290I<Data::ObjectDriver> differs from other similar frameworks 291(e.g. L<Class::DBI>) in a couple of ways: 292 293=over 4 294 295=item * It has built-in support for caching. 296 297=item * It has built-in support for data partitioning. 298 299=item * Drivers are attached to classes, not to the application as a whole. 300 301This is essential for partitioning, because your partition drivers need 302to know how to load a specific class of data. 303 304But it can also be useful for caching, because you may find that it doesn't 305make sense to cache certain classes of data that change constantly. 306 307=item * The driver class != the base object class. 308 309All of the object classes you declare will descend from 310I<Data::ObjectDriver::BaseObject>, and all of the drivers you instantiate 311or subclass will descend from I<Data::ObjectDriver> itself. 312 313This provides a useful distinction between your data/classes, and the 314drivers that describe how to B<act> on that data, meaning that an 315object based on I<Data::ObjectDriver::BaseObject> is not tied to any 316particular type of driver. 317 318=back 319 320=head1 USAGE 321 322=head2 Class->lookup($id) 323 324Looks up/retrieves a single object with the primary key I<$id>, and returns 325the object. 326 327I<$id> can be either a scalar or a reference to an array, in the case of 328a class with a multiple column primary key. 329 330=head2 Class->lookup_multi(\@ids) 331 332Looks up/retrieves multiple objects with the IDs I<\@ids>, which should be 333a reference to an array of IDs. As in the case of I<lookup>, an ID can 334be either a scalar or a reference to an array. 335 336Returns a reference to an array of objects B<in the same order> as the IDs 337you passed in. Any objects that could not successfully be loaded will be 338represented in that array as an C<undef> element. 339 340So, for example, if you wanted to load 2 objects with the primary keys 341C<[ 5, 3 ]> and C<[ 4, 2 ]>, you'd call I<lookup_multi> like this: 342 343 Class->lookup_multi([ 344 [ 5, 3 ], 345 [ 4, 2 ], 346 ]); 347 348And if the first object in that list could not be loaded successfully, 349you'd get back a reference to an array like this: 350 351 [ 352 undef, 353 $object 354 ] 355 356where I<$object> is an instance of I<Class>. 357 358=head2 Class->search(\%terms [, \%options ]) 359 360Searches for objects matching the terms I<%terms>. In list context, returns 361an array of matching objects; in scalar context, returns a reference to 362a subroutine that acts as an iterator object, like so: 363 364 my $iter = Ingredient->search({ recipe_id => 5 }); 365 while (my $ingredient = $iter->()) { 366 ... 367 } 368 369C<$iter> is blessed in L<Data::ObjectDriver::Iterator> package, so the above 370could also be written: 371 372 my $iter = Ingredient->search({ recipe_id => 5 }); 373 while (my $ingredient = $iter->next()) { 374 ... 375 } 376 377The keys in I<%terms> should be column names for the database table 378modeled by I<Class> (and the values should be the desired values for those 379columns). 380 381I<%options> can contain: 382 383=over 4 384 385=item * sort 386 387The name of a column to use to sort the result set. 388 389Optional. 390 391=item * direction 392 393The direction in which you want to sort the result set. Must be either 394C<ascend> or C<descend>. 395 396Optional. 397 398=item * limit 399 400The value for a I<LIMIT> clause, to limit the size of the result set. 401 402Optional. 403 404=item * offset 405 406The offset to start at when limiting the result set. 407 408Optional. 409 410=item * fetchonly 411 412A reference to an array of column names to fetch in the I<SELECT> statement. 413 414Optional; the default is to fetch the values of all of the columns. 415 416=item * for_update 417 418If set to a true value, the I<SELECT> statement generated will include a 419I<FOR UPDATE> clause. 420 421=item * comment 422 423A sql comment to watermark the SQL query. 424 425=item * window_size 426 427Used when requesting an iterator for the search method and selecting 428a large result set or a result set of unknown size. In such a case, 429no LIMIT clause is assigned, which can load all available objects into 430memory. Specifying C<window_size> will load objects in manageable chunks. 431This will also cause any caching driver to be bypassed for issuing 432the search itself. Objects are still placed into the cache upon load. 433 434This attribute is ignored when the search method is invoked in an array 435context, or if a C<limit> attribute is also specified that is smaller than 436the C<window_size>. 437 438=back 439 440=head2 Class->search(\@terms [, \%options ]) 441 442This is an alternative calling signature for the search method documented 443above. When providing an array of terms, it allows for constructing complex 444expressions that mix 'and' and 'or' clauses. For example: 445 446 my $iter = Ingredient->search([ { recipe_id => 5 }, 447 -or => { calories => { value => 300, op => '<' } } ]); 448 while (my $ingredient = $iter->()) { 449 ... 450 } 451 452Supported logic operators are: '-and', '-or', '-and_not', '-or_not'. 453 454=head2 Class->add_trigger($trigger, \&callback) 455 456Adds a trigger to all objects of class I<Class>, such that when the event 457I<$trigger> occurs to any of the objects, subroutine C<&callback> is run. Note 458that triggers will not occur for instances of I<subclasses> of I<Class>, only 459of I<Class> itself. See TRIGGERS for the available triggers. 460 461=head2 Class->call_trigger($trigger, [@callback_params]) 462 463Invokes the triggers watching class I<Class>. The parameters to send to the 464callbacks (in addition to I<Class>) are specified in I<@callback_params>. See 465TRIGGERS for the available triggers. 466 467=head2 $obj->save 468 469Saves the object I<$obj> to the database. 470 471If the object is not yet in the database, I<save> will automatically 472generate a primary key and insert the record into the database table. 473Otherwise, it will update the existing record. 474 475If an error occurs, I<save> will I<croak>. 476 477Internally, I<save> calls I<update> for records that already exist in the 478database, and I<insert> for those that don't. 479 480=head2 $obj->remove 481 482Removes the object I<$obj> from the database. 483 484If an error occurs, I<remove> will I<croak>. 485 486=head2 Class->remove(\%terms, \%args) 487 488Removes objects found with the I<%terms>. So it's a shortcut of: 489 490 my @obj = Class->search(\%terms, \%args); 491 for my $obj (@obj) { 492 $obj->remove; 493 } 494 495However, when you pass C<nofetch> option set to C<%args>, it won't 496create objects with C<search>, but issues I<DELETE> SQL directly to 497the database. 498 499 ## issues "DELETE FROM tbl WHERE user_id = 2" 500 Class->remove({ user_id => 2 }, { nofetch => 1 }); 501 502This might be much faster and useful for tables without Primary Key, 503but beware that in this case B<Triggers won't be fired> because no 504objects are instantiated. 505 506=head2 Class->bulk_insert([col1, col2], [[d1,d2], [d1,d2]]); 507 508Bulk inserts data into the underlying table. The first argument 509is an array reference of columns names as specified in install_properties 510 511=head2 $obj->add_trigger($trigger, \&callback) 512 513Adds a trigger to the object I<$obj>, such that when the event I<$trigger> 514occurs to the object, subroutine C<&callback> is run. See TRIGGERS for the 515available triggers. Triggers are invoked in the order in which they are added. 516 517=head2 $obj->call_trigger($trigger, [@callback_params]) 518 519Invokes the triggers watching all objects of I<$obj>'s class and the object 520I<$obj> specifically for trigger event I<$trigger>. The additional parameters 521besides I<$obj>, if any, are passed as I<@callback_params>. See TRIGGERS for 522the available triggers. 523 524=head1 TRIGGERS 525 526I<Data::ObjectDriver> provides a trigger mechanism by which callbacks can be 527called at certain points in the life cycle of an object. These can be set on a 528class as a whole or individual objects (see USAGE). 529 530Triggers can be added and called for these events: 531 532=over 4 533 534=item * pre_save -> ($obj, $orig_obj) 535 536Callbacks on the I<pre_save> trigger are called when the object is about to be 537saved to the database. For example, use this callback to translate special code 538strings into numbers for storage in an integer column in the database. Note that this hook is also called when you C<remove> the object. 539 540Modifications to I<$obj> will affect the values passed to subsequent triggers 541and saved in the database, but not the original object on which the I<save> 542method was invoked. 543 544=item * post_save -> ($obj, $orig_obj) 545 546Callbaks on the I<post_save> triggers are called after the object is 547saved to the database. Use this trigger when your hook needs primary 548key which is automatically assigned (like auto_increment and 549sequence). Note that this hooks is B<NOT> called when you remove the 550object. 551 552=item * pre_insert/post_insert/pre_update/post_update/pre_remove/post_remove -> ($obj, $orig_obj) 553 554Those triggers are fired before and after $obj is created, updated and 555deleted. 556 557=item * post_load -> ($obj) 558 559Callbacks on the I<post_load> trigger are called when an object is being 560created from a database query, such as with the I<lookup> and I<search> class 561methods. For example, use this callback to translate the numbers your 562I<pre_save> callback caused to be saved I<back> into string codes. 563 564Modifications to I<$obj> will affect the object passed to subsequent triggers 565and returned from the loading method. 566 567Note I<pre_load> should only be used as a trigger on a class, as the object to 568which the load is occurring was not previously available for triggers to be 569added. 570 571=item * pre_search -> ($class, $terms, $args) 572 573Callbacks on the I<pre_search> trigger are called when a content addressed 574query for objects of class I<$class> is performed with the I<search> method. 575For example, use this callback to translate the entry in I<$terms> for your 576code string field to its appropriate integer value. 577 578Modifications to I<$terms> and I<$args> will affect the parameters to 579subsequent triggers and what objects are loaded, but not the original hash 580references used in the I<search> query. 581 582Note I<pre_search> should only be used as a trigger on a class, as I<search> is 583never invoked on specific objects. 584 585=over 586 587The return values from your callbacks are ignored. 588 589Note that the invocation of callbacks is the responsibility of the object 590driver. If you implement a driver that does not delegate to 591I<Data::ObjectDriver::Driver::DBI>, it is I<your> responsibility to invoke the 592appropriate callbacks with the I<call_trigger> method. 593 594=back 595 596=back 597 598=head1 PROFILING 599 600For performance tuning, you can turn on query profiling by setting 601I<$Data::ObjectDriver::PROFILE> to a true value. Or, alternatively, you can 602set the I<DOD_PROFILE> environment variable to a true value before starting 603your application. 604 605To obtain the profile statistics, get the global 606I<Data::ObjectDriver::Profiler> instance: 607 608 my $profiler = Data::ObjectDriver->profiler; 609 610Then see the documentation for I<Data::ObjectDriver::Profiler> to see the 611methods on that class. 612 613In some applications there are phases of execution in which no I/O 614operations should occur, but sometimes it's difficult to tell when, 615where, or if those I/O operations are happening. One approach to 616surfacing these situations is to set, either globally or locally, 617the $Data::ObjectDriver::RESTRICT_IO flag. If set, this will tell 618Data::ObjectDriver to die with some context rather than executing 619network calls for data. 620 621 622=head1 TRANSACTIONS 623 624 625Transactions are supported by Data::ObjectDriver's default drivers. So each 626Driver is capable to deal with transactional state independently. Additionally 627<Data::ObjectDriver::BaseObject> class know how to turn transactions switch on 628for all objects. 629 630In the case of a global transaction all drivers used during this time are put 631in a transactional state until the end of the transaction. 632 633=head2 Example 634 635 ## start a transaction 636 Data::ObjectDriver::BaseObject->begin_work; 637 638 $recipe = Recipe->new; 639 $recipe->title('lasagnes'); 640 $recipe->save; 641 642 my $ingredient = Ingredient->new; 643 $ingredient->recipe_id($recipe->recipe_id); 644 $ingredient->name("more layers"); 645 $ingredient->insert; 646 $ingredient->remove; 647 648 if ($you_are_sure) { 649 Data::ObjectDriver::BaseObject->commit; 650 } 651 else { 652 ## erase all trace of the above 653 Data::ObjectDriver::BaseObject->rollback; 654 } 655 656=head2 Driver implementation 657 658Drivers have to implement the following methods: 659 660=over 4 661 662=item * begin_work to initialize a transaction 663 664=item * rollback 665 666=item * commit 667 668=back 669 670=head2 Nested transactions 671 672Are not supported and will result in warnings and the inner transactions 673to be ignored. Be sure to B<end> each transaction and not to let et long 674running transaction open (i.e you should execute a rollback or commit for 675each open begin_work). 676 677=head2 Transactions and DBI 678 679In order to make transactions work properly you have to make sure that 680the C<$dbh> for each DBI drivers are shared among drivers using the same 681database (basically dsn). 682 683One way of doing that is to define a get_dbh() subref in each DBI driver 684to return the same dbh if the dsn and attributes of the connection are 685identical. 686 687The other way is to use the new configuration flag on the DBI driver that 688has been added specifically for this purpose: C<reuse_dbh>. 689 690 ## example coming from the test suite 691 __PACKAGE__->install_properties({ 692 columns => [ 'recipe_id', 'partition_id', 'title' ], 693 datasource => 'recipes', 694 primary_key => 'recipe_id', 695 driver => Data::ObjectDriver::Driver::Cache::Cache->new( 696 cache => Cache::Memory->new, 697 fallback => Data::ObjectDriver::Driver::DBI->new( 698 dsn => 'dbi:SQLite:dbname=global.db', 699 reuse_dbh => 1, ## be sure that the corresponding dbh is shared 700 ), 701 ), 702 }); 703 704=head1 EXAMPLES 705 706=head2 A Partitioned, Caching Driver 707 708 package Ingredient; 709 use strict; 710 use base qw( Data::ObjectDriver::BaseObject ); 711 712 use Data::ObjectDriver::Driver::DBI; 713 use Data::ObjectDriver::Driver::Partition; 714 use Data::ObjectDriver::Driver::Cache::Cache; 715 use Cache::Memory; 716 use Carp; 717 718 our $IDs; 719 720 __PACKAGE__->install_properties({ 721 columns => [ 'ingredient_id', 'recipe_id', 'name', 'quantity', ], 722 datasource => 'ingredients', 723 primary_key => [ 'recipe_id', 'ingredient_id' ], 724 driver => 725 Data::ObjectDriver::Driver::Cache::Cache->new( 726 cache => Cache::Memory->new( namespace => __PACKAGE__ ), 727 fallback => 728 Data::ObjectDriver::Driver::Partition->new( 729 get_driver => \&get_driver, 730 pk_generator => \&generate_pk, 731 ), 732 ), 733 }); 734 735 sub get_driver { 736 my($terms) = @_; 737 my $recipe; 738 if (ref $terms eq 'HASH') { 739 my $recipe_id = $terms->{recipe_id} 740 or Carp::croak("recipe_id is required"); 741 $recipe = Recipe->lookup($recipe_id); 742 } elsif (ref $terms eq 'ARRAY') { 743 $recipe = Recipe->lookup($terms->[0]); 744 } 745 Carp::croak("Unknown recipe") unless $recipe; 746 Data::ObjectDriver::Driver::DBI->new( 747 dsn => 'dbi:mysql:database=cluster' . $recipe->cluster_id, 748 username => 'foo', 749 pk_generator => \&generate_pk, 750 ); 751 } 752 753 sub generate_pk { 754 my($obj) = @_; 755 $obj->ingredient_id(++$IDs{$obj->recipe_id}); 756 1; 757 } 758 759 1; 760 761=head1 FORK SAFETY 762 763As of version 0.21, I<Data::ObjectDriver> resets internal database handles 764after I<fork(2)> is called, but only if L<POSIX::AtFork> module is installed. 765Otherwise, I<Data::ObjectDriver> is not fork-safe. 766 767=head1 SUPPORTED DATABASES 768 769I<Data::ObjectDriver> is very modular and it's not very difficult to add new drivers. 770 771=over 4 772 773=item * MySQL is well supported and has been heavily tested. 774 775=item * PostgreSQL has been used in production and should just work, too. 776 777=item * SQLite is supported, but YMMV depending on the version. This is the 778backend used for the test suite. 779 780=item * Oracle support has been added in 0.06 781 782=back 783 784=head1 LICENSE 785 786I<Data::ObjectDriver> is free software; you may redistribute it and/or modify 787it under the same terms as Perl itself. 788 789=head1 AUTHOR & COPYRIGHT 790 791Except where otherwise noted, I<Data::ObjectDriver> is Copyright 2005-2006 792Six Apart, cpan@sixapart.com. All rights reserved. 793 794=cut 795