1package Ima::DBI; 2 3$VERSION = '0.35'; 4 5use strict; 6use base 'Class::Data::Inheritable'; 7use DBI; 8 9# Some class data to store a per-class list of handles. 10Ima::DBI->mk_classdata('__Database_Names'); 11Ima::DBI->mk_classdata('__Statement_Names'); 12 13=head1 NAME 14 15Ima::DBI - Database connection caching and organization 16 17=head1 SYNOPSIS 18 19 package Foo; 20 use base 'Ima::DBI'; 21 22 # Class-wide methods. 23 Foo->set_db($db_name, $data_source, $user, $password); 24 Foo->set_db($db_name, $data_source, $user, $password, \%attr); 25 26 my @database_names = Foo->db_names; 27 my @database_handles = Foo->db_handles; 28 29 Foo->set_sql($sql_name, $statement, $db_name); 30 Foo->set_sql($sql_name, $statement, $db_name, $cache); 31 32 my @statement_names = Foo->sql_names; 33 34 # Object methods. 35 $dbh = $obj->db_*; # Where * is the name of the db connection. 36 $sth = $obj->sql_*; # Where * is the name of the sql statement. 37 $sth = $obj->sql_*(@sql_pieces); 38 39 $obj->DBIwarn($what, $doing); 40 41 my $rc = $obj->commit; 42 my $rc = $obj->commit(@db_names); 43 44 my $rc = $obj->rollback; 45 my $rc = $obj->rollback(@db_names); 46 47 48=head1 DESCRIPTION 49 50Ima::DBI attempts to organize and facilitate caching and more efficient 51use of database connections and statement handles by storing DBI and 52SQL information with your class (instead of as seperate objects). 53This allows you to pass around just one object without worrying about 54a trail of DBI handles behind it. 55 56One of the things I always found annoying about writing large programs 57with DBI was making sure that I didn't have duplicate database handles 58open. I was also annoyed by the somewhat wasteful nature of the 59prepare/execute/finish route I'd tend to go through in my subroutines. 60The new DBI->connect_cached and DBI->prepare_cached helped a lot, but 61I still had to throw around global datasource, username and password 62information. 63 64So, after a while I grew a small library of DBI helper routines and 65techniques. Ima::DBI is the culmination of all this, put into a nice(?), 66clean(?) class to be inherited from. 67 68=head2 Why should I use this thing? 69 70Ima::DBI is a little odd, and it's kinda hard to explain. So lemme 71explain why you'd want to use this thing... 72 73=over 4 74 75=item * Consolidation of all SQL statements and database information 76 77No matter what, embedding one language into another is messy. 78DBI alleviates this somewhat, but I've found a tendency to have that 79scatter the SQL around inside the Perl code. Ima::DBI allows you to 80easily group the SQL statements in one place where they are easier to 81maintain (especially if one developer is writing the SQL, another writing 82the Perl). Alternatively, you can place your SQL statement alongside 83the code which uses it. Whatever floats your boat. 84 85Database connection information (data source, username, password, 86atrributes, etc...) can also be consolidated together and tracked. 87 88Both the SQL and the connection info are probably going to change a lot, 89so having them well organized and easy to find in the code is a Big Help. 90 91=item * Holds off opening a database connection until necessary. 92 93While Ima::DBI is informed of all your database connections and SQL 94statements at compile-time, it will not connect to the database until 95you actually prepare a statement on that connection. 96 97This is obviously very good for programs that sometimes never touch 98the database. It's also good for code that has lots of possible 99connections and statements, but which typically only use a few. 100Kinda like an autoloader. 101 102=item * Easy integration of the DBI handles into your class 103 104Ima::DBI causes each database handle to be associated with your class, 105allowing you to pull handles from an instance of your object, as well 106as making many oft-used DBI methods available directly from your 107instance. 108 109This gives you a cleaner OO design, since you can now just throw 110around the object as usual and it will carry its associated DBI 111baggage with it. 112 113=item * Honors taint mode 114 115It always struck me as a design deficiency that tainted SQL statements 116could be passed to $sth->prepare(). For example: 117 118 # $user is from an untrusted source and is tainted. 119 $user = get_user_data_from_the_outside_world; 120 $sth = $dbh->prepare('DELETE FROM Users WHERE User = $user'); 121 122Looks innocent enough... but what if $user was the string "1 OR User LIKE 123'%'". You just blew away all your users. Hope you have backups. 124 125Ima::DBI turns on the DBI->connect Taint attribute so that all DBI 126methods (except execute()) will no longer accept tainted data. 127See L<DBI/Taint> for details. 128 129=item * Taints returned data 130 131Databases should be like any other system call. It's the scary Outside 132World, thus it should be tainted. Simple. Ima::DBI turns on DBI's Taint 133attribute on each connection. This feature is overridable by passing 134your own Taint attribute to set_db as normal for DBI. See L<DBI/Taint> 135for details. 136 137=item * Encapsulation of some of the more repetitive bits of everyday DBI usage 138 139I get lazy a lot and I forget to do things I really should, like using 140bind_cols(), or rigorous error checking. Ima::DBI does some of this 141stuff automatically, other times it just makes it more convenient. 142 143=item * Encapsulation of DBI's cache system 144 145DBI's automatic handle caching system is relatively new, and some people 146aren't aware of its use. Ima::DBI uses it automatically, so you don't 147have to worry about it. (It even makes it a bit more efficient) 148 149=item * Sharing of database and sql information amongst inherited classes 150 151Any SQL statements and connections created by a class are available to 152its children via normal method inheritance. 153 154=item * Guarantees one connection per program. 155 156One program, one database connection (per database user). One program, 157one prepared statement handle (per statement, per database user). 158That's what Ima::DBI enforces. Extremely handy in persistant environments 159(servers, daemons, mod_perl, FastCGI, etc...) 160 161=item * Encourages use of bind parameters and columns 162 163Bind parameters are safer and more efficient than embedding the column 164information straight into the SQL statement. Bind columns are more 165efficient than normal fetching. Ima::DBI pretty much requires the usage 166of the former, and eases the use of the latter. 167 168=back 169 170=head2 Why shouldn't I use this thing. 171 172=over 4 173 174=item * It's all about OO 175 176Although it is possible to use Ima::DBI as a stand-alone module as 177part of a function-oriented design, its generally not to be used 178unless integrated into an object-oriented design. 179 180=item * Overkill for small programs 181 182=item * Overkill for programs with only one or two SQL statements 183 184Its up to you whether the trouble of setting up a class and jumping 185through the necessary Ima::DBI hoops is worth it for small programs. 186To me, it takes just as much time to set up an Ima::DBI subclass as it 187would to access DBI without it... but then again I wrote the module. 188YMMV. 189 190=item * Overkill for programs that only use their SQL statements once 191 192Ima::DBI's caching might prove to be an unecessary performance hog if 193you never use the same SQL statement twice. Not sure, I haven't 194looked into it. 195 196=back 197 198 199=head1 USAGE 200 201The basic steps to "DBIing" a class are: 202 203=over 4 204 205=item 1 206 207Inherit from Ima::DBI 208 209=item 2 210 211Set up and name all your database connections via set_db() 212 213=item 3 214 215Set up and name all your SQL statements via set_sql() 216 217=item 4 218 219Use sql_* to retrieve your statement handles ($sth) as needed and db_* 220to retreive database handles ($dbh). 221 222 223=back 224 225Have a look at L<EXAMPLE> below. 226 227=head1 TAINTING 228 229Ima::DBI, by default, uses DBI's Taint flag on all connections. 230 231This means that Ima::DBI methods do not accept tainted data, and that all 232data fetched from the database will be tainted. This may be different 233from the DBI behavior you're used to. See L<DBI/Taint> for details. 234 235=head1 Class Methods 236 237=head2 set_db 238 239 Foo->set_db($db_name, $data_source, $user, $password); 240 Foo->set_db($db_name, $data_source, $user, $password, \%attr); 241 242This method is used in place of DBI->connect to create your database 243handles. It sets up a new DBI database handle associated to $db_name. 244All other arguments are passed through to DBI->connect_cached. 245 246A new method is created for each db you setup. This new method is called 247"db_$db_name"... so, for example, Foo->set_db("foo", ...) will create 248a method called "db_foo()". (Spaces in $db_name will be translated into 249underscores: '_') 250 251%attr is combined with a set of defaults (RaiseError => 1, AutoCommit 252=> 0, PrintError => 0, Taint => 1). This is a better default IMHO, 253however it does give databases without transactions (such as MySQL when 254used with the default MyISAM table type) a hard time. Be sure to turn 255AutoCommit back on if your database does not support transactions. 256 257The actual database handle creation (and thus the database connection) 258is held off until a prepare is attempted with this handle. 259 260=cut 261 262sub _croak { my $self = shift; require Carp; Carp::croak(@_) } 263 264sub set_db { 265 my $class = shift; 266 my $db_name = shift or $class->_croak("Need a db name"); 267 $db_name =~ s/\s/_/g; 268 269 my $data_source = shift or $class->_croak("Need a data source"); 270 my $user = shift || ""; 271 my $password = shift || ""; 272 my $attr = shift || {}; 273 ref $attr eq 'HASH' or $class->_croak("$attr must be a hash reference"); 274 $attr = $class->_add_default_attributes($attr); 275 276 $class->_remember_handle($db_name); 277 no strict 'refs'; 278 *{ $class . "::db_$db_name" } = 279 $class->_mk_db_closure($data_source, $user, $password, $attr); 280 281 return 1; 282} 283 284sub _add_default_attributes { 285 my ($class, $user_attr) = @_; 286 my %attr = $class->_default_attributes; 287 @attr{ keys %$user_attr } = values %$user_attr; 288 return \%attr; 289} 290 291sub _default_attributes { 292 ( 293 RaiseError => 1, 294 AutoCommit => 0, 295 PrintError => 0, 296 Taint => 1, 297 RootClass => "DBIx::ContextualFetch" 298 ); 299} 300 301sub _remember_handle { 302 my ($class, $db) = @_; 303 my $handles = $class->__Database_Names || []; 304 push @$handles, $db; 305 $class->__Database_Names($handles); 306} 307 308sub _mk_db_closure { 309 my ($class, $dsn, $user, $pass, $attr) = @_; 310 $attr ||= {}; 311 312 my $dbh; 313 my $process_id = $$; 314 return sub { 315 # set the PID in a private cache key to prevent us 316 # from sharing one with the parent after fork. This 317 # is better than disconnecting the existing $dbh since 318 # the parent may still need the connection open. Note 319 # that forking code also needs to set InactiveDestroy 320 # on all open handles in the child or the connection 321 # will be broken during DESTROY. 322 $attr->{private_cache_key_pid} = $$; 323 324 # reopen if this is a new process or if the connection 325 # is bad 326 if ($process_id != $$ or 327 not ($dbh && $dbh->FETCH('Active') && $dbh->ping)) { 328 $dbh = DBI->connect_cached($dsn, $user, $pass, $attr); 329 $process_id = $$; 330 } 331 return $dbh; 332 }; 333 334} 335 336=head2 set_sql 337 338 Foo->set_sql($sql_name, $statement, $db_name); 339 Foo->set_sql($sql_name, $statement, $db_name, $cache); 340 341This method is used in place of DBI->prepare to create your statement 342handles. It sets up a new statement handle associated to $sql_name using 343the database connection associated with $db_name. $statement is passed 344through to either DBI->prepare or DBI->prepare_cached (depending on 345$cache) to create the statement handle. 346 347If $cache is true or isn't given, then prepare_cached() will be used to 348prepare the statement handle and it will be cached. If $cache is false 349then a normal prepare() will be used and the statement handle will be 350recompiled on every sql_*() call. If you have a statement which changes 351a lot or is used very infrequently you might not want it cached. 352 353A new method is created for each statement you set up. This new method 354is "sql_$sql_name"... so, as with set_db(), Foo->set_sql("bar", ..., 355"foo"); will create a method called "sql_bar()" which uses the database 356connection from "db_foo()". Again, spaces in $sql_name will be translated 357into underscores ('_'). 358 359The actual statement handle creation is held off until sql_* is first 360called on this name. 361 362=cut 363 364sub set_sql { 365 my ($class, $sql_name, $statement, $db_name, $cache) = @_; 366 $cache = 1 unless defined $cache; 367 368 # ------------------------- sql_* closure ----------------------- # 369 my $db_meth = $db_name; 370 $db_meth =~ s/\s/_/g; 371 $db_meth = "db_$db_meth"; 372 373 (my $sql_meth = $sql_name) =~ s/\s/_/g; 374 $sql_meth = "sql_$sql_meth"; 375 376 # Remember the name of this handle for the class. 377 my $handles = $class->__Statement_Names || []; 378 push @$handles, $sql_name; 379 $class->__Statement_Names($handles); 380 381 no strict 'refs'; 382 *{ $class . "::$sql_meth" } = 383 $class->_mk_sql_closure($sql_name, $statement, $db_meth, $cache); 384 385 return 1; 386} 387 388sub _mk_sql_closure { 389 my ($class, $sql_name, $statement, $db_meth, $cache) = @_; 390 391 return sub { 392 my $class = shift; 393 my $dbh = $class->$db_meth(); 394 395 # Everything must pass through sprintf, even if @_ is empty. 396 # This is to do proper '%%' translation. 397 my $sql = $class->transform_sql($statement => @_); 398 return $cache 399 ? $dbh->prepare_cached($sql) 400 : $dbh->prepare($sql); 401 }; 402} 403 404=head2 transform_sql 405 406To make up for the limitations of bind parameters, $statement can contain 407sprintf() style formatting (ie. %s and such) to allow dynamically 408generated SQL statements (so to get a real percent sign, use '%%'). 409 410The translation of the SQL happens in transform_sql(), which can be 411overridden to do more complex transformations. See L<Class::DBI> for an 412example. 413 414=cut 415 416sub transform_sql { 417 my ($class, $sql, @args) = @_; 418 return sprintf $sql, @args; 419} 420 421=head2 db_names / db_handles 422 423 my @database_names = Foo->db_names; 424 my @database_handles = Foo->db_handles; 425 my @database_handles = Foo->db_handles(@db_names); 426 427Returns a list of the database handles set up for this class using 428set_db(). This includes all inherited handles. 429 430db_names() simply returns the name of the handle, from which it is 431possible to access it by converting it to a method name and calling 432that db method... 433 434 my @db_names = Foo->db_names; 435 my $db_meth = 'db_'.$db_names[0]; 436 my $dbh = $foo->$db_meth; 437 438Icky, eh? Fortunately, db_handles() does this for you and returns a 439list of database handles in the same order as db_names(). B<Use this 440sparingly> as it will connect you to the database if you weren't 441already connected. 442 443If given @db_names, db_handles() will return only the handles for 444those connections. 445 446These both work as either class or object methods. 447 448=cut 449 450sub db_names { @{ $_[0]->__Database_Names || [] } } 451 452sub db_handles { 453 my ($self, @db_names) = @_; 454 @db_names = $self->db_names unless @db_names; 455 return map $self->$_(), map "db_$_", @db_names; 456} 457 458=head2 sql_names 459 460 my @statement_names = Foo->sql_names; 461 462Similar to db_names() this returns the names of all SQL statements set 463up for this class using set_sql(), inherited or otherwise. 464 465There is no corresponding sql_handles() because we can't know what 466arguments to pass in. 467 468=cut 469 470sub sql_names { @{ $_[0]->__Statement_Names || [] } } 471 472=head1 Object Methods 473 474=head2 db_* 475 476 $dbh = $obj->db_*; 477 478This is how you directly access a database handle you set up with set_db. 479 480The actual particular method name is derived from what you told set_db. 481 482db_* will handle all the issues of making sure you're already 483connected to the database. 484 485=head2 sql_* 486 487 $sth = $obj->sql_*; 488 $sth = $obj->sql_*(@sql_pieces); 489 490sql_*() is a catch-all name for the methods you set up with set_sql(). 491For instance, if you did: 492 493 Foo->set_sql('GetAllFoo', 'Select * From Foo', 'SomeDb'); 494 495you'd run that statement with sql_GetAllFoo(). 496 497sql_* will handle all the issues of making sure the database is 498already connected, and the statement handle is prepared. It returns a 499prepared statement handle for you to use. (You're expected to 500execute() it) 501 502If sql_*() is given a list of @sql_pieces it will use them to fill in 503your statement, assuming you have sprintf() formatting tags in your 504statement. For example: 505 506 Foo->set_sql('GetTable', 'Select * From %s', 'Things'); 507 508 # Assuming we have created an object... this will prepare the 509 # statement 'Select * From Bar' 510 $sth = $obj->sql_Search('Bar'); 511 512Be B<very careful> with what you feed this function. It cannot 513do any quoting or escaping for you, so it is totally up to you 514to take care of that. Fortunately if you have tainting on you 515will be spared the worst. 516 517It is recommended you only use this in cases where bind parameters 518will not work. 519 520=head2 DBIwarn 521 522 $obj->DBIwarn($what, $doing); 523 524Produces a useful error for exceptions with DBI. 525 526B<I'm not particularly happy with this interface> 527 528Most useful like this: 529 530 eval { 531 $self->sql_Something->execute($self->{ID}, @stuff); 532 }; 533 if($@) { 534 $self->DBIwarn($self->{ID}, 'Something'); 535 return; 536 } 537 538 539=cut 540 541sub DBIwarn { 542 my ($self, $thing, $doing) = @_; 543 my $errstr = "Failure while doing '$doing' with '$thing'\n"; 544 $errstr .= $@ if $@; 545 546 require Carp; 547 Carp::carp $errstr; 548 549 return 1; 550} 551 552=head1 Modified database handle methods 553 554Ima::DBI makes some of the methods available to your object that are 555normally only available via the database handle. In addition, it 556spices up the API a bit. 557 558=head2 commit 559 560 $rc = $obj->commit; 561 $rc = $obj->commit(@db_names); 562 563Derived from $dbh->commit() and basically does the same thing. 564 565If called with no arguments, it causes commit() to be called on all 566database handles associated with $obj. Otherwise it commits all 567database handles whose names are listed in @db_names. 568 569Alternatively, you may like to do: $rc = $obj->db_Name->commit; 570 571If all the commits succeeded it returns true, false otherwise. 572 573=cut 574 575sub commit { 576 my ($self, @db_names) = @_; 577 return grep(!$_, map $_->commit, $self->db_handles(@db_names)) ? 0 : 1; 578} 579 580=head2 rollback 581 582 $rc = $obj->rollback; 583 $rc = $obj->rollback(@db_names); 584 585Derived from $dbh->rollback, this acts just like Ima::DBI->commit, 586except that it calls rollback(). 587 588Alternatively, you may like to do: $rc = $obj->db_Name->rollback; 589 590If all the rollbacks succeeded it returns true, false otherwise. 591 592=cut 593 594sub rollback { 595 my ($self, @db_names) = @_; 596 return grep(!$_, map $_->rollback, $self->db_handles(@db_names)) ? 0 : 1; 597} 598 599=head1 EXAMPLE 600 601 package Foo; 602 use base qw(Ima::DBI); 603 604 # Set up database connections (but don't connect yet) 605 Foo->set_db('Users', 'dbi:Oracle:Foo', 'admin', 'passwd'); 606 Foo->set_db('Customers', 'dbi:Oracle:Foo', 'Staff', 'passwd'); 607 608 # Set up SQL statements to be used through out the program. 609 Foo->set_sql('FindUser', <<"SQL", 'Users'); 610 SELECT * 611 FROM Users 612 WHERE Name LIKE ? 613 SQL 614 615 Foo->set_sql('ChangeLanguage', <<"SQL", 'Customers'); 616 UPDATE Customers 617 SET Language = ? 618 WHERE Country = ? 619 SQL 620 621 # rest of the class as usual. 622 623 package main; 624 625 $obj = Foo->new; 626 627 eval { 628 # Does connect & prepare 629 my $sth = $obj->sql_FindUser; 630 # bind_params, execute & bind_columns 631 $sth->execute(['Likmi%'], [\($name)]); 632 while( $sth->fetch ) { 633 print $name; 634 } 635 636 # Uses cached database and statement handles 637 $sth = $obj->sql_FindUser; 638 # bind_params & execute. 639 $sth->execute('%Hock'); 640 @names = $sth->fetchall; 641 642 # connects, prepares 643 $rows_altered = $obj->sql_ChangeLanguage->execute(qw(es_MX mx)); 644 }; 645 unless ($@) { 646 # Everything went okay, commit the changes to the customers. 647 $obj->commit('Customers'); 648 } 649 else { 650 $obj->rollback('Customers'); 651 warn "DBI failure: $@"; 652 } 653 654=head1 USE WITH MOD_PERL, FASTCGI, ETC. 655 656To help with use in forking environments, Ima::DBI database handles keep 657track of the PID of the process they were openend under. If they notice 658a change (because you forked a new process), a new handle will be opened 659in the new process. This prevents a common problem seen in environments 660like mod_perl where people would open a handle in the parent process and 661then run into trouble when they try to use it from a child process. 662 663Because Ima::DBI handles keeping database connections persistent and 664prevents problems with handles openend before forking, it is not 665necessary to use Apache::DBI when using Ima::DBI. However, there is 666one feature of Apache::DBI which you will need in a mod_perl or FastCGI 667environment, and that's the automatic rollback it does at the end of each 668request. This rollback provides safety from transactions left hanging 669when some perl code dies -- a serious problem which could grind your 670database to a halt with stale locks. 671 672To replace this feature on your own under mod_perl, you can add something 673like this in a handler at any phase of the request: 674 675 $r->push_handlers(PerlCleanupHandler => sub { 676 MyImaDBI->rollback(); 677 }); 678 679Here C<MyImaDBI> is your subclass of Ima::DBI. You could also make this 680into an actual module and set the PerlCleanupHandler from your httpd.conf. 681A similar approach should work in any long-running environment which has 682a hook for running some code at the end of each request. 683 684=head1 TODO, Caveat, BUGS, etc.... 685 686=over 4 687 688=item I seriously doubt that it's thread safe. 689 690You can bet cupcackes to sno-cones that much havoc will be wrought if 691Ima::DBI is used in a threaded Perl. 692 693=item Should make use of private_* handle method to store information 694 695=item The docs stink. 696 697The docs were originally written when I didn't have a good handle on 698the module and how it will be used in practical cases. I need to 699rewrite the docs from the ground up. 700 701=item Need to add debugging hooks. 702 703The thing which immediately comes to mind is a Verbose flag to print 704out SQL statements as they are made as well as mention when database 705connections are made, etc... 706 707=back 708 709=head1 MAINTAINERS 710 711Tony Bowden <tony@tmtm.com> and Perrin Harkins <perrin@elem.com> 712 713=head1 ORIGINAL AUTHOR 714 715Michael G Schwern <schwern@pobox.com> 716 717=head1 LICENSE 718 719This module is free software. You may distribute under the same terms 720as Perl itself. IT COMES WITHOUT WARRANTY OF ANY KIND. 721 722=head1 THANKS MUCHLY 723 724Tim Bunce, for enduring many DBI questions and adding Taint, 725prepare_cached and connect_cached methods to DBI, simplifying this 726greatly! 727 728Arena Networks, for effectively paying for Mike to write most of this 729module. 730 731=head1 SEE ALSO 732 733L<DBI>. 734 735You may also choose to check out L<Class::DBI> which hides most of this 736from view. 737 738=cut 739 740return 1001001; 741