Test-Database-1.11000755001750001750 011367653105 13133 5ustar00bookbook000000000000Build.PL000444001750001750 142611367653105 14510 0ustar00bookbook000000000000Test-Database-1.11use 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) ', 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(); Makefile.PL000444001750001750 116011367653105 15161 0ustar00bookbook000000000000Test-Database-1.11use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::Database', AUTHOR => 'Philippe Bruhat (BooK) ', 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-*' }, ); README000444001750001750 244611367653105 14077 0ustar00bookbook000000000000Test-Database-1.11Test-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. Changes000444001750001750 1231711367653105 14530 0ustar00bookbook000000000000Test-Database-1.11Revision 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 META.yml000444001750001750 234411367653105 14465 0ustar00bookbook000000000000Test-Database-1.11--- name: Test-Database version: 1.11 author: - 'Philippe Bruhat (BooK) ' 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 MANIFEST000444001750001750 130311367653105 14337 0ustar00bookbook000000000000Test-Database-1.11Build.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 lib000755001750001750 011367653105 13622 5ustar00bookbook000000000000Test-Database-1.11Test000755001750001750 011367653105 14541 5ustar00bookbook000000000000Test-Database-1.11/libDatabase.pm000444001750001750 3010311367653105 16755 0ustar00bookbook000000000000Test-Database-1.11/lib/Testpackage 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 I See L for the thread that led to the creation of C. C provides a simple way for test authors to request a test database, without worrying about environment variables or the test host configuration. See L for typical usage. =head1 METHODS C provides the following methods: =over 4 =item list_drivers( [$type] ) Return a list of driver names of the given "type". C returns the list of all existing C subclasses. C returns the list of C subclasses for which the matching C class is available. Called with no parameter (or anything not matching C or C), it will return the list of currently loaded drivers. =item drivers() Returns the C instances that are setup by C and updated by C. =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 objects that match the given C<@requests>. If C<@requests> is not provided, return all the available handles. See L for details about writing requests. =item handle( @request ) I version of C, that returns the first matching handle. =back =head1 REQUESTS The C method takes I as parameters. A request is a simple hash reference, with a number of recognized keys. =over 4 =item * C: driver name (based on the C name). C is an alias for C. If the two keys are present, the C key will be ignored. If missing, all available drivers will match. =item * C: exact database engine version Only database engines having a version string identical to the given version string will match. =item * C: minimum database engine version Only database engines having a version number greater or equal to the given minimum version will match. =item * C: maximum database engine version Only database engines having a version number lower (and not equal) to the given maximum version will match. =item * C: 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, C or C 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 and C keys are optional and empty strings will be used if they are not provided. Empty lines and comments are ignored. Optionaly, the C section is used to add a "unique" element to the databases created by the drivers (as defined by C). It allows several hosts to share access to the same database server without risking a race condition when creating a new database. See L 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<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. 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 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =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<< >> for early comments. Thanks to Nelson Ferraz for writing C, 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 Database000755001750001750 011367653105 16245 5ustar00bookbook000000000000Test-Database-1.11/lib/TestHandle.pm000444001750001750 600311367653105 20132 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Databasepackage 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 is a very simple class for encapsulating the information about a test database handle. C 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 provides the following methods: =over 4 =item new( %args ) Return a new C with the given parameters (C, C, C). The only mandatory argument is C. =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, C, C). =item dbh( [ $attr ] ) Return the DBI database handle obtained when connecting with the connection triplet returned by C. The optional parameter C<$attr> is a reference to a hash of connection attributes, passed directly to DBI's C method. =item name() Return the database name attached to the handle. =item dbd() Return the DBI driver name, as computed from the C. =item driver() Return the C object attached to the handle. =back =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 Driver.pm000444001750001750 3104611367653105 20217 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Databasepackage 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 is a base class for creating C drivers. =head1 METHODS The class provides the following methods: =over 4 =item new( %args ) Create a new C object. If called as C<< Test::Database::Driver->new() >>, requires a C parameter to define the actual object class. =item make_handle() Create a new C 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 based on the information in the mapper. See L 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 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). =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 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. =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, C, C). =item version_matches( $request ) Return a boolean indicating if the driver's version matches the version constraints in the given request (see L 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 contains a good template for writing a C 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 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, 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 store useful information in the system's temporary directory, under a directory named F (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 are stored here, under names matching F_B>, where B is the lowercased name of the driver and B is a number. =item the F file A YAML file containing a C / database name mapping, to enable a given test suite to receive the same database handles in all the test scripts that call the Chandles()> method. =back =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 Tutorial.pod000444001750001750 2705511367653105 20742 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database=head1 NAME Test::Database::Tutorial - How to use Test::Database =head1 INTRODUCTION The goal of the C 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 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 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 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. =head1 MODULE AND TEST AUTHOR C 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). The handles returned are objects of the C class. The data contained in the database is never destroyed or cleaned up by C, 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 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 and C 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 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 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 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 sections for file-based drivers (at least the ones that have a corresponding C), since the module will automatically detect the available ones and create databases as needed. To find out which of the DBD that C 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 from the point of view of a tester is: "configure once, test everything". As a CPAN tester, once you have installed C, you should edit the local equivalent of F<~/.test-database> for the user that will be running the CPAN test suites. =head2 C versus C C 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 sections define the information needed to connect to a database engine (a "driver") with sufficient rights to run a C command. This allows C 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 is able to detect available file-based engines and use them as needed. Other database engines like C and C 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, I had to edit the F file in F to make sure anyone would be able to connect as the C 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 (using a configured C have a name built after the following template: C_I_I>, where I is the DBD name, I is the login of the user running C and I a number that If the same database server is used by several host running C 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 section to the F<~/.test-database> configuration file. If the C entry exists, the template used by C to create new databases is C_I_I_I>. =head2 Cleaning the test drivers When given a C, C 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 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 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 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 currently supports the following DBD drivers: C, C, C, C, C, C. Adding a new driver requires writing a corresponding C subclass, having the same name as the original C driver. An example module is provided in F, and the other drivers can also be used as an example. See also the I section in the documentation for C. =head1 WHERE DO DSN COME FROM? The following ASCII-art graph shows where the C objects returned by the C 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 method works: =over 4 =item * C maintains a list of C objects computed from the DSN listed in the configuration. The handles matching the request are selected. =item * C also maintains a list of C 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 objects. =item * Finally, all the collected C objects are returned. =back So, without any configuration, C will only be able to provide file-based databases. It is also recommended to B put DSN or driver information for the file-based database engines that have a corresponding C class, since it will cause C to return several handles for the same database engine. =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 Util.pm000444001750001750 412111367653105 17653 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Databasepackage 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 exports a collection of functions used by several modules in the C distribution. =head1 EXPORTED FUNCTIONS All functions provided by C 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<< >> =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 Driver000755001750001750 011367653105 17500 5ustar00bookbook000000000000Test-Database-1.11/lib/Test/DatabaseDBM.pm000444001750001750 221511367653105 20575 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 SQLite.pm000444001750001750 220511367653105 21333 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 CSV.pm000444001750001750 220311367653105 20623 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 Pg.pm000444001750001750 413311367653105 20542 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =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 =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 mysql.pm000444001750001750 366011367653105 21345 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =head1 ACKNOWLEDGEMENTS Many thanks to Kristian Köhntopp who helped me while writing a previous version of this module (before C 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 SQLite2.pm000444001750001750 221311367653105 21414 0ustar00bookbook000000000000Test-Database-1.11/lib/Test/Database/Driverpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 eg000755001750001750 011367653105 13447 5ustar00bookbook000000000000Test-Database-1.11MyDriver.pm000444001750001750 322611367653105 15706 0ustar00bookbook000000000000Test-Database-1.11/egpackage 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 driver for C. =head1 SEE ALSO L =head1 AUTHOR Philippe Bruhat (BooK), C<< >> =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 t000755001750001750 011367653105 13317 5ustar00bookbook000000000000Test-Database-1.1111-make_dsn.t000444001750001750 200611367653105 15637 0ustar00bookbook000000000000Test-Database-1.11/tuse 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 ) . ' )'; } 20-handles.t000444001750001750 622411367653105 15502 0ustar00bookbook000000000000Test-Database-1.11/tuse 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 ); } } 00-load.t000444001750001750 53211367653105 14755 0ustar00bookbook000000000000Test-Database-1.11/tuse 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"); pod.t000444001750001750 35011367653105 14401 0ustar00bookbook000000000000Test-Database-1.11/t#!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(); 10-drivers.t000444001750001750 644011367653105 15541 0ustar00bookbook000000000000Test-Database-1.11/tuse 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' ); 09-handle-dsn.t000444001750001750 212011367653105 16077 0ustar00bookbook000000000000Test-Database-1.11/tuse 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 ); database.empty000444001750001750 6711367653105 16243 0ustar00bookbook000000000000Test-Database-1.11/t# example correct .test-database.rc file # but empty 10-list_drivers.t000444001750001750 171511367653105 16574 0ustar00bookbook000000000000Test-Database-1.11/tuse 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()' ); 12-load.t000444001750001750 305411367653105 15002 0ustar00bookbook000000000000Test-Database-1.11/tuse 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 at / ], [ File::Spec->catfile(qw< t database.bad2 >), qr/^Record doesn't start with dsn or driver_dsn .*, line \d+:\n 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' ); 11-version_matches.t000444001750001750 440211367653105 17251 0ustar00bookbook000000000000Test-Database-1.11/tuse 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 ) . ' }'; } database.rc000444001750001750 43111367653105 15524 0ustar00bookbook000000000000Test-Database-1.11/t# 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 11-available_dbname.t000444001750001750 233011367653105 17304 0ustar00bookbook000000000000Test-Database-1.11/tuse 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; } database.good000444001750001750 56511367653105 16060 0ustar00bookbook000000000000Test-Database-1.11/t# 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 database.bad2000444001750001750 4711367653105 15713 0ustar00bookbook000000000000Test-Database-1.11/tdrh = dbi:mysql: username = root database.bad000444001750001750 25511367653105 15652 0ustar00bookbook000000000000Test-Database-1.11/t# example correct .test-database.rc file # mysql driver_dsn = mysql host = localhost username = root password = "s3k r3t" bad format driver = SQLite driver = CSV pod-coverage.t000444001750001750 214111367653105 16212 0ustar00bookbook000000000000Test-Database-1.11/tuse 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; 08-handle.t000444001750001750 253311367653105 15324 0ustar00bookbook000000000000Test-Database-1.11/tuse 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; } } 25-sql.t000444001750001750 453711367653105 14675 0ustar00bookbook000000000000Test-Database-1.11/tuse 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" ); }