diff options
| author | Nicholas Bamber <nicholas@periapt.co.uk> | 2010-11-26 22:08:43 +0000 |
|---|---|---|
| committer | Nicholas Bamber <nicholas@periapt.co.uk> | 2010-11-26 22:08:43 +0000 |
| commit | 9e62fccfaba9a6c64846b86f911d6286a490fddc (patch) | |
| tree | 8a7ef90d1a5fd8446a48cf80e89c87032de43553 | |
[svn-inject] Installing original source of libtest-database-perl (1.11)
36 files changed, 3250 insertions, 0 deletions
diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..9922456 --- /dev/null +++ b/Build.PL @@ -0,0 +1,31 @@ +use 5.006; +use strict; +use warnings; +use Module::Build; + +my $builder = Module::Build->new( + module_name => 'Test::Database', + license => 'perl', + dist_author => 'Philippe Bruhat (BooK) <book@cpan.org>', + dist_version_from => 'lib/Test/Database.pm', + requires => { + 'DBI' => 1, + 'File::HomeDir' => 0.50, + 'version' => 0, + 'YAML::Tiny' => 1.27, + 'File::Spec' => 0, + 'File::Path' => 0, + 'perl' => 5.006, + }, + build_requires => { + 'Test::More' => 0, + }, + meta_merge => { + resources => { + repository => 'http://github.com/book/Test-Database', + }, + }, + add_to_cleanup => [ 'Test-Database-*' ], +); + +$builder->create_build_script(); @@ -0,0 +1,145 @@ +Revision history for Test-Database + +1.11 Tue May 4 01:03:10 CEST 2010 + [IMPROVEMENTS] + - new version_string() method ensures version constraints on + requests work correctly (thanks to Erik Rijkers) + - new paramater for requests: regex_version + [TESTS] + - workaround for DBD::DBM errors in t/25-sql.t, thanks to + Birmingham.pm + +1.10 Tue Apr 27 00:58:22 CEST 2010 + [IMPROVEMENTS] + - Do not print errors when errors are expected and will be ignored. + (Thanks to Barbie - RT #56516) + [TESTS] + - clean t/10-drivers.t of warnings and errors + (Thanks to Barbie & Martin J Evans - RT #56516) + +1.09 Tue Mar 16 12:43:08 CET 2010 + [TESTS] + - added t/24-cleanup.t to ensure all databases used by the test suite + [DOCUMENTATION] + - fixed copyright dates, added an author/license section to the + tutorial + +1.08 Mon Mar 15 15:00:45 CET 2010 + [IMPROVEMENTS] + - better dependencies lists and META.yml (Alexandr Ciornii) + - ignore errors when loading configuration + - more accessors added to Test::Database::Handle + +1.07 Mon Oct 12 23:25:26 CEST 2009 + [IMPROVEMENTS] + - Test::Database::Driver now has a dbd_version() method + - Fixed a bug that created some warnings (thanks to Nicholas Bamber) + - Test::Database::Driver::Pg now accepts a 'template' parameter + (requested by Adam Kennedy) + [TESTS] + - Fixed warnings in t/10-drivers.t and t/25-sql.t + +1.06 Thu Sep 3 00:39:49 CEST 2009 + [IMPROVEMENTS] + - better basename computation for database created by the module + [DOCUMENTATION] + - added explanations on how database handles are provided + in Test::Database::Tutorial + [PREREQUISITES] + - Need YAML::Tiny 1.27, since we use LoadFile in scalar context + +1.05 Fri Aug 28 00:09:31 CEST 2009 + [IMPROVEMENTS] + - the key configuration item allows to add a unique key + to database created by Test::Database (useful when + sharing a database between several test hosts) + [DOCUMENTATION] + - Test::Database::Tutorial now documents how to use the + module as a CPAN author or CPAN tester + +1.04 Sun Aug 23 03:10:11 CEST 2009 + [IMPROVEMENTS] + - re-introduced Test::Database::Driver::Pg + - more robust computation of base_dir() + [TESTS] + - tests for make_dsn() + +1.03 Fri Aug 21 23:01:10 CEST 2009 + [IMPROVEMENTS] + - improved dsn and driver_dsn management + - database requests may include version information + - more robust test suite + +1.02 Sun Aug 16 14:47:04 CEST 2009 + [IMPROVEMENTS] + - re-introduced Test::Database::Driver::mysql + - add support for driver_dsn in configuration file + +1.01 Sun Aug 2 01:03:22 CEST 2009 + [IMPROVEMENTS] + - re-introduced Test::Database::Driver + - Test::Database::Driver supports file-based DBD + - Test::Database::Driver maps existing databases to cwd() + - Drivers for SQLite, SQLite2, CSV, DBM + +1.00 Sat Jul 11 00:39:04 CEST 2009 + [IMPROVEMENTS] + - rewrite/cleanup: the module now only supports a list of DSN + provided in the ~/.test-database configuration file + - the only two modules lefts for now are Test::Database and + Test::Database::Handle + [TODO] + - future versions will appear shortly and bring back some + of the features that appeared in 0.99 and later + +0.99_03 Tue Apr 6 22:16:05 CEST 2009 + [DRIVERS] + - new driver for DBD::Pg + +0.99_02 Mon Apr 6 03:21:51 CEST 2009 + [IMPROVEMENTS] + - try to connect to non file-based databases to ensure we can, + before adding a driver to our collection + - cleanup() will only clean loaded drivers + +0.99_01 Wed Apr 1 10:01:57 CEST 2009 + [FIXES] + - Do not die when automatically trying to load a non-existent + ~/.test-database file + [DOCUMENTATION] + - add some documentation about REQUESTS + [TESTS] + - add tests for save_driver() and load_drivers() + - increase test coverage to over 95% + +0.99 Mon Mar 30 16:20:23 CEST 2009 - Perl QA Hackathon 2009 + [FEATURES] + - completely redesigned interface: the module never starts a + database engine, but simply makes pre-configured ones available + to test scripts + [DRIVERS] + - new driver for DBD::SQlite + - new driver for DBD::SQlite2 + - new driver for DBD::CSV + - new driver for DBD::DBM + - new driver for DBD::mysql + +0.02 Tue Oct 14 03:04:27 CEST 2008 + [FEATURES] + - improved database engine setup process, using setup_engine(), + start_engine() and stop_engine() methods in the driver classes + [DRIVERS] + - add a driver for DBD::mysql + [TESTS] + - fix t/10-drivers.t to not fail on uninstalled DBD drivers + +0.01 Fri Oct 10 17:44:24 CEST 2008 + [FEATURES] + - provide a simple interface for obtaining a database handle + [DRIVERS] + - add a driver for DBD::SQlite + - add a driver for DBD::CSV + - add a driver for DBD::DBM + [TESTS] + - over 97% test coverage + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..7a81dfe --- /dev/null +++ b/MANIFEST @@ -0,0 +1,36 @@ +Build.PL +Changes +eg/MyDriver.pm +lib/Test/Database.pm +lib/Test/Database/Driver.pm +lib/Test/Database/Driver/CSV.pm +lib/Test/Database/Driver/DBM.pm +lib/Test/Database/Driver/mysql.pm +lib/Test/Database/Driver/Pg.pm +lib/Test/Database/Driver/SQLite.pm +lib/Test/Database/Driver/SQLite2.pm +lib/Test/Database/Handle.pm +lib/Test/Database/Tutorial.pod +lib/Test/Database/Util.pm +Makefile.PL +MANIFEST This list of files +META.yml +README +t/00-load.t +t/08-handle.t +t/09-handle-dsn.t +t/10-drivers.t +t/10-list_drivers.t +t/11-available_dbname.t +t/11-make_dsn.t +t/11-version_matches.t +t/12-load.t +t/20-handles.t +t/25-sql.t +t/database.bad +t/database.bad2 +t/database.empty +t/database.good +t/database.rc +t/pod-coverage.t +t/pod.t diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..4dcb4e0 --- /dev/null +++ b/META.yml @@ -0,0 +1,46 @@ +--- +name: Test-Database +version: 1.11 +author: + - 'Philippe Bruhat (BooK) <book@cpan.org>' +abstract: Database handles ready for testing +license: perl +resources: + license: http://dev.perl.org/licenses/ + repository: http://github.com/book/Test-Database +requires: + DBI: 1 + File::HomeDir: 0.5 + File::Path: 0 + File::Spec: 0 + YAML::Tiny: 1.27 + perl: 5.006 + version: 0 +build_requires: + Test::More: 0 +provides: + Test::Database: + file: lib/Test/Database.pm + version: 1.11 + Test::Database::Driver: + file: lib/Test/Database/Driver.pm + Test::Database::Driver::CSV: + file: lib/Test/Database/Driver/CSV.pm + Test::Database::Driver::DBM: + file: lib/Test/Database/Driver/DBM.pm + Test::Database::Driver::Pg: + file: lib/Test/Database/Driver/Pg.pm + Test::Database::Driver::SQLite: + file: lib/Test/Database/Driver/SQLite.pm + Test::Database::Driver::SQLite2: + file: lib/Test/Database/Driver/SQLite2.pm + Test::Database::Driver::mysql: + file: lib/Test/Database/Driver/mysql.pm + Test::Database::Handle: + file: lib/Test/Database/Handle.pm + Test::Database::Util: + file: lib/Test/Database/Util.pm +generated_by: Module::Build version 0.33 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3600f91 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,20 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Test::Database', + AUTHOR => 'Philippe Bruhat (BooK) <book@cpan.org>', + VERSION_FROM => 'lib/Test/Database.pm', + ABSTRACT_FROM => 'lib/Test/Database.pm', + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'DBI' => 1, + 'File::HomeDir' => 0.50, + 'version' => 0, + 'YAML::Tiny' => 1.27, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Test-Database-*' }, +); @@ -0,0 +1,58 @@ +Test-Database + +There's plenty of modules which need a database, and they all have +to be configured differently and they're always a PITA when you first +install and each and every time they upgrade. -- Michael Schwern + +Test::Database provides a simple way for test authors to request +a test database, without worrying about environment variables or the +test host configuration. + + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +Alternatively, to install with Module::Build, you can use the following commands: + + perl Build.PL + ./Build + ./Build test + ./Build install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Test::Database + +You can also look for information at: + + RT, CPAN's request tracker + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Database + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Test-Database + + CPAN Ratings + http://cpanratings.perl.org/d/Test-Database + + Search CPAN + http://search.cpan.org/dist/Test-Database + + +COPYRIGHT + +Copyright (C) 2008-2009 Philippe Bruhat (BooK) + +LICENCE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + diff --git a/eg/MyDriver.pm b/eg/MyDriver.pm new file mode 100644 index 0000000..7e6f6e8 --- /dev/null +++ b/eg/MyDriver.pm @@ -0,0 +1,84 @@ +package Test::Database::Driver::MyDriver; +use strict; +use warnings; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +# uncomment only if your database engine is file-based +#sub is_filebased {1} + +sub _version { + # return a version string +} + +sub dsn { + my ($self, $dbname) = @_; + # return a dsn for $dbname +} + +# this routine has a default implementation for file-based database engines +sub create_database { + my ( $self, $dbname, $keep ) = @_; + $dbname = $self->available_dbname() if !$dbname; + + # create the database if it doesn't exist + # ... + + # return the handle + return Test::Database::Handle->new( + dsn => $self->dsn($dbname), + name => $dbname, + driver => $self, + # ... other fields, like username, password + ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + + # drop the database +} + +# this routine has a default implementation for file-based database engines +sub databases { + my ($self) = @_; + # return the names of all databases existing in this driver +} + +'MyDriver'; + +__END__ + +=head1 NAME + +Test::Database::Driver::MyDriver - A Test::Database driver for MyDriver + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'MyDriver' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::MyDriver>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2009 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database.pm b/lib/Test/Database.pm new file mode 100644 index 0000000..5f0d7a3 --- /dev/null +++ b/lib/Test/Database.pm @@ -0,0 +1,475 @@ +package Test::Database; +use 5.006; +use warnings; +use strict; + +use File::HomeDir; +use File::Spec; +use DBI; +use Carp; + +use Test::Database::Util; +use Test::Database::Driver; +use Test::Database::Handle; + +our $VERSION = '1.11'; + +# +# global configuration +# + +# internal data structures +my @HANDLES; +my @DRIVERS; + +# driver information +my @DRIVERS_OUR; +my @DRIVERS_OK; + +# find the list of all drivers we support +sub load_drivers { + my %seen; + for my $dir (@INC) { + opendir my $dh, File::Spec->catdir( $dir, qw( Test Database Driver ) ) + or next; + $seen{$_}++ for map { s/\.pm$//; $_ } grep {/\.pm$/} readdir $dh; + closedir $dh; + } + + # drivers we support + @DRIVERS_OUR = sort keys %seen; + + # available DBI drivers + my %DRIVERS_DBI = map { $_ => 1 } DBI->available_drivers(); + + # supported + @DRIVERS_OK = grep { exists $DRIVERS_DBI{$_} } @DRIVERS_OUR; + + # automatically load all drivers in @DRIVERS_OK + # (but ignore compilation errors) + eval "require Test::Database::Driver::$_" for @DRIVERS_OK; + + # actual driver objects + @DRIVERS = map { + my $driver; + eval { $driver = Test::Database::Driver->new( dbd => $_ ); 1; } + or warn "$@\n"; + $driver || (); + } + grep { "Test::Database::Driver::$_"->is_filebased() } @DRIVERS_OK; +} + +# startup configuration +__PACKAGE__->load_drivers(); +__PACKAGE__->load_config() if -e _rcfile(); + +# +# private functions +# +# location of our resource file +sub _rcfile { + File::Spec->catfile( File::HomeDir->my_data(), '.test-database' ); +} + +# +# methods +# +sub clean_config { + @HANDLES = (); + @DRIVERS = (); +} + +sub load_config { + my ( $class, @files ) = @_; + @files = ( _rcfile() ) if !@files; + + # fetch the items (dsn, driver_dsn) from the config files + my @items = map { _read_file($_) } @files; + + # load the key + Test::Database::Driver->_set_key( $_->{key} ) + for grep { exists $_->{key} } @items; + + # create the handles + push @HANDLES, + map { eval { Test::Database::Handle->new(%$_) } || () } + grep { exists $_->{dsn} } @items; + + # create the drivers + push @DRIVERS, + map { eval { Test::Database::Driver->new(%$_) } || () } + grep { exists $_->{driver_dsn} } @items; +} + +sub list_drivers { + my ( $class, $type ) = @_; + $type ||= ''; + return + $type eq 'all' ? @DRIVERS_OUR + : $type eq 'available' ? @DRIVERS_OK + : map { $_->name() } @DRIVERS; +} + +sub drivers { @DRIVERS } + +# requests for handles +sub handles { + my ( $class, @requests ) = @_; + my @handles; + + # empty request means "everything" + return @handles = ( @HANDLES, map { $_->make_handle() } @DRIVERS ) + if !@requests; + + # turn strings (driver name) into actual requests + @requests = map { (ref) ? $_ : { dbd => $_ } } @requests; + + # process parameter aliases + $_->{dbd} ||= delete $_->{driver} for @requests; + + # get the matching handles + for my $handle (@HANDLES) { + my $ok; + my $driver = $handle->{driver}; + for my $request (@requests) { + next if $request->{dbd} ne $handle->dbd(); + if ( grep /version/, keys %$request ) { + next if !$driver || !$driver->version_matches($request); + } + $ok = 1; + last; + } + push @handles, $handle if $ok; + } + + # get the matching drivers + my @drivers; + for my $driver (@DRIVERS) { + my $ok; + for my $request (@requests) { + next if $request->{dbd} ne $driver->dbd(); + next if !$driver->version_matches($request); + $ok = 1; + last; + } + push @drivers, $driver if $ok; + } + + # get a new database handle from the drivers + push @handles, map { $_->make_handle() } @drivers; + + # then on the handles + return @handles; +} + +sub handle { + my @h = shift->handles(@_); + return @h ? $h[0] : (); +} + +'TRUE'; + +__END__ + +=head1 NAME + +Test::Database - Database handles ready for testing + +=head1 SYNOPSIS + +Maybe you wrote generic code you want to test on all available databases: + + use Test::More; + use Test::Database; + + # get all available handles + my @handles = Test::Database->handles(); + + # plan the tests + plan tests => 3 + 4 * @handles; + + # run the tests + for my $handle (@handles) { + diag "Testing with " . $handle->dbd(); # mysql, SQLite, etc. + + # there are several ways to access the dbh: + + # let $handle do the connect() + my $dbh = $handle->dbh(); + + # do the connect() yourself + my $dbh = DBI->connect( $handle->connection_info() ); + my $dbh = DBI->connect( $handle->dsn(), $handle->username(), + $handle->password() ); + } + +It's possible to limit the results, based on the databases your code +supports: + + my @handles = Test::Database->handles( + 'SQLite', # SQLite database + { dbd => 'mysql' }, # or mysql database + { driver => 'Pg' }, # or Postgres database + ); + + # use them as above + +If you only need a single database handle, all the following return +the same one: + + my $handle = ( Test::Database->handles(@requests) )[0]; + my ($handle) = Test::Database->handles(@requests); + my $handle = Test::Database->handles(@requests); # scalar context + my $handle = Test::Database->handle(@requests); # singular! + my @handles = Test::Database->handle(@requests); # one or zero item + +You can use the same requests again if you need to use the same +test databases over several test scripts. + +=head1 DESCRIPTION + +Quoting Michael Schwern: + +I<There's plenty of modules which need a database, and they all have +to be configured differently and they're always a PITA when you first +install and each and every time they upgrade.> + +I<User setup can be dealt with by making Test::Database a build +dependency. As part of Test::Database's install process it walks the +user through the configuration process. Once it's done, it writes out +a config file and then it's done for good.> + +See L<http://www.nntp.perl.org/group/perl.qa/2008/10/msg11645.html> +for the thread that led to the creation of C<Test::Database>. + +C<Test::Database> provides a simple way for test authors to request +a test database, without worrying about environment variables or the +test host configuration. + +See L<SYNOPSIS> for typical usage. + +=head1 METHODS + +C<Test::Database> provides the following methods: + +=over 4 + +=item list_drivers( [$type] ) + +Return a list of driver names of the given "type". + +C<all> returns the list of all existing C<Test::Database::Driver> subclasses. + +C<available> returns the list of C<Test::Database::Driver> subclasses for which the matching +C<DBD> class is available. + +Called with no parameter (or anything not matching C<all> or C<available>), it will return +the list of currently loaded drivers. + +=item drivers() + +Returns the C<Test::Database::Driver> instances that are setup by +C<load_drivers()> and updated by C<load_config()>. + +=item load_drivers() + +Load the available drivers from the system (file-based drivers, usually). + +=item load_config( @files ) + +Read configuration from the files in C<@files>. + +If no file is provided, the local equivalent of F<~/.test-database> is used. + +=item clean_config() + +Empties whatever configuration has already been loaded. +Also removes the loaded drivers list. + +=item handles( @requests ) + +Return a set of C<Test::Database::Handle> objects that match the +given C<@requests>. + +If C<@requests> is not provided, return all the available handles. + +See L<REQUESTS> for details about writing requests. + +=item handle( @request ) + +I<Singular> version of C<handles()>, that returns the first matching +handle. + +=back + +=head1 REQUESTS + +The C<handles()> method takes I<requests> as parameters. A request is +a simple hash reference, with a number of recognized keys. + +=over 4 + +=item * + +C<dbd>: driver name (based on the C<DBD::> name). + +C<driver> is an alias for C<dbd>. +If the two keys are present, the C<driver> key will be ignored. + +If missing, all available drivers will match. + +=item * + +C<version>: exact database engine version + +Only database engines having a version string identical to the +given version string will match. + +=item * + +C<min_version>: minimum database engine version + +Only database engines having a version number greater or equal to the +given minimum version will match. + +=item * + +C<max_version>: maximum database engine version + +Only database engines having a version number lower (and not equal) to the +given maximum version will match. + +=item * + +C<regex_version>: matching database engine version + +Only database engines having a version string that matches the +given regular expression will match. + +=back + +A request can also consist of a single string, in which case it is +interpreted as a shortcut for C<{ dbd => $string }>. + +=head1 FILES + +The list of available, authorized DSN is stored in the local equivalent +of F<~/.test-database>. It's a simple list of key/value pairs, with the +C<dsn>, C<driver_dsn> or C<key> keys being used to split successive entries: + + # mysql + dsn = dbi:mysql:database=mydb;host=localhost;port=1234 + username = user + password = s3k r3t + + # Oracle + dsn = dbi:Oracle:test + + # set a unique key when creating databases + key = thwapp + + # a "driver" with full access (create/drop databases) + driver_dsn = dbi:mysql: + username = root + +The C<username> and C<password> keys are optional and empty strings will be +used if they are not provided. + +Empty lines and comments are ignored. + +Optionaly, the C<key> section is used to add a "unique" element to the +databases created by the drivers (as defined by C<driver_dsn>). It +allows several hosts to share access to the same database server +without risking a race condition when creating a new database. See +L<Test::Database::Tutorial> for a longer explanation. + +Individual drivers may accept extra parameters. See their documetation +for details. Unrecognized parameters and not used, and therefore ignored. + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 BUGS + +Please report any bugs or feature requests to C<bug-test-database at rt.cpan.org>, or through +the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Database>. I will be notified, and then you'll +automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Test::Database + +You can also look for information at: + +=over 4 + +=item * RT: CPAN's request tracker + +L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Database> + +=item * AnnoCPAN: Annotated CPAN documentation + +L<http://annocpan.org/dist/Test-Database> + +=item * CPAN Ratings + +L<http://cpanratings.perl.org/d/Test-Database> + +=item * Search CPAN + +L<http://search.cpan.org/dist/Test-Database> + +=back + +=head1 TODO + +Some of the items on the TODO list: + +=over 4 + +=item * + +Add a database engine autodetection script/module, to automatically +write the F<.test-database> configuration file. + +=back + +=head1 ACKNOWLEDGEMENTS + +Thanks to C<< <perl-qa@perl.org> >> for early comments. + +Thanks to Nelson Ferraz for writing C<DBIx::Slice>, the testing of +which made me want to have a generic way to obtain a test database. + +Thanks to Mark Lawrence for discussing this module with me, and +sending me an alternative implementation to show me what he needed. + +Thanks to Kristian Koehntopp for helping me write a mysql driver, +and to Greg Sabino Mullane for writing a full Postgres driver, +none of which made it into the final release because of the complete +change in goals and implementation between versions 0.02 and 0.03. + +The work leading to the new implementation (version 0.99 and later) +was carried on during the Perl QA Hackathon, held in Birmingham in March +2009. Thanks to Birmingham.pm for organizing it and to Booking.com for +sending me there. + +Thanks to the early adopters: +Alexis Sukrieh (SUKRIA), +Nicholas Bamber (SILASMONK) +and Adam Kennedy (ADAMK). + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver.pm b/lib/Test/Database/Driver.pm new file mode 100644 index 0000000..4a4a3a5 --- /dev/null +++ b/lib/Test/Database/Driver.pm @@ -0,0 +1,527 @@ +package Test::Database::Driver; +use strict; +use warnings; +use Carp; +use File::Spec; +use File::Path; +use version; +use YAML::Tiny qw( LoadFile DumpFile ); +use Cwd; + +use Test::Database::Handle; + +# +# GLOBAL CONFIGURATION +# + +# the location where all drivers-related files will be stored +my $KEY = ''; +my $login = getlogin() || getpwuid($<); +$login =~ s/\W+//g; +my $root = File::Spec->rel2abs( + File::Spec->catdir( File::Spec->tmpdir(), "Test-Database-$login" ) ); + +# generic driver class initialisation +sub __init { + my ($class) = @_; + + # create directory if needed + my $dir = $class->base_dir(); + if ( !-e $dir ) { + mkpath( [$dir] ); + } + elsif ( !-d $dir ) { + croak "$dir is not a directory. Initializing $class failed"; + } + + # load the DBI driver (may die) + DBI->install_driver( $class->name() ); +} + +# +# METHODS +# +sub new { + my ( $class, %args ) = @_; + + if ( $class eq __PACKAGE__ ) { + if ( exists $args{driver_dsn} ) { + my ( $scheme, $driver, $attr_string, $attr_hash, $driver_dsn ) + = DBI->parse_dsn( $args{driver_dsn} ); + $args{dbd} = $driver; + } + croak "dbd or driver_dsn parameter required" if !exists $args{dbd}; + eval "require Test::Database::Driver::$args{dbd}" + or do { $@ =~ s/ at .*?\z//s; croak $@; }; + $class = "Test::Database::Driver::$args{dbd}"; + $class->__init(); + } + + my $self = bless { + username => '', + password => '', + %args, + dbd => $class->name() || $args{dbd}, + }, + $class; + + $self->_load_mapping(); + + # try to connect before returning the object + if ( !$class->is_filebased() ) { + eval { + DBI->connect_cached( $self->connection_info(), + { PrintError => 0 } ); + } or return; + } + + return $self; +} + +sub _mapping_file { + return File::Spec->catfile( $_[0]->base_dir(), 'mapping.yml' ); +} + +sub available_dbname { + my ($self) = @_; + my $name = $self->_basename(); + my %taken = map { $_ => 1 } $self->databases(); + my $n = 0; + $n++ while $taken{"$name$n"}; + return "$name$n"; +} + +sub _load_mapping { + my ($self, $file)= @_; + $file = $self->_mapping_file() if ! defined $file; + + # basic mapping info + $self->{mapping} = {}; + return if !-e $file; + + # load mapping from file + my $mapping = LoadFile( $file ); + $self->{mapping} = $mapping->{$self->driver_dsn()} || {}; + + # remove stale entries + $self->_save_mapping( $file ) if $self->_check_mapping(); +} + +sub _save_mapping { + my ($self, $file )= @_; + $file = $self->_mapping_file() if ! defined $file; + + # update mapping information + my $mapping = {}; + $mapping = LoadFile( $file ) if -e $file; + $mapping->{ $self->driver_dsn() } = $self->{mapping}; + + # save mapping information + DumpFile( "$file.tmp", $mapping ); + rename "$file.tmp", $file + or croak "Can't rename $file.tmp to $file: $!"; +} + +sub _check_mapping { + my ($self) = @_; + my $mapping = $self->{mapping}; + my %database = map { $_ => undef } $self->databases(); + my $updated; + + # check that all databases in the mapping exist + for my $cwd ( keys %$mapping ) { + if ( !exists $database{ $mapping->{$cwd} } ) { + delete $mapping->{$cwd}; + $updated++; + } + } + return $updated; +} + +sub make_dsn { + my ($self, @args, @pairs) = @_; + + push @pairs, join '=', splice @args, 0, 2 while @args; + + my $dsn = $self->driver_dsn(); + return $dsn + . ( $dsn =~ /^dbi:[^:]+:$/ ? '' : ';' ) + . join( ';', @pairs ); +} + +sub make_handle { + my ($self) = @_; + my $handle; + + # get the database name from the mapping + my $dbname = $self->{mapping}{ cwd() }; + + # if the database still exists, return it + if ( $dbname && grep { $_ eq $dbname } $self->databases() ) { + $handle = Test::Database::Handle->new( + dsn => $self->dsn($dbname), + username => $self->username(), + password => $self->password(), + name => $dbname, + driver => $self, + ); + } + + # otherwise create the database and update the mapper + else { + $handle = $self->create_database(); + $self->{mapping}{ cwd() } = $handle->{name}; + $self->_save_mapping(); + } + + return $handle; +} + +sub version_matches { + my ( $self, $request ) = @_; + + # string tests + my $version_string = $self->version_string(); + return + if exists $request->{version} + && $version_string ne $request->{version}; + return + if exists $request->{regex_version} + && $version_string !~ $request->{regex_version}; + + # numeric tests + my $version = $self->version(); + return + if exists $request->{min_version} + && $version < $request->{min_version}; + return + if exists $request->{max_version} + && $version >= $request->{max_version}; + + return 1; +} + +# +# ACCESSORS +# +sub name { return ( $_[0] =~ /^Test::Database::Driver::([:\w]*)/g )[0]; } +*dbd = \&name; + +sub base_dir { + my ($self) = @_; + my $class = ref $self || $self; + return $root if $class eq __PACKAGE__; + my $dir = File::Spec->catdir( $root, $class->name() ); + return $dir if !ref $self; # class method + return $self->{base_dir} ||= $dir; # may be overriden in new() +} + +sub version { + no warnings; + return $_[0]{version} + ||= version->new( $_[0]->_version() =~ /^([0-9._]*[0-9])/ ); +} + +sub version_string { + return $_[0]{version_string} ||= $_[0]->_version(); +} + +sub dbd_version { return "DBD::$_[0]{dbd}"->VERSION; } + +sub driver_dsn { return $_[0]{driver_dsn} ||= $_[0]->_driver_dsn() } +sub username { return $_[0]{username} } +sub password { return $_[0]{password} } + +sub connection_info { + return ( $_[0]->driver_dsn(), $_[0]->username(), $_[0]->password() ); +} + +# THESE MUST BE IMPLEMENTED IN THE DERIVED CLASSES +sub drop_database { die "$_[0] doesn't have a drop_database() method\n" } +sub _version { die "$_[0] doesn't have a _version() method\n" } + +# create_database creates the database and returns a handle +sub create_database { + my $class = ref $_[0] || $_[0]; + goto &_filebased_create_database if $class->is_filebased(); + die "$class doesn't have a create_database() method\n"; +} + +sub databases { + goto &_filebased_databases if $_[0]->is_filebased(); + die "$_[0] doesn't have a databases() method\n"; +} + +# THESE MAY BE OVERRIDDEN IN THE DERIVED CLASSES +sub is_filebased {0} +sub _driver_dsn { join ':', 'dbi', $_[0]->name(), ''; } + +sub dsn { + my ( $self, $dbname ) = @_; + return $self->make_dsn( database => $dbname ); +} + +# +# PRIVATE METHODS +# +sub _set_key { + $KEY = $_[1] || ''; + croak "Invalid format for key '$KEY'" if $KEY !~ /^\w*$/; +} + +sub _basename { + lc join '_', 'TDD', $_[0]->name(), $login, ( $KEY ? $KEY : (), '' ); +} + +# generic implementations for file-based drivers +sub _filebased_databases { + my ($self) = @_; + my $dir = $self->base_dir(); + my $basename = qr/^@{[$self->_basename()]}/; + + opendir my $dh, $dir or croak "Can't open directory $dir for reading: $!"; + my @databases = grep {/$basename/} File::Spec->no_upwards( readdir($dh) ); + closedir $dh; + + return @databases; +} + +sub _filebased_create_database { + my ( $self ) = @_; + my $dbname = $self->available_dbname(); + + return Test::Database::Handle->new( + dsn => $self->dsn($dbname), + name => $dbname, + driver => $self, + ); +} + +'CONNECTION'; + +__END__ + +=head1 NAME + +Test::Database::Driver - Base class for Test::Database drivers + +=head1 SYNOPSIS + + package Test::Database::Driver::MyDatabase; + use strict; + use warnings; + + use Test::Database::Driver; + our @ISA = qw( Test::Database::Driver ); + + sub _version { + my ($class) = @_; + ...; + return $version; + } + + sub create_database { + my ( $self ) = @_; + ...; + return $handle; + } + + sub drop_database { + my ( $self, $name ) = @_; + ...; + } + + sub databases { + my ($self) = @_; + ...; + return @databases; + } + +=head1 DESCRIPTION + +C<Test::Database::Driver> is a base class for creating C<Test::Database> +drivers. + +=head1 METHODS + +The class provides the following methods: + +=over 4 + +=item new( %args ) + +Create a new C<Test::Database::Driver> object. + +If called as C<< Test::Database::Driver->new() >>, requires a C<driver> +parameter to define the actual object class. + +=item make_handle() + +Create a new C<Test::Database::Handle> object, attached to an existing database +or to a newly created one. + +The decision whether to create a new database or not is made by +C<Test::Database::Driver> based on the information in the mapper. +See L<TEMPORARY STORAGE ORGANIZATION> for details. + +=item make_dsn( %args ) + +Return a Data Source Name based on the driver's DSN, with the key/value +pairs contained in C<%args> as additional parameters. + +This is typically used by C<dsn()> to make a DSN for a specific database, +based on the driver's DSN. + +=item name() + +=item dbd() + +The driver's short name (everything after C<Test::Database::Driver::>). + +=item base_dir() + +The directory where the driver should store all the files for its databases, +if needed. Typically used by file-based database drivers. + +=item version() + +C<version> object representing the version of the underlying database enginge. +This object is build with the return value of C<_version()>. + +=item version_string() + +Version string representing the version of the underlying database enginge. +This string is the actual return value of C<_version()>. + +=item dbd_version() + +The version of the DBD used to connect to the database engine, as returned +by C<VERSION()>. + +=item driver_dsn() + +Return a driver Data Source Name, sufficient to connect to the database +engine without specifying an actual database. + +=item username() + +Return the connection username. + +=item password() + +Return the connection password. + +=item connection_info() + +Return the connection information triplet (C<driver_dsn>, C<username>, +C<password>). + +=item version_matches( $request ) + +Return a boolean indicating if the driver's version matches the version +constraints in the given request (see L<Test::Database> documentation's +section about requests). + +=back + +The class also provides a few helpful commands that may be useful for driver +authors: + +=over 4 + +=item available_dbname() + +Return an unused database name that can be used to create a new database +for the driver. + +=item dsn( $dbname ) + +Build a Data Source Name for the database with the given C<$dbname>, +based on the driver's DSN. + +=back + +=head1 WRITING A DRIVER FOR YOUR DATABASE OF CHOICE + +The L<SYNOPSIS> contains a good template for writing a +C<Test::Database::Driver> class. + +Creating a driver requires writing the following methods: + +=over 4 + +=item _version() + +Return the version of the underlying database engine. + +=item create_database( $name ) + +Create the database for the corresponding DBD driver. + +Return a C<Test::Database::Handle> in case of success, and nothing in +case of failure to create the database. + +=item drop_database( $name ) + +Drop the database named C<$name>. + +=back + +Some methods have defaults implementations in C<Test::Database::Driver>, +but those can be overridden in the derived class: + +=over 4 + +=item is_filebased() + +Return a boolean value indicating if the database engine is file-based +or not, i.e. if all the database information is stored in a file or a +directory, and no external database server is needed. + +=item databases() + +Return the names of all existing databases for this driver as a list +(the default implementation is only valid for file-based drivers). + +=back + +=head1 TEMPORARY STORAGE ORGANIZATION + +Subclasses of C<Test::Database::Driver> store useful information +in the system's temporary directory, under a directory named +F<Test-Database-$user> (C<$user> being the current user's name). + +That directory contains the following files: + +=over 4 + +=item database files + +The database files and directories created by file-based drivers +controlled by C<Test::Database> are stored here, under names matching +F<tdd_B<DRIVER>_B<N>>, where B<DRIVER> is the lowercased name of the +driver and B<N> is a number. + +=item the F<mapping.yml> file + +A YAML file containing a C<cwd()> / database name mapping, to enable a +given test suite to receive the same database handles in all the test +scripts that call the C<Test::Database->handles()> method. + +=back + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/CSV.pm b/lib/Test/Database/Driver/CSV.pm new file mode 100644 index 0000000..915f0e9 --- /dev/null +++ b/lib/Test/Database/Driver/CSV.pm @@ -0,0 +1,63 @@ +package Test::Database::Driver::CSV; +use strict; +use warnings; + +use File::Spec; +use File::Path; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +sub is_filebased {1} + +sub _version { return Text::CSV_XS->VERSION; } + +sub dsn { + my ( $self, $dbname ) = @_; + my $dbdir = File::Spec->catdir( $self->base_dir(), $dbname ); + mkpath( [$dbdir] ); + return $self->make_dsn( f_dir => $dbdir ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + my $dbdir = File::Spec->catdir( $self->base_dir(), $dbname ); + rmtree( [$dbdir] ); +} + +'CSV'; + +__END__ + +=head1 NAME + +Test::Database::Driver::CSV - A Test::Database driver for CSV + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'CSV' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::CSV>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/DBM.pm b/lib/Test/Database/Driver/DBM.pm new file mode 100644 index 0000000..e2751fe --- /dev/null +++ b/lib/Test/Database/Driver/DBM.pm @@ -0,0 +1,64 @@ +package Test::Database::Driver::DBM; +use strict; +use warnings; + +use File::Spec; +use File::Path; +use DBD::DBM; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +sub is_filebased {1} + +sub _version { return DBD::DBM->VERSION; } + +sub dsn { + my ( $self, $dbname ) = @_; + my $dbdir = File::Spec->catdir( $self->base_dir(), $dbname ); + mkpath( [$dbdir] ); + return $self->make_dsn( f_dir => $dbdir ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + my $dbdir = File::Spec->catdir( $self->base_dir(), $dbname ); + rmtree( [$dbdir] ); +} + +'DBM'; + +__END__ + +=head1 NAME + +Test::Database::Driver::DBM - A Test::Database driver for DBM + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'DBM' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::DBM>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/Pg.pm b/lib/Test/Database/Driver/Pg.pm new file mode 100644 index 0000000..106b909 --- /dev/null +++ b/lib/Test/Database/Driver/Pg.pm @@ -0,0 +1,100 @@ +package Test::Database::Driver::Pg; +use strict; +use warnings; +use Carp; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +sub _version { + DBI->connect_cached( $_[0]->connection_info() ) + ->selectcol_arrayref('SELECT VERSION()')->[0] =~ /^PostgreSQL (\S+)/; + return $1; +} + +sub create_database { + my ($self) = @_; + my $dbname = $self->available_dbname(); + + DBI->connect_cached( $self->connection_info() ) + ->do( "CREATE DATABASE $dbname" + . ( $self->{template} ? " TEMPLATE $self->{template}" : '' ) ); + + # return the handle + return Test::Database::Handle->new( + dsn => $self->dsn($dbname), + name => $dbname, + username => $self->username(), + password => $self->password(), + driver => $self, + ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + + DBI->connect_cached( $self->connection_info() ) + ->do("DROP DATABASE $dbname") + if grep { $_ eq $dbname } $self->databases(); +} + +sub databases { + my ($self) = @_; + my $basename = qr/^@{[$self->_basename()]}/; + my $databases = eval { + DBI->connect_cached( $self->connection_info(), { PrintError => 0 } ) + ->selectall_arrayref( + 'SELECT datname FROM pg_catalog.pg_database'); + }; + return grep {/$basename/} map {@$_} @$databases; +} + +'Pg'; + +__END__ + +=head1 NAME + +Test::Database::Driver::Pg - A Test::Database driver for Pg + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'Pg' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::Pg>. + +=head1 EXTRA PARAMETERS + +This driver understands the following extra parameters in the configuration +file: + +=over 4 + +=item template + +The template to use when creating a new database. + +=back + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/SQLite.pm b/lib/Test/Database/Driver/SQLite.pm new file mode 100644 index 0000000..0065cb9 --- /dev/null +++ b/lib/Test/Database/Driver/SQLite.pm @@ -0,0 +1,62 @@ +package Test::Database::Driver::SQLite; +use strict; +use warnings; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +use DBI; +use File::Spec; + +sub is_filebased {1} + +sub _version { return DBI->connect( $_[0]->driver_dsn() )->{sqlite_version}; } + +sub dsn { + my ( $self, $dbname ) = @_; + return $self->make_dsn( + dbname => File::Spec->catdir( $self->base_dir(), $dbname ) ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + my $dbfile = File::Spec->catfile( $self->base_dir(), $dbname ); + unlink $dbfile; +} + +'SQLite'; + +__END__ + +=head1 NAME + +Test::Database::Driver::SQLite - A Test::Database driver for SQLite + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'SQLite' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::SQLite>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/SQLite2.pm b/lib/Test/Database/Driver/SQLite2.pm new file mode 100644 index 0000000..d5d5c92 --- /dev/null +++ b/lib/Test/Database/Driver/SQLite2.pm @@ -0,0 +1,62 @@ +package Test::Database::Driver::SQLite2; +use strict; +use warnings; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +use DBI; +use File::Spec; + +sub is_filebased {1} + +sub _version { return DBI->connect( $_[0]->driver_dsn() )->{sqlite_version}; } + +sub dsn { + my ( $self, $dbname ) = @_; + return $self->make_dsn( + dbname => File::Spec->catdir( $self->base_dir(), $dbname ) ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + my $dbfile = File::Spec->catfile( $self->base_dir(), $dbname ); + unlink $dbfile; +} + +'SQLite2'; + +__END__ + +=head1 NAME + +Test::Database::Driver::SQLite2 - A Test::Database driver for SQLite2 + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'SQLite2' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::SQLite2>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Driver/mysql.pm b/lib/Test/Database/Driver/mysql.pm new file mode 100644 index 0000000..e112fc8 --- /dev/null +++ b/lib/Test/Database/Driver/mysql.pm @@ -0,0 +1,90 @@ +package Test::Database::Driver::mysql; +use strict; +use warnings; + +use DBI; + +use Test::Database::Driver; +our @ISA = qw( Test::Database::Driver ); + +sub _version { + return DBI->connect( $_[0]->connection_info() ) + ->selectcol_arrayref('SELECT VERSION()')->[0]; +} + +sub create_database { + my ( $self ) = @_; + my $dbname = $self->available_dbname(); + + DBI->connect_cached( $self->connection_info() ) + ->do("CREATE DATABASE $dbname"); + + # return the handle + return Test::Database::Handle->new( + dsn => $self->dsn($dbname), + name => $dbname, + username => $self->username(), + password => $self->password(), + driver => $self, + ); +} + +sub drop_database { + my ( $self, $dbname ) = @_; + + DBI->connect_cached( $self->connection_info() ) + ->do("DROP DATABASE $dbname") + if grep { $_ eq $dbname } $self->databases(); +} + +sub databases { + my ($self) = @_; + my $basename = qr/^@{[$self->_basename()]}/; + my $databases = eval { + DBI->connect_cached( $self->connection_info(), { PrintError => 0 } ) + ->selectall_arrayref('SHOW DATABASES'); + }; + return grep {/$basename/} map {@$_} @$databases; +} + +'mysql'; + +__END__ + +=head1 NAME + +Test::Database::Driver::mysql - A Test::Database driver for mysql + +=head1 SYNOPSIS + + use Test::Database; + my @handles = Test::Database->handles( 'mysql' ); + +=head1 DESCRIPTION + +This module is the C<Test::Database> driver for C<DBD::mysql>. + +=head1 SEE ALSO + +L<Test::Database::Driver> + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 ACKNOWLEDGEMENTS + +Many thanks to Kristian Köhntopp who helped me while writing a +previous version of this module (before C<Test::Database> 0.03). + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Handle.pm b/lib/Test/Database/Handle.pm new file mode 100644 index 0000000..dc8acd2 --- /dev/null +++ b/lib/Test/Database/Handle.pm @@ -0,0 +1,147 @@ +package Test::Database::Handle; +use strict; +use warnings; +use Carp; +use DBI; + +# basic accessors +for my $attr (qw( dbd dsn username password name driver )) { + no strict 'refs'; + *{$attr} = sub { return $_[0]{$attr} }; +} + +sub new { + my ( $class, %args ) = @_; + + exists $args{$_} or croak "$_ argument required" + for qw( dsn ); + + my ( $scheme, $driver, $attr_string, $attr_hash, $driver_dsn ) + = DBI->parse_dsn( $args{dsn} ); + + # fix args + %args = ( + username => '', + password => '', + %args, + dbd => $driver, + ); + + # try to provide a Test::Database::Driver object + if ( !exists $args{driver} ) { + eval { + $args{driver} = "Test::Database::Driver::$driver"->new( + driver_dsn => $args{dsn}, + username => $args{username}, + password => $args{password}, + ); + }; + } + + return bless { %args }, $class; +} + +sub connection_info { return @{ $_[0] }{qw( dsn username password )} } + +sub dbh { + my ( $self, $attr ) = @_; + return $self->{dbh} ||= DBI->connect( $self->connection_info(), $attr ); +} + +'IDENTITY'; + +__END__ + +=head1 NAME + +Test::Database::Handle - A class for Test::Database handles + +=head1 SYNOPSIS + + use Test::Database; + + my $handle = Test::Database->handle(@requests); + my $dbh = $handle->dbh(); + +=head1 DESCRIPTION + +C<Test::Database::Handle> is a very simple class for encapsulating the +information about a test database handle. + +C<Test::Database::Handle> objects are used within a test script to +obtain the necessary information about a test database handle. +Handles are obtained through the C<< Test::Database->handles() >> +or C<< Test::Database->handle() >> methods. + +=head1 METHODS + +C<Test::Database::Handle> provides the following methods: + +=over 4 + +=item new( %args ) + +Return a new C<Test::Database::Handle> with the given parameters +(C<dsn>, C<username>, C<password>). + +The only mandatory argument is C<dsn>. + +=back + +The following accessors are available. + +=over 4 + +=item dsn() + +Return the Data Source Name. + +=item username() + +Return the connection username. + +=item password() + +Return the connection password. + +=item connection_info() + +Return the connection information triplet (C<dsn>, C<username>, C<password>). + +=item dbh( [ $attr ] ) + +Return the DBI database handle obtained when connecting with the +connection triplet returned by C<connection_info()>. + +The optional parameter C<$attr> is a reference to a hash of connection +attributes, passed directly to DBI's C<connect()> method. + +=item name() + +Return the database name attached to the handle. + +=item dbd() + +Return the DBI driver name, as computed from the C<dsn>. + +=item driver() + +Return the C<Test::Database::Driver> object attached to the handle. + +=back + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/lib/Test/Database/Tutorial.pod b/lib/Test/Database/Tutorial.pod new file mode 100644 index 0000000..becb608 --- /dev/null +++ b/lib/Test/Database/Tutorial.pod @@ -0,0 +1,367 @@ +=head1 NAME + +Test::Database::Tutorial - How to use Test::Database + +=head1 INTRODUCTION + +The goal of the C<Test::Database> module is to provide easy to use test +databases for test scripts that need them. + +=head2 The problem + +Until now, when a test script needed a database, it either used SQLite +(or some other easy to setup database), or required some environment +variables to be present, or used default credentials, or even set up +the database by itself. + +Most of those methods have pros and cons: + +=over 4 + +=item * + +using SQLite + +No setup needed, but the test script can only use SQLite's dialect of SQL. +So much for portability across database engines. + +=item * + +using environment variables + +The environment variables are different for every module to test, and +usually only the main developers/testers know about them. Since most of +the CPAN testers probably don't bother setting them up, these modules +are most certainly undertested. + +=item * + +using default credentials + +Typically using C<'root'> and C<''> to connect to the C<test> MySQL +database, these test script assume a default installation on the host +system. These credentials often provide full access to the database +engine, which is a security risk in itself (see below). + +=item * + +setting up the database by itself + +This method usually uses the default credentials to access an account +with enough privileges to create a database. The host system data may +be at risk! + +=back + + +=head2 A solution: C<Test::Database> + +Many modules use a database to store their data, and often support +several database engines. + +Wouldn't it be nice to be able to test on all the supported databases +that are available on the test system? Without breaking (into) anything? + +This is the goal of the C<Test::Database> module. It supports: + +=over 4 + +=item * + +getting DSN information from a list of pre-configured database and engines + +=item * + +automatic detection of "file-based" database engines (typically, SQLite). + +=back + +The rest of this document describes various use cases for C<Test::Database>. + + +=head1 MODULE AND TEST AUTHOR + +C<Test::Database> has a single interface for test authors: + + my @handles = Test::Database->handles( @requests ); + +C<@request> is a list of "requests" for databases handles. Requests +must declare the DBD they expect, and can optionaly add version-based +limitations (only available for drivers supported by C<Test::Database>). + +The handles returned are objects of the C<Test::Database::Handle> class. + +The data contained in the database is never destroyed or cleaned +up by C<Test::Database>, so it's perfectly fine to have a startup script +that will setup the necessary tables and test data, several tests scripts +that will build and update the data, and a eventually a teardown script +that will drop all created tables. + +C<Test::Database> can return two types of databases handles: + +=over 4 + +=item * + +either a handle to a newly created database (created especially at the +test script's request) + +=item * + +or a handle to an already existing database + +=back + +There is no way for the test script to tell the difference. + +In any case, the database is assumed to provide C<DROP TABLE> and +C<CREATE TABLE> rights, and the test script is by definition allowed +to do whatever it pleases with the tables that exist in the database. + +Note that C<Test::Database> supports any DSN, not just those for which +it has a driver. If your module supports Oracle, you can add C<'Oracle'> +to your list of requests, and if the host owner configured a C<dsn> +pointing at an Oracle database, then it will be available for your tests. + +=head2 Specific database support + +It is possible to request specific versions of a database engine. + + use Test::Database; + + # request database handles for all available databases + my @handles = Test::Database->handles(); + + # or for only the databases we support + my @handles = Test::Database->handles( + { dbd => 'SQLite' }, + { dbd => 'SQLite2' }, + { dbd => 'mysql', min_version => '4.0' }, + ); + +See L<Test::Database> documentation for details about how +to write a request. + +=head2 Testing on a development box + +The first systems on which you are going to test your module are the +ones you own. On these system, it's up to you to configure the databases +you want to make available. + +A typical F<~/.test-database> configuration file would look like this: + + dsn = dbi:mysql:database=test + username = root + + dsn = dbi:Pg:database=test + username = postgres + + dsn = dbi:Oracle:test + +There is no need to add C<dsn> sections for file-based drivers +(at least the ones that have a corresponding C<Test::Database::Driver>), +since the module will automatically detect the available ones and create +databases as needed. + +To find out which of the DBD that C<Test::Database> supports are +installed, use the following one-liner: + + $ perl -MTest::Database -le 'print for Test::Database->list_drivers("available")' + DBM + SQLite + mysql + +With no parameter, it will return the list of configured ones: + + $ perl -MTest::Database -le 'print for Test::Database->list_drivers()' + DBM + SQLite + + +=head1 CPAN TESTER + +The main goal of C<Test::Database> from the point of view of a tester +is: "configure once, test everything". + +As a CPAN tester, once you have installed C<Test::Database>, you +should edit the local equivalent of F<~/.test-database> for the +user that will be running the CPAN test suites. + +=head2 C<dsn> versus C<driver_dsn> + +C<dsn> sections define the information needed to connect to a single +database. Any database listed here can be used by any test script that +requests it. + +C<driver_dsn> sections define the information needed to connect to a +database engine (a "driver") with sufficient rights to run a +C<CREATE DATABASE> command. This allows C<Test::Database> to create the +databases on demand, thus ensuring every test suite will get a specific +database. + +If you have file-based database engine, there is nothing to setup, as +C<Test::Database> is able to detect available file-based engines and +use them as needed. + +Other database engines like C<mysql> and C<Pg> require a little more +configuration. For example, here's the content of my F<~/.test-database> +configuration file: + + driver_dsn = dbi:mysql: + username = root + + driver_dsn = dbi:Pg: + username = postgres + +For C<Pg>, I had to edit the F<pg_hba.cong> file in F</etc> to make sure +anyone would be able to connect as the C<postgres> user, for example. + +=head2 Several test hosts accessing the same database engine + +If you have a large scale testing setup, you may want to setup a single +MySQL or Postgres instance for all your test hosts, rather than one per +test host. + +Databases created by C<Test::Database::Driver> (using a configured +C<driver_dsn> have a name built after the following template: +C<tdd_I<driver>_I<login>_I<n>>, where I<driver> is the DBD name, I<login> +is the login of the user running C<Test::Database> and I<n> a number that + +If the same database server is used by several host running +C<Test::Database> from the same user account, there is a race condition +during with two different host may try to create the a database with +the same name. A simple trick to avoid this is to add a C<key> section +to the F<~/.test-database> configuration file. + +If the C<key> entry exists, the template used by C<Test::Database::Driver> +to create new databases is C<tdd_I<driver>_I<login>_I<key>_I<n>>. + +=head2 Cleaning the test drivers + +When given a C<driver_dsn>, C<Test::Database> will use it to create a +database for each test suite that requests one. Some mapping information +is created to ensure the same test suite always receives a handle to +the same database. (The mapping of test suite to database is based on +the current working directory when C<Test::Database> is loaded). + +After a while, your database engine may fill up with unused test databases. + +All drivers store their mapping information in the system's temporary +directory, so the mapping information is relatively volatile, which implies +more unused test databases (at least for non file-based drivers, since the +file-based drivers store their database files in the system's temporary +directory too). + +The following one-liner will list all the existing databases that were +created by C<Test::Database> in your configured drivers: + + perl -MTest::Database -le 'print join "\n ", $_->name, $_->databases for Test::Database->drivers' + +Example output: + + CSV + tdd_csv_book_0 + tdd_csv_book_1 + DBM + SQLite + tdd_sqlite_book_0 + tdd_sqlite_book_1 + SQLite2 + tdd_sqlite2_book_0 + mysql + tdd_mysql_book_0 + tdd_mysql_book_1 + +The following one-liner will drop them all: + + perl -MTest::Database -le 'for$d(Test::Database->drivers){$d->drop_database($_)for$d->databases}' + +If a C<key> has been defined in the configuration, only the databases +corresponding to that key will be dropped. + +=head1 ADDING SUPPORT FOR A NEW DATABASE ENGINE + +C<Test::Database> currently supports the following DBD drivers: +C<CSV>, C<DBM>, C<mysql>, C<Pg>, C<SQLite2>, C<SQLite>. + +Adding a new driver requires writing a corresponding +C<Test::Database::Driver> subclass, having the same name as the original +C<DBD> driver. + +An example module is provided in F<eg/MyDriver.pm>, and the other +drivers can also be used as an example. See also the I<WRITING A +DRIVER FOR YOUR DATABASE OF CHOICE> section in the documentation for +C<Test::Database::Driver>. + + +=head1 WHERE DO DSN COME FROM? + +The following ASCII-art graph shows where the C<Test::Database::Handle> +objects returned by the C<handles()> method come from: + + + ,-------------, ,-------------, ,--------------, + | DSN from | | File-based | | Drivers from | + | config file | | drivers | | config file | + '-------------' '-------------' '--------------' + | | | + | | ,-----------, | + | '--->| Available |<----' + | | drivers | + | '-----------' + | | + | ,-----------, | + '------------->| Available |<--' + | DSN | + '-----------' + + +Here are a few details about the C<handles()> method works: + +=over 4 + +=item * + +C<Test::Database> maintains a list of C<Test::Database::Handle> objects +computed from the DSN listed in the configuration. + +The handles matching the request are selected. + +=item * + +C<Test::Database> also maintains a list of C<Test::Database::Driver> +objects computed from the list of supported file-based drivers that are +locally available and from the list in the configuration file. + +The list of matching drivers is computed from the requests. Each driver +is then requested to provide an existing database (using its existing +mapping information) or to create one if needed, and returns the +corresponding C<Test::Database::Handle> objects. + +=item * + +Finally, all the collected C<Test::Database::Handle> objects are returned. + +=back + +So, without any configuration, C<Test::Database> will only be able to +provide file-based databases. It is also recommended to B<not> put DSN +or driver information for the file-based database engines that have +a corresponding C<Test::Database::Driver> class, since it will cause +C<handles()> to return several handles for the same database engine. + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2009-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +You can redistribute this tutorial and/or modify it under the same terms +as Perl itself. + +=cut + diff --git a/lib/Test/Database/Util.pm b/lib/Test/Database/Util.pm new file mode 100644 index 0000000..efb3938 --- /dev/null +++ b/lib/Test/Database/Util.pm @@ -0,0 +1,98 @@ +package Test::Database::Util; +use strict; +use warnings; +use Carp; + +# export everything +sub import { + my $caller = caller(); + no strict 'refs'; + *{"${caller}::$_"} = \&$_ for qw( _read_file ); +} + +# return a list of hashrefs representing each configuration section +sub _read_file { + my ($file) = @_; + my @config; + + open my $fh, '<', $file or croak "Can't open $file for reading: $!"; + my $re_header = qr/^(?:(?:driver_)?dsn|key)$/; + my %args; + my $records; + while (<$fh>) { + next if /^\s*(?:#|$)/; # skip blank lines and comments + chomp; + + /\s*(\w+)\s*=\s*(.*)\s*/ && do { + my ( $key, $value ) = ( $1, $2 ); + if ( $key =~ $re_header ) { + push @config, {%args} if keys %args; + $records++; + %args = (); + } + elsif ( !$records ) { + croak "Record doesn't start with dsn or driver_dsn or key " + . "at $file, line $.:\n <$_>"; + } + $args{$key} = $value; + next; + }; + + # unknown line + croak "Can't parse line at $file, line $.:\n <$_>"; + } + push @config, {%args} if keys %args; + close $fh; + + return @config; +} + +'USING'; + +__END__ + +=head1 NAME + +Test::Database::Util - Utility functions for Test::Database modules + +=head1 SYNOPSIS + + use Test::Database::Util; + + # exports a collection of underscore functions + +=head1 DESCRIPTION + +C<Test::Database::Util> exports a collection of functions used by +several modules in the C<Test-Database> distribution. + +=head1 EXPORTED FUNCTIONS + +All functions provided by C<Test::Database::Util> are exported in the +calling package. + +The following functions are provided: + +=over 4 + +=item _read_file( $file ) + +Return a list of hash references, read in the given C<$file> file. + +=back + +=head1 AUTHOR + +Philippe Bruhat (BooK), C<< <book@cpan.org> >> + +=head1 COPYRIGHT + +Copyright 2008-2010 Philippe Bruhat (BooK), all rights reserved. + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..43061b9 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More; +use File::Find; + +my @modules; +find( sub { push @modules, $File::Find::name if /\.pm$/ }, 'blib/lib' ); + +plan tests => scalar @modules; + +use_ok($_) + for reverse sort map { s!/!::!g; s/\.pm$//; s/^blib::lib:://; $_ } + @modules; + +diag("Tested Test::Database $Test::Database::VERSION, Perl $], $^X"); + diff --git a/t/08-handle.t b/t/08-handle.t new file mode 100644 index 0000000..474fe01 --- /dev/null +++ b/t/08-handle.t @@ -0,0 +1,51 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Handle; +use List::Util qw( sum ); + +my @tests = ( + + # args, expected result, error regex + [ [], undef, qr/^dsn argument required/ ], + [ [ dbd => 'Zlonk' ], undef, qr/^dsn argument required/ ], + [ [ driver => 'Foo', dsn => 'dbi:SQLite:dbname=zlonk' ], + { dsn => 'dbi:SQLite:dbname=zlonk', + username => '', + password => '', + dbd => 'SQLite', + driver => 'Foo', + } + ], + [ [ dbd => 'SQLite', + dsn => 'dbi:SQLite:dbname=zlonk', + name => 'zlonk' + ], + { dsn => 'dbi:SQLite:dbname=zlonk', + username => '', + password => '', + dbd => 'SQLite', + name => 'zlonk', + } + ], +); +my @attr = qw( dsn username password dbd ); + +plan tests => sum map { $_->[2] ? 1 : 1 + @attr } @tests; + +for my $t (@tests) { + my ( $args, $expected, $err ) = @$t; + + my $got = eval { Test::Database::Handle->new(@$args) }; + my $call = "Test::Database::Handle->new( " + . join( ', ', map {"'$_'"} @$args ) . " )"; + + if ($@) { + like( $@, $err, "Expected error message for $call" ); + } + else { + isa_ok( $got, 'Test::Database::Handle' ); + is( $got->$_, $expected->{$_}, "$_ for $call" ) for @attr; + } +} + diff --git a/t/09-handle-dsn.t b/t/09-handle-dsn.t new file mode 100644 index 0000000..91237fc --- /dev/null +++ b/t/09-handle-dsn.t @@ -0,0 +1,45 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Handle; + +use DBI; +use File::Spec; +use File::Temp qw( tempdir ); + +my $dir = tempdir( CLEANUP => 1 ); +my $db = File::Spec->catfile( $dir, 'db.sqlite' ); + +my $dsn = "dbi:SQLite:$db"; +my $dbh; +eval { $dbh = DBI->connect($dsn) } + or plan skip_all => 'DBD::SQLite needed for this test'; + +# some SQL statements to try out +my @sql = ( + q{CREATE TABLE users (id INTEGER, name VARCHAR(64))}, + q{INSERT INTO users (id, name) VALUES (1, 'book')}, + q{INSERT INTO users (id, name) VALUES (2, 'echo')}, +); +my $select = "SELECT id, name FROM users"; + +plan tests => @sql + 4; + +# create some information +ok( $dbh->do($_), $_ ) for @sql; + +# create handle +my $handle = Test::Database::Handle->new( dsn => $dsn ); + +is_deeply( + [ $handle->connection_info() ], + [ $dsn, '', '' ], + 'connection_info()' +); +isa_ok( my $dbh2 = $handle->dbh(), 'DBI::db' ); +cmp_ok( $handle->dbh(), 'eq', $dbh2, 'cached dbh' ); + +# check the data is there +my $lines = $dbh->selectall_arrayref($select); +is_deeply( $lines, [ [ 1, 'book' ], [ 2, 'echo' ] ], $select ); + diff --git a/t/10-drivers.t b/t/10-drivers.t new file mode 100644 index 0000000..37845c9 --- /dev/null +++ b/t/10-drivers.t @@ -0,0 +1,106 @@ +use strict; +use warnings; +use Test::More; +use Test::Database; +use Test::Database::Driver; + +# for file-based drivers, the dbd parameter is enough +# but for other drivers, we'll need the driver_dsn, username and password +my @drivers = ( + map { + my $d = $_; + +{ map { $_ => $d->{$_} } + grep { exists $d->{$_} } + qw( driver_dsn dbd username password ) } + } Test::Database->drivers() +); + +plan tests => 5 + @drivers * ( 1 + 2 * 12 ) + 2; + +my $base = 'Test::Database::Driver'; + +# tests for Test::Database::Driver directly +{ + ok( !eval { Test::Database::Driver->new(); 1 }, + 'Test::Database::Driver->new() failed' + ); + like( + $@, + qr/^dbd or driver_dsn parameter required at/, + 'Expected error message' + ); + my $dir = $base->base_dir(); + ok( $dir, "$base has a base_dir(): $dir" ); + like( $dir, qr/Test-Database-.*/, + "$base\'s base_dir() looks like expected" ); + ok( -d $dir, "$base base_dir() is a directory" ); +} + +# now test the subclasses + +for my $args (@drivers) { + my $name = $args->{dbd}; + my $class = "Test::Database::Driver::$name"; + use_ok($class); + + for my $t ( + [ $base => eval { $base->new(%$args) } || ( '', $@ ) ], + [ $class => eval { $class->new(%$args) } || ( '', $@ ) ], + ) + { + my ( $created_by, $driver, $at ) = @$t; + $at =~ s/ at .*\n// if $at; + SKIP: { + skip "Failed to create $name driver with $created_by ($at)", 12 + if !$driver; + diag "$name driver (created by $created_by)"; + + # class and name + my $desc = "$name driver"; + isa_ok( $driver, $class, $desc ); + is( $driver->name(), $name, "$desc has the expected name()" ); + + # base_dir + my $dir = $driver->base_dir(); + ok( $dir, "$desc has a base_dir(): $dir" ); + like( $dir, qr/Test-Database-.*\Q$name\E/, + "$desc\'s base_dir() looks like expected" ); + ok( -d $dir, "$desc base_dir() is a directory" ); + + # version + my $version; + ok( eval { $version = $driver->version() }, + "$desc has a version(): $version" + ); + diag $@ if $@; + isa_ok( $version, 'version', "$desc version()" ); + + # version_dbd + my $version_dbd; + ok( eval { $version_dbd = $driver->dbd_version() }, + "$desc has a dbd_version(): $version_dbd" + ); + diag $@ if $@; + + # driver_dsn, username, password, connection_info + ok( $driver->driver_dsn(), "$desc has a driver_dsn()" ); + ok( defined $driver->username(), "$desc has a username()" ); + ok( defined $driver->password(), "$desc has a password()" ); + is_deeply( + [ $driver->connection_info() ], + [ map { $driver->$_ } qw< driver_dsn username password > ], + "$desc has a connection_info()" + ); + } + } +} + +# get all loaded drivers +@drivers = Test::Database->list_drivers(); +cmp_ok( scalar @drivers, '>=', 1, 'At least one driver loaded' ); + +# unload them +Test::Database->clean_config(); +@drivers = Test::Database->list_drivers(); +is( scalar @drivers, 0, 'All drivers were unloaded' ); + diff --git a/t/10-list_drivers.t b/t/10-list_drivers.t new file mode 100644 index 0000000..b7aa77f --- /dev/null +++ b/t/10-list_drivers.t @@ -0,0 +1,33 @@ +use strict; +use warnings; +use Test::More; +use Test::Database; + +# hardcoded sorted list of our drivers +my @all_drivers = sort qw( CSV DBM Pg SQLite SQLite2 mysql ); + +# intersection with DBI->available_drivers +my %all_drivers = map { $_ => 1 } @all_drivers; +my @available_drivers + = sort grep { exists $all_drivers{$_} } DBI->available_drivers; + +plan tests => 3; + +# minimal setup +Test::Database->clean_config(); +Test::Database->load_drivers(); + +# existing Test::Database::Driver:: drivers +is_deeply( [ Test::Database->list_drivers('all') ], + \@all_drivers, q{list_drivers('all')} ); + +# available DBI drivers +is_deeply( [ Test::Database->list_drivers('available') ], + \@available_drivers, q{list_drivers('available')} ); + +# available DBI drivers we could load (should only be file-based) +my @filebased + = grep { "Test::Database::Driver::$_"->is_filebased() } @available_drivers; +is_deeply( [ Test::Database->list_drivers() ], \@filebased, + 'list_drivers()' ); + diff --git a/t/11-available_dbname.t b/t/11-available_dbname.t new file mode 100644 index 0000000..57e180e --- /dev/null +++ b/t/11-available_dbname.t @@ -0,0 +1,44 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Driver; + +# fake the databases() method +my @db; +{ + no strict; + @{"Test::Database::Driver::Zlonk::ISA"} = qw( Test::Database::Driver ); + *{"Test::Database::Driver::Zlonk::databases"} = sub {@db}; +} + +# our test plans +my @names = ( 0, 1, 3, 2, 4 ); +my @expected = ( 0, 1, 2, 2, 4, 5 ); + +plan tests => 4 + @expected; + +# check the basename +like( Test::Database::Driver::Zlonk->_basename(), + qr/^tdd_zlonk_\w+_$/, "_basename looks correct" ); + +# test _set_key +my $bad = 'a b c'; +ok( !eval { Test::Database::Driver->_set_key($bad); 1 }, "Bad key: $bad" ); +like( $@, qr/^Invalid format for key '$bad' at/, 'Expected error message' ); + +# set a correct key +Test::Database::Driver->_set_key('clunk'); +like( Test::Database::Driver::Zlonk->_basename(), + qr/^tdd_zlonk_\w+_clunk_$/, "_basename looks correct (with key)" ); + +# now correctly compute our expectations +my $dbname = Test::Database::Driver::Zlonk->_basename(); +@names = map {"$dbname$_"} @names; +@expected = map {"$dbname$_"} @expected; + +for my $expected (@expected) { + is( Test::Database::Driver::Zlonk->available_dbname(), + $expected, "available_dbname() = $expected" ); + push @db, shift @names; +} + diff --git a/t/11-make_dsn.t b/t/11-make_dsn.t new file mode 100644 index 0000000..7d56afd --- /dev/null +++ b/t/11-make_dsn.t @@ -0,0 +1,40 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Driver; +use version; + +# test version_matches() on a dummy driver + +my @tests = ( + [ '', 'dbi:Dummy:' ], + [ '', 'dbi:Dummy:bam=boff', qw( bam boff ) ], + [ '', 'dbi:Dummy:bam=boff;z_zwap=plop', qw( bam boff z_zwap plop ) ], + [ 'dbi:Dummy:bam=boff', 'dbi:Dummy:bam=boff;z_zwap=plop', + qw( z_zwap plop ) + ], + [ 'dbi:Dummy:bam=boff', + 'dbi:Dummy:bam=boff;z_zwap=plop;zowie=sock', + qw( z_zwap plop zowie sock ) + ], +); + +@Test::Database::Driver::Dummy::ISA = qw( Test::Database::Driver ); + +plan tests => scalar @tests; + +for my $t (@tests) { + my ( $driver_dsn, $dsn, @args ) = @$t; + my $driver = bless { driver_dsn => $driver_dsn }, + 'Test::Database::Driver::Dummy'; + + my $got = $driver->make_dsn(@args); + is( $got, $dsn, $driver->driver_dsn() . ' ' . to_string(@args) ); +} + +sub to_string { + my %args = @_; + return + '( ' . join( ', ', map {"$_ => $args{$_}"} sort keys %args ) . ' )'; +} + diff --git a/t/11-version_matches.t b/t/11-version_matches.t new file mode 100644 index 0000000..5e64ea3 --- /dev/null +++ b/t/11-version_matches.t @@ -0,0 +1,88 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Driver; +use version; + +# test version_matches() on a dummy driver + +my @requests; + +my @ok = ( + {}, + { version => '1.2.3' }, + { min_version => '1.2.2' }, + { min_version => '1.2.3' }, + { max_version => '1.3.0' }, + { version => '1.2.3', min_version => '1.2.0' }, + { version => '1.2.3', max_version => '1.4.3' }, + { min_version => '1.2.0', max_version => '2.0' }, + { version => '1.2.3', min_version => '1.2.0', max_version => '2.0' }, + { regex_version => qr/^1\.2/ }, +); + +my @ok_beta + = map { my %r = %$_; $r{version} = '1.2.3-beta' if $r{version}; \%r } @ok; +push @ok_beta, { regex_version => qr/beta/ }; + +my @not_ok = ( + { min_version => '1.3.0' }, + { max_version => '1.002' }, + { max_version => '1.2.3' }, + { version => '1.2.3-beta' }, + { version => '1.3.4' }, + { min_version => '1.3.0', max_version => '2.1' }, + { min_version => '0.1.3', max_version => '1.002' }, + { regex_version => qr/^1\.2\.[1245]$/ }, + { regex_version => qr/^1\.2$/ }, +); + +my @not_ok_beta = map { + my %r = %$_; + $r{version} = '1.2.3' if $r{version} && $r{version} eq '1.2.3-beta'; + \%r +} @not_ok; + +# define our dummy class +package Test::Database::Driver::Dummy; +our @ISA = qw( Test::Database::Driver ); +sub _version { $_[0]{xxx} || '1.2.3' } + +package main; +my $driver = bless {}, 'Test::Database::Driver::Dummy'; +my $driver_beta = bless { xxx => '1.2.3-beta' }, + 'Test::Database::Driver::Dummy'; + +plan tests => @ok + @not_ok + @ok_beta + @not_ok_beta; + +for my $request (@ok) { + ok( $driver->version_matches($request), + to_string($request) . ' matches driver' + ); +} + +for my $request (@not_ok) { + ok( !$driver->version_matches($request), + to_string($request) . ' does not match driver' ); +} + +for my $request (@ok_beta) { + ok( $driver_beta->version_matches($request), + to_string($request) . ' matches beta driver' + ); +} + +for my $request (@not_ok_beta) { + ok( !$driver_beta->version_matches($request), + to_string($request) . ' does not match beta driver' + ); +} + +sub to_string { + my ($request) = @_; + return + '{ ' + . join( ', ', map {"$_ => $request->{$_}"} sort keys %$request ) + . ' }'; +} + diff --git a/t/12-load.t b/t/12-load.t new file mode 100644 index 0000000..b18640c --- /dev/null +++ b/t/12-load.t @@ -0,0 +1,56 @@ +use strict; +use warnings; +use Test::More; +use Test::Database::Util; +use File::Spec; + +my @good = ( + { dsn => 'dbi:mysql:database=mydb;host=localhost;port=1234', + username => 'user', + password => 's3k r3t', + }, + { dsn => 'dbi:mysql:database=mydb;host=remotehost;port=5678', + username => 'otheruser', + }, + { dsn => 'dbi:SQLite:db.sqlite' }, + { driver_dsn => 'dbi:mysql:host=remotehost;port=5678', + username => 'otheruser', + }, +); + +my @bad = ( + [ File::Spec->catfile(qw< t database.bad >), + qr/^Can't parse line at .*, line \d+:\n <bad format> at / + ], + [ File::Spec->catfile(qw< t database.bad2 >), + qr/^Record doesn't start with dsn or driver_dsn .*, line \d+:\n <drh = dbi:mysql:> at / + ], + [ 'missing', qr/^Can't open missing for reading: / ], +); + +plan tests => 1 + @good + 2 * @bad + 1; + +# load a correct file +my $file = File::Spec->catfile(qw< t database.good >); +my @config = _read_file($file); + +is( scalar @config, scalar @good, + "Got @{[scalar @good]} handles from $file" ); + +for my $test (@good) { + my $args = shift @config; + is_deeply( $args, $test, + "Read args for handle " . ( $test->{dsn} || $test->{driver_dsn} ) ); +} + +# try to load a bad file +for my $t (@bad) { + my ( $file, $regex ) = @$t; + ok( !eval { _read_file($file); 1 }, "_read_file( $file ) failed" ); + like( $@, $regex, 'Expected error message' ); +} + +# load an empty file +$file = File::Spec->catfile(qw< t database.empty >); +is( scalar _read_file($file), 0, 'Empty file' ); + diff --git a/t/20-handles.t b/t/20-handles.t new file mode 100644 index 0000000..be2fdbb --- /dev/null +++ b/t/20-handles.t @@ -0,0 +1,106 @@ +use strict; +use warnings; +use Test::More; +use File::Spec; +use Test::Database; + +my %handle = ( + mysql1 => Test::Database::Handle->new( + dsn => 'dbi:mysql:database=mydb;host=localhost;port=1234', + username => 'user', + password => 's3k r3t', + ), + mysql2 => Test::Database::Handle->new( + dsn => 'dbi:mysql:database=mydb;host=remotehost;port=5678', + username => 'otheruser', + ), + sqlite => Test::Database::Handle->new( dsn => 'dbi:SQLite:db.sqlite', ), +); +delete $_->{driver} for values %handle; + +# test description: +# 1st char is variable to look at: array (@) or scalar ($) +# 2nd char is expected result: list (@), single item ($) or number (1) +my @code; +my %tests = map { + my ( $fmt, $code ) = split / /, $_, 2; + push @code, $code; + ( $code => $fmt ) +} split /\n/, << 'CODE'; +@@ @handles = Test::Database->handles(@requests); +$1 $handle = Test::Database->handles(@requests); +$$ $handle = ( Test::Database->handles(@requests) )[0]; +$$ ($handle) = Test::Database->handles(@requests); +$$ $handle = Test::Database->handle(@requests); +@$ @handles = Test::Database->handle(@requests); +CODE + +my @tests = ( + + # request, expected response + [ [], [ @handle{qw( mysql1 mysql2 sqlite )} ], '' ], + [ ['mysql'], [ @handle{qw( mysql1 mysql2 )} ], q{'mysql'} ], + [ ['sqlite'], [], q{'sqlite'} ], + [ ['SQLite'], [ $handle{sqlite} ], q{'SQLite'} ], + [ ['Oracle'], [], q{'Oracle'} ], + [ [ 'SQLite', 'mysql' ], + [ @handle{qw( mysql1 mysql2 sqlite )} ], + q{'SQLite', 'mysql'} + ], + [ [ 'mysql', 'SQLite', 'mysql' ], + [ @handle{qw( mysql1 mysql2 sqlite )} ], + q{'mysql', 'SQLite', 'mysql'} + ], + [ [ 'mysql', 'Oracle', 'SQLite' ], + [ @handle{qw( mysql1 mysql2 sqlite )} ], + q{'Oracle', 'mysql', 'SQLite'} + ], + [ [ { dbd => 'mysql' } ], [ @handle{qw( mysql1 mysql2 )} ], q{'mysql'} ], + [ [ { driver => 'mysql' } ], + [ @handle{qw( mysql1 mysql2 )} ], + q{'mysql'} + ], + +); + +# reset the internal structures and force loading our test config +Test::Database->clean_config(); +my $config = File::Spec->catfile( 't', 'database.rc' ); +Test::Database->load_config( $config ); + +plan tests => @tests * keys %tests; + +for my $test (@tests) { + my ( $requests, $responses, $desc ) = @$test; + my %expected = ( + '1' => [ scalar @$responses ], + '$' => [ $responses->[0] ], + '@' => $responses, + '0' => [], + ); + + # try out each piece of code + my @requests = @$requests; + for my $code (@code) { + my ( $handle, @handles ); + my ( $got, $expected ) = split //, $tests{$code}; + + # special case + $expected = '0' if $tests{$code} eq '@$' && !@$responses; + + # run the code + eval "$code; 1;" or do { + ok( 0, $code ); + diag $@; + next; + }; + ( my $mesg = $code ) =~ s/\@requests/$desc/; + $got + = $got eq '$' ? [$handle] + : $got eq '@' ? \@handles + : die "Unknown variable symbol $got"; + ref && delete $_->{driver} for @$got; + is_deeply( $got, $expected{$expected}, $mesg ); + } +} + diff --git a/t/25-sql.t b/t/25-sql.t new file mode 100644 index 0000000..6f6d8d0 --- /dev/null +++ b/t/25-sql.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +use Test::More; +use File::Spec; + +# DBD::DBM uses SQL::Statement if available +# but SQL::Statement versions > 1.20 make the test fail +# (see RT #56463, #56561) +BEGIN { + if ( eval { require SQL::Statement; $SQL::Statement::VERSION > 1.20; } ) { + $ENV{DBI_SQL_NANO} = 1; + } +} + +use Test::Database; + +my @drivers = Test::Database->drivers(); +@drivers = grep { + my $name = $_->name(); + grep { $name eq $_ } @ARGV +} @drivers if @ARGV; + +plan skip_all => 'No drivers available for testing' if !@drivers; + +# some SQL statements to try out +my @sql = ( + q{CREATE TABLE users (id INTEGER, name VARCHAR(64))}, + q{INSERT INTO users (id, name) VALUES (1, 'book')}, + q{INSERT INTO users (id, name) VALUES (2, 'echo')}, +); +my $select = "SELECT id, name FROM users"; +my $drop = 'DROP TABLE users'; + +plan tests => ( 1 + ( 3 + @sql + 1 ) * 2 + 1 + 2) * @drivers; + +for my $driver (@drivers) { + my $drname = $driver->name(); + diag "Testing driver $drname " . $driver->version() + . ", DBD::$drname " . $driver->dbd_version(); + isa_ok( $driver, 'Test::Database::Driver' ); + + my $count = 0; + my $old; + for my $request ( + $drname, + { dbd => $drname }, + ) + { + + # database handle to a database (created by the driver) + my ($handle) = Test::Database->handles($request); + my $dbname = $handle->{name}; + isa_ok( $handle, 'Test::Database::Handle', "$drname $dbname" ); + + # check we always get the same database, when it's created + is( $dbname, $old, "Got db $old again" ) if $old; + $old ||= $dbname; + + # do some tests on the dbh + my $desc = "$drname($dbname)"; + my $dbh = $handle->dbh(); + isa_ok( $dbh, 'DBI::db' ); + + # create some information + ok( $dbh->do($_), "$desc: $_" ) for @sql; + + # check the data is there + my $lines = $dbh->selectall_arrayref($select); + is_deeply( + $lines, + [ [ 1, 'book' ], [ 2, 'echo' ] ], + "$desc: $select" + ); + + # remove everything + ok( $dbh->do($drop), "$desc: $drop" ); + $dbh->disconnect(); + } + + ok( grep ( { $_ eq $old } $driver->databases() ), + "Database $old still there" ); + $driver->drop_database($old); + ok( !grep ( { $_ eq $old } $driver->databases() ), + "Database $old was dropped" ); +} + diff --git a/t/database.bad b/t/database.bad new file mode 100644 index 0000000..b72ee06 --- /dev/null +++ b/t/database.bad @@ -0,0 +1,14 @@ +# example correct .test-database.rc file + +# mysql +driver_dsn = mysql +host = localhost +username = root +password = "s3k r3t" + +bad format + +driver = SQLite + +driver = CSV + diff --git a/t/database.bad2 b/t/database.bad2 new file mode 100644 index 0000000..e779a94 --- /dev/null +++ b/t/database.bad2 @@ -0,0 +1,3 @@ +drh = dbi:mysql: +username = root + diff --git a/t/database.empty b/t/database.empty new file mode 100644 index 0000000..cc0dae7 --- /dev/null +++ b/t/database.empty @@ -0,0 +1,4 @@ +# example correct .test-database.rc file + +# but empty + diff --git a/t/database.good b/t/database.good new file mode 100644 index 0000000..28b8a7d --- /dev/null +++ b/t/database.good @@ -0,0 +1,17 @@ +# example correct .test-database.rc file + +# mysql +dsn = dbi:mysql:database=mydb;host=localhost;port=1234 +username = user +password = s3k r3t + +# another +dsn = dbi:mysql:database=mydb;host=remotehost;port=5678 +username = otheruser + +# sqlite +dsn = dbi:SQLite:db.sqlite + +# a database driver +driver_dsn = dbi:mysql:host=remotehost;port=5678 +username = otheruser diff --git a/t/database.rc b/t/database.rc new file mode 100644 index 0000000..f6349c9 --- /dev/null +++ b/t/database.rc @@ -0,0 +1,14 @@ +# example correct .test-database.rc file + +# mysql +dsn = dbi:mysql:database=mydb;host=localhost;port=1234 +username = user +password = s3k r3t + +# another +dsn = dbi:mysql:database=mydb;host=remotehost;port=5678 +username = otheruser + +# sqlite +dsn = dbi:SQLite:db.sqlite + diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..4aec937 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,40 @@ +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod::Coverage +my $min_tpc = 1.08; +eval "use Test::Pod::Coverage $min_tpc"; +plan skip_all => + "Test::Pod::Coverage $min_tpc required for testing POD coverage" + if $@; + +# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, +# but older versions don't recognize some common documentation styles +my $min_pc = 0.18; +eval "use Pod::Coverage $min_pc"; +plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" + if $@; + +my @drivers; +my @modules + = grep { $_ ne 'Test::Database' } + grep { !/Driver::/ or push @drivers, $_ and 0 } all_modules(); + +plan tests => @modules + @drivers + 1; + +# Test::Database exports are not documented +pod_coverage_ok( 'Test::Database', { trustme => [qr/^test_db_\w+$/] } ); + +# no exception for those modules +pod_coverage_ok($_) for @modules; + +# the drivers methods are documented Test::Database::Driver +pod_coverage_ok( + $_, + { trustme => [ + qr/^(?:(?:create|drop)_database|databases|dsn|is_filebased|cleanup|essentials)$/ + ] + } +) for @drivers; + @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok(); |