1package Ima::DBI; 2 3$VERSION = '0.33'; 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 METHODS 236 237=head2 Class methods 238 239=over 4 240 241=item B<set_db> 242 243 Foo->set_db($db_name, $data_source, $user, $password); 244 Foo->set_db($db_name, $data_source, $user, $password, \%attr); 245 246This method is used in place of DBI->connect to create your database 247handles. It sets up a new DBI database handle associated to $db_name. 248All other arguments are passed through to DBI->connect_cached. 249 250A new method is created for each db you setup. This new method is called 251"db_$db_name"... so, for example, Foo->set_db("foo", ...) will create 252a method called "db_foo()". (Spaces in $db_name will be translated into 253underscores: '_') 254 255%attr is combined with a set of defaults (RaiseError => 1, AutoCommit 256=> 0, PrintError => 0, Taint => 1). This is a better default IMHO, 257however it does give databases without transactions (such as MySQL) a 258hard time. Be sure to turn AutoCommit back on if your database does 259not support transactions. 260 261The actual database handle creation (and thus the database connection) 262is held off until a prepare is attempted with this handle. 263 264=cut 265 266sub _croak { my $self = shift; require Carp; Carp::croak(@_) } 267 268sub set_db { 269 my $class = shift; 270 my $db_name = shift or $class->_croak("Need a db name"); 271 $db_name =~ s/\s/_/g; 272 273 my $data_source = shift or $class->_croak("Need a data source"); 274 my $user = shift || ""; 275 my $password = shift || ""; 276 my $attr = shift || {}; 277 ref $attr eq 'HASH' or $class->_croak("$attr must be a hash reference"); 278 $attr = $class->_add_default_attributes($attr); 279 280 $class->_remember_handle($db_name); 281 no strict 'refs'; 282 *{ $class . "::db_$db_name" } = 283 $class->_mk_db_closure($data_source, $user, $password, $attr); 284 285 return 1; 286} 287 288sub _add_default_attributes { 289 my ($class, $user_attr) = @_; 290 my %attr = $class->_default_attributes; 291 @attr{ keys %$user_attr } = values %$user_attr; 292 return \%attr; 293} 294 295sub _default_attributes { 296 ( 297 RaiseError => 1, 298 AutoCommit => 0, 299 PrintError => 0, 300 Taint => 1, 301 RootClass => "DBIx::ContextualFetch" 302 ); 303} 304 305sub _remember_handle { 306 my ($class, $db) = @_; 307 my $handles = $class->__Database_Names || []; 308 push @$handles, $db; 309 $class->__Database_Names($handles); 310} 311 312sub _mk_db_closure { 313 my ($class, @connection) = @_; 314 my $dbh; 315 return sub { 316 unless ($dbh && $dbh->FETCH('Active') && $dbh->ping) { 317 $dbh = DBI->connect_cached(@connection); 318 } 319 return $dbh; 320 }; 321} 322 323=pod 324 325=item B<set_sql> 326 327 Foo->set_sql($sql_name, $statement, $db_name); 328 Foo->set_sql($sql_name, $statement, $db_name, $cache); 329 330This method is used in place of DBI->prepare to create your statement 331handles. It sets up a new statement handle associated to $sql_name using 332the database connection associated with $db_name. $statement is passed 333through to either DBI->prepare or DBI->prepare_cached (depending on 334$cache) to create the statement handle. 335 336If $cache is true or isn't given, then prepare_cached() will be used to 337prepare the statement handle and it will be cached. If $cache is false 338then a normal prepare() will be used and the statement handle will be 339recompiled on every sql_*() call. If you have a statement which changes 340a lot or is used very infrequently you might not want it cached. 341 342A new method is created for each statement you set up. This new method 343is "sql_$sql_name"... so, as with set_db(), Foo->set_sql("bar", ..., 344"foo"); will create a method called "sql_bar()" which uses the database 345connection from "db_foo()". Again, spaces in $sql_name will be translated 346into underscores ('_'). 347The actual statement handle creation is held off until sql_* is first 348called on this name. 349 350To make up for the limitations of bind parameters, $statement can contain 351sprintf() style formatting (ie. %s and such) to allow dynamically 352generated SQL statements (so to get a real percent sign, use '%%'). 353See sql_* below for more details. 354 355=cut 356 357sub set_sql { 358 my ($class, $sql_name, $statement, $db_name, $cache) = @_; 359 $cache = 1 unless defined $cache; 360 361 # ------------------------- sql_* closure ----------------------- # 362 my $db_meth = $db_name; 363 $db_meth =~ s/\s/_/g; 364 $db_meth = "db_$db_meth"; 365 366 (my $sql_meth = $sql_name) =~ s/\s/_/g; 367 $sql_meth = "sql_$sql_meth"; 368 369 # Remember the name of this handle for the class. 370 my $handles = $class->__Statement_Names || []; 371 push @$handles, $sql_name; 372 $class->__Statement_Names($handles); 373 374 no strict 'refs'; 375 *{ $class . "::$sql_meth" } = 376 $class->_mk_sql_closure($sql_name, $statement, $db_meth, $cache); 377 378 return 1; 379} 380 381sub _mk_sql_closure { 382 my ($class, $sql_name, $statement, $db_meth, $cache) = @_; 383 384 return sub { 385 my $class = shift; 386 my $dbh = $class->$db_meth(); 387 388 # Everything must pass through sprintf, even if @_ is empty. 389 # This is to do proper '%%' translation. 390 my $sql = $class->transform_sql($statement => @_); 391 return $cache 392 ? $dbh->prepare_cached($sql) 393 : $dbh->prepare($sql); 394 }; 395} 396 397sub transform_sql { 398 my ($class, $sql, @args) = @_; 399 return sprintf $sql, @args; 400} 401 402=item B<db_names> 403 404=item B<db_handles> 405 406 my @database_names = Foo->db_names; 407 my @database_handles = Foo->db_handles; 408 my @database_handles = Foo->db_handles(@db_names); 409 410Returns a list of the database handles set up for this class using 411set_db(). This includes all inherited handles. 412 413db_names() simply returns the name of the handle, from which it is 414possible to access it by converting it to a method name and calling 415that db method... 416 417 my @db_names = Foo->db_names; 418 my $db_meth = 'db_'.$db_names[0]; 419 my $dbh = $foo->$db_meth; 420 421Icky, eh? Fortunately, db_handles() does this for you and returns a 422list of database handles in the same order as db_names(). B<Use this 423sparingly> as it will connect you to the database if you weren't 424already connected. 425 426If given @db_names, db_handles() will return only the handles for 427those connections. 428 429These both work as either class or object methods. 430 431=cut 432 433sub db_names { @{ $_[0]->__Database_Names || [] } } 434 435sub db_handles { 436 my ($self, @db_names) = @_; 437 @db_names = $self->db_names unless @db_names; 438 return map $self->$_(), map "db_$_", @db_names; 439} 440 441=item B<sql_names> 442 443 my @statement_names = Foo->sql_names; 444 445Similar to db_names() this returns the names of all SQL statements set 446up for this class using set_sql(), inherited or otherwise. 447 448There is no corresponding sql_handles() because we can't know what 449arguments to pass in. 450 451=cut 452 453sub sql_names { @{ $_[0]->__Statement_Names || [] } } 454 455=back 456 457=head2 Object methods 458 459=over 4 460 461=item B<db_*> 462 463 $dbh = $obj->db_*; 464 465This is how you directly access a database handle you set up with set_db. 466 467The actual particular method name is derived from what you told set_db. 468 469db_* will handle all the issues of making sure you're already 470connected to the database. 471 472=item B<sql_*> 473 474 $sth = $obj->sql_*; 475 $sth = $obj->sql_*(@sql_pieces); 476 477sql_*() is a catch-all name for the methods you set up with set_sql(). 478For instance, if you did: 479 480 Foo->set_sql('GetAllFoo', 'Select * From Foo', 'SomeDb'); 481 482you'd run that statement with sql_GetAllFoo(). 483 484sql_* will handle all the issues of making sure the database is 485already connected, and the statement handle is prepared. It returns a 486prepared statement handle for you to use. (You're expected to 487execute() it) 488 489If sql_*() is given a list of @sql_pieces it will use them to fill in 490your statement, assuming you have sprintf() formatting tags in your 491statement. For example: 492 493 Foo->set_sql('GetTable', 'Select * From %s', 'Things'); 494 495 # Assuming we have created an object... this will prepare the 496 # statement 'Select * From Bar' 497 $sth = $obj->sql_Search('Bar'); 498 499Be B<very careful> with what you feed this function. It cannot 500do any quoting or escaping for you, so it is totally up to you 501to take care of that. Fortunately if you have tainting on you 502will be spared the worst. 503 504It is recommended you only use this in cases where bind parameters 505will not work. 506 507=item B<DBIwarn> 508 509 $obj->DBIwarn($what, $doing); 510 511Produces a useful error for exceptions with DBI. 512 513B<I'm not particularly happy with this interface> 514 515Most useful like this: 516 517 eval { 518 $self->sql_Something->execute($self->{ID}, @stuff); 519 }; 520 if($@) { 521 $self->DBIwarn($self->{ID}, 'Something'); 522 return; 523 } 524 525 526=cut 527 528sub DBIwarn { 529 my ($self, $thing, $doing) = @_; 530 my $errstr = "Failure while doing '$doing' with '$thing'\n"; 531 $errstr .= $@ if $@; 532 533 require Carp; 534 Carp::carp $errstr; 535 536 return 1; 537} 538 539=back 540 541 542=head2 Modified database handle methods 543 544Ima::DBI makes some of the methods available to your object that are 545normally only available via the database handle. In addition, it 546spices up the API a bit. 547 548=over 4 549 550=item B<commit> 551 552 $rc = $obj->commit; 553 $rc = $obj->commit(@db_names); 554 555Derived from $dbh->commit() and basically does the same thing. 556 557If called with no arguments, it causes commit() to be called on all 558database handles associated with $obj. Otherwise it commits all 559database handles whose names are listed in @db_names. 560 561Alternatively, you may like to do: $rc = $obj->db_Name->commit; 562 563If all the commits succeeded it returns true, false otherwise. 564 565=cut 566 567sub commit { 568 my ($self, @db_names) = @_; 569 return grep(!$_, map $_->commit, $self->db_handles(@db_names)) ? 0 : 1; 570} 571 572=pod 573 574=item B<rollback> 575 576 $rc = $obj->rollback; 577 $rc = $obj->rollback(@db_names); 578 579Derived from $dbh->rollback, this acts just like Ima::DBI->commit, 580except that it calls rollback(). 581 582Alternatively, you may like to do: $rc = $obj->db_Name->rollback; 583 584If all the rollbacks succeeded it returns true, false otherwise. 585 586=cut 587 588sub rollback { 589 my ($self, @db_names) = @_; 590 return grep(!$_, map $_->rollback, $self->db_handles(@db_names)) ? 0 : 1; 591} 592 593=pod 594 595=back 596 597=head1 EXAMPLE 598 599 package Foo; 600 use base qw(Ima::DBI); 601 602 # Set up database connections (but don't connect yet) 603 Foo->set_db('Users', 'dbi:Oracle:Foo', 'admin', 'passwd'); 604 Foo->set_db('Customers', 'dbi:Oracle:Foo', 'Staff', 'passwd'); 605 606 # Set up SQL statements to be used through out the program. 607 Foo->set_sql('FindUser', <<"SQL", 'Users'); 608 SELECT * 609 FROM Users 610 WHERE Name LIKE ? 611 SQL 612 613 Foo->set_sql('ChangeLanguage', <<"SQL", 'Customers'); 614 UPDATE Customers 615 SET Language = ? 616 WHERE Country = ? 617 SQL 618 619 # rest of the class as usual. 620 621 package main; 622 623 $obj = Foo->new; 624 625 eval { 626 # Does connect & prepare 627 my $sth = $obj->sql_FindUser; 628 # bind_params, execute & bind_columns 629 $sth->execute(['Likmi%'], [\($name)]); 630 while( $sth->fetch ) { 631 print $name; 632 } 633 634 # Uses cached database and statement handles 635 $sth = $obj->sql_FindUser; 636 # bind_params & execute. 637 $sth->execute('%Hock'); 638 @names = $sth->fetchall; 639 640 # connects, prepares 641 $rows_altered = $obj->sql_ChangeLanguage->execute(qw(es_MX mx)); 642 }; 643 unless ($@) { 644 # Everything went okay, commit the changes to the customers. 645 $obj->commit('Customers'); 646 } 647 else { 648 $obj->rollback('Customers'); 649 warn "DBI failure: $@"; 650 } 651 652 653=head1 TODO, Caveat, BUGS, etc.... 654 655=over 4 656 657=item I seriously doubt that it's thread safe. 658 659You can bet cupcackes to sno-cones that much havoc will be wrought if 660Ima::DBI is used in a threaded Perl. 661 662=item Should make use of private_* handle method to store information 663 664=item The docs stink. 665 666The docs were originally written when I didn't have a good handle on 667the module and how it will be used in practical cases. I need to 668rewrite the docs from the ground up. 669 670=item Need to add debugging hooks. 671 672The thing which immediately comes to mind is a Verbose flag to print 673out SQL statements as they are made as well as mention when database 674connections are made, etc... 675 676=back 677 678=head1 MAINTAINER 679 680Tony Bowden <tony@tmtm.com> 681 682=head1 ORIGINAL AUTHOR 683 684Michael G Schwern <schwern@pobox.com> 685 686=head1 LICENSE 687 688This module is free software. You may distribute under the same terms 689as Perl itself. IT COMES WITHOUT WARRANTY OF ANY KIND. 690 691=head1 THANKS MUCHLY 692 693Tim Bunce, for enduring many DBI questions and adding Taint, 694prepare_cached and connect_cached methods to DBI, simplifying this 695greatly! 696 697Arena Networks, for effectively paying for Mike to write most of this 698module. 699 700=head1 SEE ALSO 701 702L<DBI>. 703 704You may also choose to check out L<Class::DBI> which hides most of this 705from view. 706 707=cut 708 709return 1001001; 710