DBD-Mock-1.45/0000755000175000017500000000000012041122556012557 5ustar marianomarianoDBD-Mock-1.45/META.json0000664000175000017500000000160112041122556014200 0ustar marianomariano{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DBD-Mock", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DBI" : "1.3", "Test::Exception" : "0.31", "Test::More" : "0.47" } } }, "release_status" : "stable", "version" : "1.45" } DBD-Mock-1.45/Makefile.PL0000644000175000017500000000065511654534326014552 0ustar marianomariano# Note: this file was auto-generated by Module::Build::Compat version 0.30 require 5.6.0; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'DBD::Mock', 'VERSION_FROM' => 'lib/DBD/Mock.pm', 'PREREQ_PM' => { 'DBI' => '1.3', 'Test::More' => '0.47', 'Test::Exception' => '0.31' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ); DBD-Mock-1.45/lib/0000755000175000017500000000000012041122556013325 5ustar marianomarianoDBD-Mock-1.45/lib/DBD/0000755000175000017500000000000012041122556013716 5ustar marianomarianoDBD-Mock-1.45/lib/DBD/Mock.pm0000644000175000017500000011263612041122521015146 0ustar marianomarianopackage DBD::Mock; # --------------------------------------------------------------------------- # # Copyright (c) 2004-2007 Stevan Little, Chris Winters # (spawned from original code Copyright (c) 1994 Tim Bunce) # --------------------------------------------------------------------------- # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # --------------------------------------------------------------------------- # use 5.008001; use strict; use warnings; use DBI; use DBD::Mock::dr; use DBD::Mock::db; use DBD::Mock::st; use DBD::Mock::StatementTrack; use DBD::Mock::StatementTrack::Iterator; use DBD::Mock::Session; use DBD::Mock::Pool; use DBD::Mock::Pool::db; sub import { shift; $DBI::connect_via = "DBD::Mock::Pool::connect" if ( @_ && lc( $_[0] ) eq "pool" ); } our $VERSION = '1.45'; our $drh = undef; # will hold driver handle our $err = 0; # will hold any error codes our $errstr = ''; # will hold any error messages sub driver { return $drh if defined $drh; my ( $class, $attributes ) = @_; $attributes = {} unless ( defined($attributes) && ( ref($attributes) eq 'HASH' ) ); $drh = DBI::_new_drh( "${class}::dr", { Name => 'Mock', Version => $DBD::Mock::VERSION, Attribution => 'DBD Mock driver by Chris Winters & Stevan Little (orig. from Tim Bunce)', Err => \$DBD::Mock::err, Errstr => \$DBD::Mock::errstr, # mock attributes mock_connect_fail => 0, # and pass in any extra attributes given %{$attributes} } ); return $drh; } sub CLONE { undef $drh } # NOTE: # this feature is still quite experimental. It is defaulted to # be off, but it can be turned on by doing this: # $DBD::Mock::AttributeAliasing++; # and then turned off by doing: # $DBD::Mock::AttributeAliasing = 0; # we shall see how this feature works out. our $AttributeAliasing = 0; my %AttributeAliases = ( mysql => { db => { # aliases can either be a string which is obvious mysql_insertid => 'mock_last_insert_id' }, st => { # but they can also be a subroutine reference whose # first argument will be either the $dbh or the $sth # depending upon which context it is aliased in. mysql_insertid => sub { (shift)->{Database}->{'mock_last_insert_id'} } } }, ); sub _get_mock_attribute_aliases { my ($dbname) = @_; ( exists $AttributeAliases{ lc($dbname) } ) || die "Attribute aliases not available for '$dbname'"; return $AttributeAliases{ lc($dbname) }; } sub _set_mock_attribute_aliases { my ( $dbname, $dbh_or_sth, $key, $value ) = @_; return $AttributeAliases{ lc($dbname) }->{$dbh_or_sth}->{$key} = $value; } ## Some useful constants use constant NULL_RESULTSET => [ [] ]; 1; __END__ =head1 NAME DBD::Mock - Mock database driver for testing =head1 SYNOPSIS use DBI; # connect to your as normal, using 'Mock' as your driver name my $dbh = DBI->connect( 'DBI:Mock:', '', '' ) || die "Cannot create handle: $DBI::errstr\n"; # create a statement handle as normal and execute with parameters my $sth = $dbh->prepare( 'SELECT this, that FROM foo WHERE id = ?' ); $sth->execute( 15 ); # Now query the statement handle as to what has been done with it my $mock_params = $sth->{mock_params}; print "Used statement: ", $sth->{mock_statement}, "\n", "Bound parameters: ", join( ', ', @{ $mock_params } ), "\n"; =head1 DESCRIPTION Testing with databases can be tricky. If you are developing a system married to a single database then you can make some assumptions about your environment and ask the user to provide relevant connection information. But if you need to test a framework that uses DBI, particularly a framework that uses different types of persistence schemes, then it may be more useful to simply verify what the framework is trying to do -- ensure the right SQL is generated and that the correct parameters are bound. C makes it easy to just modify your configuration (presumably held outside your code) and just use it instead of C (like L or L) in your framework. There is no distinct area where using this module makes sense. (Some people may successfully argue that this is a solution looking for a problem...) Indeed, if you can assume your users have something like L or L or if you do not mind creating a dependency on them then it makes far more sense to use these legitimate driver implementations and test your application in the real world -- at least as much of the real world as you can create in your tests... And if your database handle exists as a package variable or something else easily replaced at test-time then it may make more sense to use L to create a fully dynamic handle. There is an excellent article by chromatic about using L in this and other ways, strongly recommended. (See L for a link) =head2 How does it work? C comprises a set of classes used by DBI to implement a database driver. But instead of connecting to a datasource and manipulating data found there it tracks all the calls made to the database handle and any created statement handles. You can then inspect them to ensure what you wanted to happen actually happened. For instance, say you have a configuration file with your database connection information: [DBI] dsn = DBI:Pg:dbname=myapp user = foo password = bar And this file is read in at process startup and the handle stored for other procedures to use: package ObjectDirectory; my ( $DBH ); sub run_at_startup { my ( $class, $config ) = @_; $config ||= read_configuration( ... ); my $dsn = $config->{DBI}{dsn}; my $user = $config->{DBI}{user}; my $pass = $config->{DBI}{password}; $DBH = DBI->connect( $dsn, $user, $pass ) || die ...; } sub get_database_handle { return $DBH; } A procedure might use it like this (ignoring any error handling for the moment): package My::UserActions; sub fetch_user { my ( $class, $login ) = @_; my $dbh = ObjectDirectory->get_database_handle; my $sql = q{ SELECT login_name, first_name, last_name, creation_date, num_logins FROM users WHERE login_name = ? }; my $sth = $dbh->prepare( $sql ); $sth->execute( $login ); my $row = $sth->fetchrow_arrayref; return ( $row ) ? User->new( $row ) : undef; } So for the purposes of our tests we just want to ensure that: =over 4 =item 1. The right SQL is being executed =item 2. The right parameters are bound =back Assume whether the SQL actually B or not is irrelevant for this test :-) To do that our test might look like: my $config = ObjectDirectory->read_configuration( ... ); $config->{DBI}{dsn} = 'DBI:Mock:'; ObjectDirectory->run_at_startup( $config ); my $login_name = 'foobar'; my $user = My::UserActions->fetch_user( $login_name ); # Get the handle from ObjectDirectory; # this is the same handle used in the # 'fetch_user()' procedure above my $dbh = ObjectDirectory->get_database_handle(); # Ask the database handle for the history # of all statements executed against it my $history = $dbh->{mock_all_history}; # Now query that history record to # see if our expectations match reality is(scalar(@{$history}), 1, 'Correct number of statements executed' ; my $login_st = $history->[0]; like($login_st->statement, qr/SELECT login_name.*FROM users WHERE login_name = ?/sm, 'Correct statement generated' ); my $params = $login_st->bound_params; is(scalar(@{$params}), 1, 'Correct number of parameters bound'); is($params->[0], $login_name, 'Correct value for parameter 1' ); # Reset the handle for future operations $dbh->{mock_clear_history} = 1; The list of properties and what they return is listed below. But in an overall view: =over 4 =item * A database handle contains the history of all statements created against it. Other properties set for the handle (e.g., 'PrintError', 'RaiseError') are left alone and can be queried as normal, but they do not affect anything. (A future feature may track the sequence/history of these assignments but if there is no demand it probably will not get implemented.) =item * A statement handle contains the statement it was prepared with plus all bound parameters or parameters passed via C. It can also contain predefined results for the statement handle to 'fetch', track how many fetches were called and what its current record is. =back =head2 A Word of Warning This may be an incredibly naive implementation of a DBD. But it works for me ... =head1 DBD::Mock Since this is a normal DBI statement handle we need to expose our tracking information as properties (accessed like a hash) rather than methods. =head2 Database Driver Properties =over 4 =item B This is a boolean property which when set to true (C<1>) will not allow DBI to connect. This can be used to simulate a DSN error or authentication failure. This can then be set back to false (C<0>) to resume normal DBI operations. Here is an example of how this works: # install the DBD::Mock driver my $drh = DBI->install_driver('Mock'); $drh->{mock_connect_fail} = 1; # this connection will fail my $dbh = DBI->connect('dbi:Mock:', '', '') || die "Cannot connect"; # this connection will throw an exception my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1 }); $drh->{mock_connect_fail} = 0; # this will work now ... my $dbh = DBI->connect(...); This feature is conceptually different from the 'mock_can_connect' attribute of the C<$dbh> in that it has a driver-wide scope, where 'mock_can_connect' is handle-wide scope. It also only prevents the initial connection, any C<$dbh> handles created prior to setting 'mock_connect_fail' to true (C<1>) will still go on working just fine. =item B This is an ARRAY reference which holds fake data sources which are returned by the Driver and Database Handle's C method. =item B This takes a string and adds it to the 'mock_data_sources' attribute. =back =head2 Database Handle Properties =over 4 =item B Returns an array reference with all history (a.k.a. C) objects created against the database handle in the order they were created. Each history object can then report information about the SQL statement used to create it, the bound parameters, etc.. =item B Returns a C object which will iterate through the current set of C object in the history. See the B documentation below for more information. =item B If set to a true value all previous statement history operations will be erased. This B the history of currently open handles, so if you do something like: my $dbh = get_handle( ... ); my $sth = $dbh->prepare( ... ); $dbh->{mock_clear_history} = 1; $sth->execute( 'Foo' ); You will have no way to learn from the database handle that the statement parameter 'Foo' was bound. This is useful mainly to ensure you can isolate the statement histories from each other. A typical sequence will look like: set handle to framework perform operations analyze mock database handle reset mock database handle history perform more operations analyze mock database handle reset mock database handle history ... =item B This statement allows you to simulate a downed database connection. This is useful in testing how your application/tests will perform in the face of some kind of catastrophic event such as a network outage or database server failure. It is a simple boolean value which defaults to on, and can be set like this: # turn the database off $dbh->{mock_can_connect} = 0; # turn it back on again $dbh->{mock_can_connect} = 1; The statement handle checks this value as well, so something like this will fail in the expected way: $dbh = DBI->connect( 'DBI:Mock:', '', '' ); $dbh->{mock_can_connect} = 0; # blows up! my $sth = eval { $dbh->prepare( 'SELECT foo FROM bar' ) }); if ( $@ ) { # Here, $DBI::errstr = 'No connection present' } Turning off the database after a statement prepare will fail on the statement C, which is hopefully what you would expect: $dbh = DBI->connect( 'DBI:Mock:', '', '' ); # ok! my $sth = eval { $dbh->prepare( 'SELECT foo FROM bar' ) }); $dbh->{mock_can_connect} = 0; # blows up! $sth->execute; Similarly: $dbh = DBI->connect( 'DBI:Mock:', '', '' ); # ok! my $sth = eval { $dbh->prepare( 'SELECT foo FROM bar' ) }); # ok! $sth->execute; $dbh->{mock_can_connect} = 0; # blows up! my $row = $sth->fetchrow_arrayref; Note: The handle attribute C and the handle method C will behave according to the value of C. So if C were to be set to 0 (or off), then both C and C would return false values (or 0). =item B This stocks the database handle with a record set, allowing you to seed data for your application to see if it works properly.. Each recordset is a simple arrayref of arrays with the first arrayref being the fieldnames used. Every time a statement handle is created it asks the database handle if it has any resultsets available and if so uses it. Here is a sample usage, partially from the test suite: my @user_results = ( [ 'login', 'first_name', 'last_name' ], [ 'cwinters', 'Chris', 'Winters' ], [ 'bflay', 'Bobby', 'Flay' ], [ 'alincoln', 'Abe', 'Lincoln' ], ); my @generic_results = ( [ 'foo', 'bar' ], [ 'this_one', 'that_one' ], [ 'this_two', 'that_two' ], ); my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); $dbh->{mock_add_resultset} = \@user_results; # add first resultset $dbh->{mock_add_resultset} = \@generic_results; # add second resultset my ( $sth ); eval { $sth = $dbh->prepare( 'SELECT login, first_name, last_name FROM foo' ); $sth->execute(); }; # this will fetch rows from the first resultset... my $row1 = $sth->fetchrow_arrayref; my $user1 = User->new( login => $row->[0], first => $row->[1], last => $row->[2] ); is( $user1->full_name, 'Chris Winters' ); my $row2 = $sth->fetchrow_arrayref; my $user2 = User->new( login => $row->[0], first => $row->[1], last => $row->[2] ); is( $user2->full_name, 'Bobby Flay' ); ... my $sth_generic = $dbh->prepare( 'SELECT foo, bar FROM baz' ); $sth_generic->execute; # this will fetch rows from the second resultset... my $row = $sth->fetchrow_arrayref; You can also associate a resultset with a particular SQL statement instead of adding them in the order they will be fetched: $dbh->{mock_add_resultset} = { sql => 'SELECT foo, bar FROM baz', results => [ [ 'foo', 'bar' ], [ 'this_one', 'that_one' ], [ 'this_two', 'that_two' ], ], }; This will return the given results when the statement 'SELECT foo, bar FROM baz' is prepared. Note that they will be returned B the statement is prepared, not just the first. It should also be noted that if you want, for some reason, to change the result set bound to a particular SQL statement, all you need to do is add the result set again with the same SQL statement and DBD::Mock will overwrite it. It should also be noted that the C method will return the number of records stocked in the result set. So if your code/application makes use of the C<$sth-Erows> method for things like UPDATE and DELETE calls you should stock the result set like so: $dbh->{mock_add_resultset} = { sql => 'UPDATE foo SET baz = 1, bar = 2', # this will appear to have updated 3 rows results => [[ 'rows' ], [], [], []], }; # or ... $dbh->{mock_add_resultset} = { sql => 'DELETE FROM foo WHERE bar = 2', # this will appear to have deleted 1 row results => [[ 'rows' ], []], }; Now I admit this is not the most elegant way to go about this, but it works for me for now, and until I can come up with a better method, or someone sends me a patch ;) it will do for now. If you want a given statement to fail, you will have to use the hashref method and add a 'failure' key. That key can be handed an arrayref with the error number and error string, in that order. It can also be handed a hashref with two keys - errornum and errorstring. If the 'failure' key has no useful value associated with it, the errornum will be '1' and the errorstring will be 'Unknown error'. =item B This attribute can be used to set up values for get_info(). It takes a hashref of attribute_name/value pairs. See L for more information on the information types and their meaning. =item B This attribute can be used to set a current DBD::Mock::Session object. For more information on this, see the L docs below. This attribute can also be used to remove the current session from the C<$dbh> simply by setting it to C. =item B This attribute is incremented each time an INSERT statement is passed to C on a per-handle basis. It's starting value can be set with the 'mock_start_insert_id' attribute (see below). $dbh->{mock_start_insert_id} = 10; my $sth = $dbh->prepare('INSERT INTO Foo (foo, bar) VALUES(?, ?)'); $sth->execute(1, 2); # $dbh->{mock_last_insert_id} == 10 $sth->execute(3, 4); # $dbh->{mock_last_insert_id} == 11 For more examples, please refer to the test file F. =item B This attribute can be used to set a start value for the 'mock_last_insert_id' attribute. It can also be used to effectively reset the 'mock_last_insert_id' attribute as well. This attribute also can be used with an ARRAY ref parameter, it's behavior is slightly different in that instead of incrementing the value for every C it will only increment for each C. This allows it to be used over multiple C calls in a single C<$sth>. It's usage looks like this: $dbh->{mock_start_insert_id} = [ 'Foo', 10 ]; $dbh->{mock_start_insert_id} = [ 'Baz', 20 ]; my $sth1 = $dbh->prepare('INSERT INTO Foo (foo, bar) VALUES(?, ?)'); my $sth2 = $dbh->prepare('INSERT INTO Baz (baz, buz) VALUES(?, ?)'); $sth1->execute(1, 2); # $dbh->{mock_last_insert_id} == 10 $sth2->execute(3, 4); # $dbh->{mock_last_insert_id} == 20 Note that DBD::Mock's matching of table names in 'INSERT' statements is fairly simple, so if your table names are quoted in the insert statement (C) then you need to quote the name for C: $dbh->{mock_start_insert_id} = [ q{"Foo"}, 10 ]; =item B DBI provides some simple parsing capabilities for 'SELECT' statements to ensure that placeholders are bound properly. And typically you may simply want to check after the fact that a statement is syntactically correct, or at least what you expect. But other times you may want to parse the statement as it is prepared rather than after the fact. There is a hook in this mock database driver for you to provide your own parsing routine or object. The syntax is simple: $dbh->{mock_add_parser} = sub { my ( $sql ) = @_; unless ( $sql =~ /some regex/ ) { die "does not contain secret fieldname"; } }; You can also add more than one for a handle. They will be called in order, and the first one to fail will halt the parsing process: $dbh->{mock_add_parser} = \&parse_update_sql; $dbh->{mock_add-parser} = \&parse_insert_sql; Depending on the 'PrintError' and 'RaiseError' settings in the database handle any parsing errors encountered will issue a C or C. No matter what the statement handle will be C. Instead of providing a subroutine reference you can use an object. The only requirement is that it implements the method C and takes a SQL statement as the only argument. So you should be able to do something like the following (untested): my $parser = SQL::Parser->new( 'mysql', { RaiseError => 1 } ); $dbh->{mock_add_parser} = $parser; =item B & B These properties will dispatch to the Driver's properties of the same name. =back =head2 Database Driver Methods =over 4 =item B This returns the value of C. =back In order to capture begin_work(), commit(), and rollback(), DBD::Mock will create statements for them, as if you had issued them in the appropriate SQL command line program. They will go through the standard prepare()-execute() cycle, meaning that any custom SQL parsers will be triggered and DBD::Mock::Session will need to know about these statements. =over 4 =item B This will create a statement with SQL of "BEGIN WORK" and no parameters. =item B This will create a statement with SQL of "COMMIT" and no parameters. =item B This will create a statement with SQL of "ROLLBACK" and no parameters. =back =head2 Statement Handle Properties =over 4 =item B Returns true if the handle is a 'SELECT' and has more records to fetch, false otherwise. (From the DBI.) =item B The SQL statement this statement handle was Cd with. So if the handle were created with: my $sth = $dbh->prepare( 'SELECT * FROM foo' ); This would return: SELECT * FROM foo The original statement is unmodified so if you are checking against it in tests you may want to use a regex rather than a straight equality check. (However if you use a phrasebook to store your SQL externally you are a step ahead...) =item B Fields used by the statement. As said elsewhere we do no analysis or parsing to find these, you need to define them beforehand. That said, you do not actually need this very often. Note that this returns the same thing as the normal statement property 'FIELD'. =item B Returns an arrayref of parameters bound to this statement in the order specified by the bind type. For instance, if you created and stocked a handle with: my $sth = $dbh->prepare( 'SELECT * FROM foo WHERE id = ? AND is_active = ?' ); $sth->bind_param( 2, 'yes' ); $sth->bind_param( 1, 7783 ); This would return: [ 7738, 'yes' ] The same result will occur if you pass the parameters via C instead: my $sth = $dbh->prepare( 'SELECT * FROM foo WHERE id = ? AND is_active = ?' ); $sth->execute( 7783, 'yes' ); The same using named parameters my $sth = $dbh->prepare( 'SELECT * FROM foo WHERE id = :id AND is_active = :active' ); $sth->bind_param( ':id' => 7783 ); $sth->bind_param( ':active' => 'yes' ); =item B An arrayref of arrayrefs representing the records the mock statement was stocked with. =item B Number of records the mock statement was stocked with; if never stocked it is still 0. (Some weirdos might expect undef...) =item B This returns the same value as I. And is what is returned by the C method of the statement handle. =item B Current record the statement is on; returns 0 in the instances when you have not yet called C and if you have not yet called a C method after the execute. =item B Whether C has been called against the statement handle. Returns 'yes' if so, 'no' if not. =item B Whether C has been called against the statement handle. Returns 'yes' if so, 'no' if not. =item B Returns 'yes' if all the records in the recordset have been returned. If no C was executed against the statement, or If no return data was set this will return 'no'. =item B Returns a C object which tracks the actions performed by this statement handle. Most of the actions are separately available from the properties listed above, so you should never need this. =back =head1 DBD::Mock::Pool This module can be used to emulate Apache::DBI style DBI connection pooling. Just as with Apache::DBI, you must enable DBD::Mock::Pool before loading DBI. use DBD::Mock qw(Pool); # followed by ... use DBI; While this may not seem to make a lot of sense in a single-process testing scenario, it can be useful when testing code which assumes a multi-process Apache::DBI pooled environment. =head1 DBD::Mock::StatementTrack Under the hood this module does most of the work with a C object. This is most useful when you are reviewing multiple statements at a time, otherwise you might want to use the C statement handle attributes instead. =over 4 =item B Takes the following parameters: =over 4 =item * B: Arrayref of return data records =item * B: Arrayref of field names =item * B: Arrayref of bound parameters =back =item B (Statement attribute 'mock_statement') Gets/sets the SQL statement used. =item B (Statement attribute 'mock_fields') Gets/sets the fields to use for this statement. =item B (Statement attribute 'mock_params') Gets/set the bound parameters to use for this statement. =item B (Statement attribute 'mock_records') Gets/sets the data to return when asked (that is, when someone calls 'fetch' on the statement handle). =item B (Statement attribute 'mock_current_record_num') Gets/sets the current record number. =item B (Statement attribute 'Active') Returns true if the statement is a SELECT and has more records to fetch, false otherwise. (This is from the DBI, see the 'Active' docs under 'ATTRIBUTES COMMON TO ALL HANDLES'.) =item B (Statement attribute 'mock_is_executed') Sets the state of the tracker 'executed' flag. =item B (Statement attribute 'mock_is_finished') If set to 'yes' tells the tracker that the statement is finished. This resets the current record number to '0' and clears out the array ref of returned records. =item B (Statement attribute 'mock_is_depleted') Returns true if the current record number is greater than the number of records set to return. =item B Returns the number of fields set in the 'fields' parameter. =item B Returns the number of records in the current result set. =item B Returns the number of parameters set in the 'bound_params' parameter. =item B Sets bound parameter C<$param_num> to C<$value>. Returns the arrayref of currently-set bound parameters. This corresponds to the 'bind_param' statement handle call. =item B Pushes C<@params> onto the list of already-set bound parameters. =item B Tells the tracker that the statement has been executed and resets the current record number to '0'. =item B If the statement has been depleted (all records returned) returns undef; otherwise it gets the current recordfor returning, increments the current record number and returns the current record. =item B Tries to give an decent depiction of the object state for use in debugging. =back =head1 DBD::Mock::StatementTrack::Iterator This object can be used to iterate through the current set of C objects in the history by fetching the 'mock_all_history_iterator' attribute from a database handle. This object is very simple and is meant to be a convience to make writing long test script easier. Aside from the constructor (C) this object has only one method. =over 4 B Calling C will return the next C object in the history. If there are no more C objects available, then this method will return false. B This will reset the internal pointer to the beginning of the statement history. =back =head1 DBD::Mock::Session The DBD::Mock::Session object is an alternate means of specifying the SQL statements and result sets for DBD::Mock. The idea is that you can specify a complete 'session' of usage, which will be verified through DBD::Mock. Here is an example: my $session = DBD::Mock::Session->new('my_session' => ( { statement => "SELECT foo FROM bar", # as a string results => [[ 'foo' ], [ 'baz' ]] }, { statement => qr/UPDATE bar SET foo \= \'bar\'/, # as a reg-exp results => [[]] }, { statement => sub { # as a CODE ref my ($SQL, $state) = @_; return $SQL eq "SELECT foo FROM bar"; }, results => [[ 'foo' ], [ 'bar' ]] }, { # with bound parameters statement => "SELECT foo FROM bar WHERE baz = ? AND borg = ?", # check exact bound param value, # then check it against regexp bound_params => [ 10, qr/\d+/ ], results => [[ 'foo' ], [ 'baz' ]] } )); As you can see, a session is essentially made up a list of HASH references we call 'states'. Each state has a 'statement' and a set of 'results'. If DBD::Mock finds a session in the 'mock_session' attribute, then it will pass the current C<$dbh> and SQL statement to that DBD::Mock::Session. The SQL statement will be checked against the 'statement' field in the current state. If it passes, then the 'results' of the current state will get feed to DBD::Mock through the 'mock_add_resultset' attribute. We then advance to the next state in the session, and wait for the next call through DBD::Mock. If at any time the SQL statement does not match the current state's 'statement', or the session runs out of available states, an error will be raised (and propagated through the normal DBI error handling based on your values for RaiseError and PrintError). Also, as can be seen in the the session element, bound parameters can also be supplied and tested. In this statement, the SQL is compared, then when the statement is executed, the bound parameters are also checked. The bound parameters much match in both number of parameters and the parameters themselves, or an error will be raised. As can also be seen in the example above, 'statement' fields can come in many forms. The simplest is a string, which will be compared using C against the currently running statement. The next is a reg-exp reference, this too will get compared against the currently running statement. The last option is a CODE ref, this is sort of a catch-all to allow for a wide range of SQL comparison approaches (including using modules like SQL::Statement or SQL::Parser for detailed functional comparisons). The first argument to the CODE ref will be the currently active SQL statement to compare against, the second argument is a reference to the current state HASH (in case you need to alter the results, or store extra information). The CODE is evaluated in boolean context and throws and exception if it is false. =over 4 B A C<$session_name> can be optionally be specified, along with at least one C<@session_states>. If you don't specify a C<$session_name>, then a default one will be created for you. The C<@session_states> must all be HASH references as well, if this conditions fail, an exception will be thrown. B This will check the C<$SQL> against the current state's 'statement' value, and if it passes will add the current state's 'results' to the C<$dbh>. If for some reason the 'statement' value is bad, not of the prescribed type, an exception is thrown. See above for more details. B If the 'bound_params' slot is available in the current state, this will check the C<$params> against the current state's 'bound_params' value. Both number of parameters and the parameters themselves must match, or an error will be raised. B Calling this method will reset the state of the session object so that it can be reused. =back =head1 EXPERIMENTAL FUNCTIONALITY All functionality listed here is highly experimental and should be used with great caution (if at all). =over 4 =item Error handling in I We have added experimental erro handling in I the best example is the test file F, but it looks something like this: $dbh->{mock_add_resultset} = { sql => 'SELECT foo FROM bar', results => DBD::Mock->NULL_RESULTSET, failure => [ 5, 'Ooops!' ], }; The C<5> is the DBI error number, and C<'Ooops!'> is the error string passed to DBI. This basically allows you to force an error condition to occur when a given SQL statement is execute. We are currently working on allowing more control on the 'when' and 'where' the error happens, look for it in future releases. =item Attribute Aliasing Basically this feature allows you to alias attributes to other attributes. So for instance, you can alias a commonly expected attribute like 'mysql_insertid' to something DBD::Mock already has like 'mock_last_insert_id'. While you can also just set 'mysql_insertid' yourself, this functionality allows it to take advantage of things like the autoincrementing of the 'mock_last_insert_id' attribute. Right now this feature is highly experimental, and has been added as a first attempt to automatically handle some of the DBD specific attributes which are commonly used/accessed in DBI programming. The functionality is off by default so as to not cause any issues with backwards compatability, but can easily be turned on and off like this: # turn it on $DBD::Mock::AttributeAliasing++; # turn it off $DBD::Mock::AttributeAliasing = 0; Once this is turned on, you will need to choose a database specific attribute aliasing table like so: DBI->connect('dbi:Mock:MySQL', '', ''); The 'MySQL' in the DSN will be picked up and the MySQL specific attribute aliasing will be used. Right now only MySQL is supported by this feature, and even that support is very minimal. Currently the MySQL C<$dbh> and C<$sth> attributes 'mysql_insertid' are aliased to the C<$dbh> attribute 'mock_last_insert_id'. It is possible to add more aliases though, using the C function (see the source code for details). =back =head1 BUGS =over =item Odd $dbh attribute behavior When writing the test suite I encountered some odd behavior with some C<$dbh> attributes. I still need to get deeper into how DBD's work to understand what it is that is actually doing wrong. =back =head1 TO DO =over =item Make DBD specific handlers Each DBD has its own quirks and issues, it would be nice to be able to handle those issues with DBD::Mock in some way. I have an number of ideas already, but little time to sit down and really flesh them out. If you have any suggestions or thoughts, feel free to email me with them. =item Enhance the DBD::Mock::StatementTrack object I would like to have the DBD::Mock::StatementTrack object handle more of the mock_* attributes. This would encapsulate much of the mock_* behavior in one place, which would be a good thing. I would also like to add the ability to bind a subroutine (or possibly an object) to the result set, so that the results can be somewhat more dynamic and allow for a more realistic interaction. =back =head1 SEE ALSO L L, which provided a good starting point L, which provided the approach Test::MockObject article - L Perl Code Kata: Testing Databases - L =head1 DISCUSSION GROUP We have created a B google group for discussion/questions about this module. L =head1 ACKNOWLEDGEMENTS =over 4 =item Thanks to Ryan Gerry for his patch in RT #26604 =item Thanks to Marc Beyer for his patch in RT #16951 =item Thanks to Justin DeVuyst for the mock_connect_fail idea =item Thanks to Thilo Planz for the code for C =item Thanks to Shlomi Fish for help tracking down RT Bug #11515 =item Thanks to Collin Winter for the patch to fix the C, C and C methods. =item Thanks to Andrew McHarg Eamcharg@acm.orgE for C, C and C methods and tests. =item Thanks to Andrew W. Gibbs for the C patch and test =item Thanks to Chas Owens for patch and test for the C, C, and C features. =back =head1 COPYRIGHT Copyright (C) 2004 Chris Winters Echris@cwinters.comE Copyright (C) 2004-2007 Stevan Little Estevan@iinteractive.comE Copyright (C) 2007 Rob Kinyon Erob.kinyon@gmail.comE Copyright (C) 2011 Mariano Wahlmann Edichoso _at_ gmail.comE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Chris Winters Echris@cwinters.comE Stevan Little Estevan@iinteractive.comE Rob Kinyon Erob.kinyon@gmail.comE Mariano Wahlmann Edichoso _at_ gmail.com =cut DBD-Mock-1.45/lib/DBD/Mock/0000755000175000017500000000000012041122556014607 5ustar marianomarianoDBD-Mock-1.45/lib/DBD/Mock/StatementTrack/0000755000175000017500000000000012041122556017540 5ustar marianomarianoDBD-Mock-1.45/lib/DBD/Mock/StatementTrack/Iterator.pm0000644000175000017500000000062411654534326021704 0ustar marianomarianopackage DBD::Mock::StatementTrack::Iterator; use strict; use warnings; sub new { my ( $class, $history ) = @_; bless { pointer => 0, history => $history || [] } => $class; } sub next { my ($self) = @_; return unless $self->{pointer} < scalar( @{ $self->{history} } ); return $self->{history}->[ $self->{pointer}++ ]; } sub reset { (shift)->{pointer} = 0 } 1; DBD-Mock-1.45/lib/DBD/Mock/db.pm0000644000175000017500000002742411655005040015541 0ustar marianomarianopackage DBD::Mock::db; use strict; use warnings; our $imp_data_size = 0; sub ping { my ($dbh) = @_; return $dbh->{mock_can_connect}; } sub last_insert_id { my ($dbh) = @_; return $dbh->{mock_last_insert_id}; } sub get_info { my ( $dbh, $attr ) = @_; $dbh->{mock_get_info} ||= {}; return $dbh->{mock_get_info}{$attr}; } sub prepare { my ( $dbh, $statement ) = @_; unless ( $dbh->{mock_can_connect} ) { $dbh->set_err( 1, "No connection present" ); return; } unless ( $dbh->{mock_can_prepare} ) { $dbh->set_err( 1, "Cannot prepare" ); return; } $dbh->{mock_can_prepare}++ if $dbh->{mock_can_prepare} < 0; eval { foreach my $parser ( @{ $dbh->{mock_parser} } ) { if ( ref($parser) eq 'CODE' ) { $parser->($statement); } else { $parser->parse($statement); } } }; if ($@) { my $parser_error = $@; chomp $parser_error; $dbh->set_err( 1, "Failed to parse statement. Error: ${parser_error}. Statement: ${statement}" ); return; } my $sth = DBI::_new_sth( $dbh, { Statement => $statement } ); $sth->trace_msg( "Preparing statement '${statement}'\n", 1 ); my %track_params = ( statement => $statement ); if ( my $session = $dbh->{mock_session} ) { eval { my $rs = $session->results_for($statement); if ( ref($rs) eq 'ARRAY' && scalar( @{$rs} ) > 0 ) { my $fields = @{$rs}[0]; $track_params{return_data} = $rs; $track_params{fields} = $fields; $sth->STORE( NAME => $fields ); $sth->STORE( NUM_OF_FIELDS => scalar @{$fields} ); } else { $sth->trace_msg( "No return data set in DBH\n", 1 ); } }; if ($@) { $dbh->DBI::set_err( 1, "Session Error: $@. Statement: $statement" ); } } else { # If we have available resultsets seed the tracker with one my $rs; if ( my $all_rs = $dbh->{mock_rs} ) { if ( my $by_name = $all_rs->{named}{$statement} ) { # We want to copy this, because it is meant to be reusable $rs = [ @{ $by_name->{results} } ]; if ( exists $by_name->{failure} ) { $track_params{failure} = [ @{ $by_name->{failure} } ]; } } else { $rs = shift @{ $all_rs->{ordered} }; } } if ( ref($rs) eq 'ARRAY' && scalar( @{$rs} ) > 0 ) { my $fields = shift @{$rs}; $track_params{return_data} = $rs; $track_params{fields} = $fields; $sth->STORE( NAME => $fields ); $sth->STORE( NUM_OF_FIELDS => scalar @{$fields} ); } else { $sth->trace_msg( "No return data set in DBH\n", 1 ); } } # do not allow a statement handle to be created if there is no # connection present. unless ( $dbh->FETCH('Active') ) { $dbh->set_err( 1, "No connection present" ); return; } # This history object will track everything done to the statement my $history = DBD::Mock::StatementTrack->new(%track_params); $sth->STORE( mock_my_history => $history ); # ...now associate the history object with the database handle so # people can browse the entire history at once, even for # statements opened and closed in a black box my $all_history = $dbh->FETCH('mock_statement_history'); push @{$all_history}, $history; return $sth; } *prepare_cached = \&prepare; { my $begin_work_commit; sub begin_work { my $dbh = shift; if ( $dbh->FETCH('AutoCommit') ) { $dbh->STORE( 'AutoCommit', 0 ); $begin_work_commit = 1; my $sth = $dbh->prepare('BEGIN WORK') or return $dbh->set_err( 1, $DBI::errstr ); my $rc = $sth->execute() or return $dbh->set_err( 1, $DBI::errstr ); $sth->finish(); return $rc; } else { return $dbh->set_err( 1, 'AutoCommit is off, you are already within a transaction' ); } } sub commit { my $dbh = shift; if ( $dbh->FETCH('AutoCommit') && $dbh->FETCH('Warn') ) { return $dbh->set_err( 1, "commit ineffective with AutoCommit" ); } my $sth = $dbh->prepare('COMMIT') or return $dbh->set_err( 1, $DBI::errstr ); my $rc = $sth->execute() or return $dbh->set_err( 1, $DBI::errstr ); $sth->finish(); if ($begin_work_commit) { $dbh->STORE( 'AutoCommit', 1 ); $begin_work_commit = 0; } return $rc; } sub rollback { my $dbh = shift; if ( $dbh->FETCH('AutoCommit') && $dbh->FETCH('Warn') ) { return $dbh->set_err( 1, "rollback ineffective with AutoCommit" ); } my $sth = $dbh->prepare('ROLLBACK') or return $dbh->set_err( 1, $DBI::errstr ); my $rc = $sth->execute() or return $dbh->set_err( 1, $DBI::errstr ); $sth->finish(); if ($begin_work_commit) { $dbh->STORE( 'AutoCommit', 1 ); $begin_work_commit = 0; } return $rc; } } # NOTE: # this method should work in most cases, however it does # not exactly follow the DBI spec in the case of error # handling. I am not sure if that level of detail is # really nessecary since it is a weird error conditon # which causes it to fail anyway. However if you find you do need it, # then please email me about it. I think it would be possible # to mimic it by accessing the DBD::Mock::StatementTrack # object directly. sub selectcol_arrayref { my ( $dbh, $query, $attrib, @bindvalues ) = @_; # get all the columns ... my $a_ref = $dbh->selectall_arrayref( $query, $attrib, @bindvalues ); # if we get nothing back, or dont get an # ARRAY ref back, then we can assume # something went wrong, and so return undef. return undef unless defined $a_ref || ref($a_ref) ne 'ARRAY'; my @cols = 0; if ( ref $attrib->{Columns} eq 'ARRAY' ) { @cols = map { $_ - 1 } @{ $attrib->{Columns} }; } # if we do get something then we # grab all the columns out of it. return [ map { @$_[@cols] } @{$a_ref} ]; } sub FETCH { my ( $dbh, $attrib, $value ) = @_; $dbh->trace_msg("Fetching DB attrib '$attrib'\n"); if ( $attrib eq 'Active' ) { return $dbh->{mock_can_connect}; } elsif ( $attrib eq 'mock_all_history' ) { return $dbh->{mock_statement_history}; } elsif ( $attrib eq 'mock_all_history_iterator' ) { return DBD::Mock::StatementTrack::Iterator->new( $dbh->{mock_statement_history} ); } elsif ( $attrib =~ /^mock/ ) { return $dbh->{$attrib}; } elsif ( $attrib =~ /^(private_|dbi_|dbd_|[A-Z])/ ) { $dbh->trace_msg( "... fetching non-driver attribute ($attrib) that DBI handles\n"); return $dbh->SUPER::FETCH($attrib); } else { if ( $dbh->{mock_attribute_aliases} ) { if ( exists ${ $dbh->{mock_attribute_aliases}->{db} }{$attrib} ) { my $mock_attrib = $dbh->{mock_attribute_aliases}->{db}->{$attrib}; if ( ref($mock_attrib) eq 'CODE' ) { return $mock_attrib->($dbh); } else { return $dbh->FETCH($mock_attrib); } } } $dbh->trace_msg( "... fetching non-driver attribute ($attrib) that DBI doesn't handle\n" ); return $dbh->{$attrib}; } } sub STORE { my ( $dbh, $attrib, $value ) = @_; my $printed_value = $value || 'undef'; $dbh->trace_msg("Storing DB attribute '$attrib' with '$printed_value'\n"); if ( $attrib eq 'AutoCommit' ) { # These are magic DBI values that say we can handle AutoCommit # internally as well $value = ($value) ? -901 : -900; } if ( $attrib eq 'mock_clear_history' ) { if ($value) { $dbh->{mock_statement_history} = []; } return []; } elsif ( $attrib eq 'mock_add_parser' ) { my $parser_type = ref($value); my $is_valid_parser; if ( $parser_type eq 'CODE' ) { $is_valid_parser++; } elsif ( $parser_type && $parser_type !~ /^(ARRAY|HASH|SCALAR)$/ ) { $is_valid_parser = eval { $parser_type->can('parse') }; } unless ($is_valid_parser) { my $error = "Parser must be a code reference or object with 'parse()' " . "method (Given type: '$parser_type')"; $dbh->set_err( 1, $error ); return; } push @{ $dbh->{mock_parser} }, $value; return $value; } elsif ( $attrib eq 'mock_add_resultset' ) { $dbh->{mock_rs} ||= { named => {}, ordered => [] }; if ( ref $value eq 'ARRAY' ) { my @copied_values = @{$value}; push @{ $dbh->{mock_rs}{ordered} }, \@copied_values; return \@copied_values; } elsif ( ref $value eq 'HASH' ) { my $name = $value->{sql}; unless ($name) { die "Indexing resultset by name requires passing in 'sql' ", "as hashref key to 'mock_add_resultset'.\n"; } my @copied_values = @{ $value->{results} }; $dbh->{mock_rs}{named}{$name} = { results => \@copied_values, }; if ( exists $value->{failure} ) { $dbh->{mock_rs}{named}{$name}{failure} = [ @{ $value->{failure} }, ]; } return \@copied_values; } else { die "Must provide an arrayref or hashref when adding ", "resultset via 'mock_add_resultset'.\n"; } } elsif ( $attrib eq 'mock_start_insert_id' ) { if ( ref $value eq 'ARRAY' ) { $dbh->{mock_last_insert_ids} = {} unless $dbh->{mock_last_insert_ids}; $dbh->{mock_last_insert_ids}{ $value->[0] } = $value->[1]; } else { # we start at one minus the start id # so that the increment works $dbh->{mock_last_insert_id} = $value - 1; } } elsif ( $attrib eq 'mock_session' ) { ( ref($value) && UNIVERSAL::isa( $value, 'DBD::Mock::Session' ) ) || die "Only DBD::Mock::Session objects can be placed into the 'mock_session' slot\n" if defined $value; $dbh->{mock_session} = $value; } elsif ( $attrib =~ /^mock_(add_)?data_sources/ ) { $dbh->{Driver}->STORE( $attrib, $value ); } elsif ( $attrib =~ /^mock/ ) { return $dbh->{$attrib} = $value; } elsif ( $attrib =~ /^(private_|dbi_|dbd_|[A-Z])/ ) { $dbh->trace_msg( "... storing non-driver attribute ($attrib) with value ($printed_value) that DBI handles\n" ); return $dbh->SUPER::STORE( $attrib, $value ); } else { $dbh->trace_msg( "... storing non-driver attribute ($attrib) with value ($printed_value) that DBI won't handle\n" ); return $dbh->{$attrib} = $value; } } sub DESTROY { my ($dbh) = @_; if ( my $session = $dbh->{mock_session} ) { if ( $session->has_states_left ) { die "DBH->finish called when session still has states left\n"; } } } sub disconnect { my ($dbh) = @_; if ( my $session = $dbh->{mock_session} ) { if ( $session->has_states_left ) { die "DBH->finish called when session still has states left\n"; } } } 1; DBD-Mock-1.45/lib/DBD/Mock/Session.pm0000644000175000017500000001111711655032061016572 0ustar marianomarianopackage DBD::Mock::Session; use strict; use warnings; my $INSTANCE_COUNT = 1; # - Class - # sub new { my $class = shift; my $name = ref( $_[0] ) ? "Session $INSTANCE_COUNT" : shift; $INSTANCE_COUNT++; $class->_verify_states( $name, @_ ); bless { name => $name, states => \@_, state_index => 0 }, $class; } sub _verify_state { my ( $class, $state, $index, $name ) = @_; die "You must specify session states as HASH refs" if ref($state) ne 'HASH'; die "Bad state '$index' in DBD::Mock::Session ($name)" if not exists $state->{statement} or not exists $state->{results}; my $stmt = $state->{statement}; my $ref = ref $stmt; die "Bad 'statement' value '$stmt' in DBD::Mock::Session ($name)", if ref($stmt) ne '' and $ref ne 'CODE' and $ref ne 'Regexp'; } sub _verify_states { my ( $class, $name, @states ) = @_; die "You must specify at least one session state" if scalar @states == 0; for ( 0 .. scalar @states - 1 ) { $class->_verify_state( $states[$_], $_, $name ); } } # - Instance - # sub name { my $self = shift; $self->{name}; } sub reset { my $self = shift; $self->{state_index} = 0; } sub current_state { my $self = shift; my $idx = $self->{state_index}; return $self->{states}[$idx]; } sub has_states_left { my $self = shift; return $self->{state_index} < $self->_num_states; } sub verify_statement { my ( $self, $got ) = @_; unless ( $self->has_states_left ) { die "Session states exhausted, only '" . $self->_num_states . "' in DBD::Mock::Session ($self->name})"; } my $state = $self->current_state; my $expected = $state->{statement}; my $ref = ref($expected); if ( $ref eq 'Regexp' and $got !~ /$expected/ ) { die "Statement does not match current state (with Regexp) in " . "DBD::Mock::Session ($self->{name})\n" . " got: $got\n" . " expected: $expected", } if ( $ref eq 'CODE' and not $expected->( $got, $state ) ) { die "Statement does not match current state (with CODE ref) in " . "DBD::Mock::Session ($self->{name})"; } if ( not $ref and $got ne $expected ) { die "Statement does not match current state in " . "DBD::Mock::Session ($self->{name})\n" . " got: $got\n" . " expected: $expected"; } } sub results_for { my ( $self, $statment ) = @_; $self->_find_state_for($statment)->{results}; } sub verify_bound_params { my ( $self, $params ) = @_; my $current_state = $self->current_state; if ( exists ${$current_state}{bound_params} ) { my $expected = $current_state->{bound_params}; if ( scalar @$expected != scalar @$params ) { die "Not the same number of bound params in current state in " . "DBD::Mock::Session ($self->{name})\n" . " got: @{$params}" . " expected: @{$expected}"; } for ( 0 .. scalar @{$params} - 1 ) { $self->_verify_bound_param( $params->[$_], $expected->[$_], $_ ); } } # and make sure we go to # the next statement $self->{state_index}++; } sub _find_state_for { my ( $self, $statement ) = @_; foreach ( $self->_remaining_states ) { my $stmt = $_->{statement}; my $ref = ref($stmt); return $_ if ( $ref eq 'Regexp' and $statement =~ /$stmt/ ); return $_ if ( $ref eq 'CODE' and $stmt->( $statement, $_ ) ); return $_ if ( not $ref and $stmt eq $statement ); } die "Statement '$statement' not found in session ($self->{name})"; } sub _num_states { my $self = shift; scalar @{ $self->{states} }; } sub _remaining_states { my $self = shift; my $start_index = $self->{state_index}; my $end_index = $self->_num_states - 1; @{ $self->{states} }[ $start_index .. $end_index ]; } sub _verify_bound_param { my ( $self, $got, $expected, $index ) = @_; no warnings; my $ref = ref $expected; if ( $ref eq 'Regexp' and $got !~ /$expected/ ) { die "Bound param $index do not match (using regexp) " . "in current state in DBD::Mock::Session ($self->{name})" . " got: $got\n" . " expected: $expected"; } if ( $got ne $expected ) { die "Bound param $index do not match " . "in current state in DBD::Mock::Session ($self->{name})\n" . " got: $got\n" . " expected: $expected"; } } 1; DBD-Mock-1.45/lib/DBD/Mock/st.pm0000644000175000017500000002664412041122471015603 0ustar marianomarianopackage DBD::Mock::st; use strict; use warnings; our $imp_data_size = 0; sub bind_col { my ( $sth, $param_num, $ref, $attr ) = @_; my $tracker = $sth->FETCH('mock_my_history'); $tracker->bind_col( $param_num, $ref ); return 1; } sub bind_param { my ( $sth, $param_num, $val, $attr ) = @_; my $tracker = $sth->FETCH('mock_my_history'); $tracker->bound_param( $param_num, $val ); return 1; } sub bind_param_array { bind_param(@_); } sub bind_param_inout { my ( $sth, $param_num, $val, $max_len ) = @_; # check that $val is a scalar ref ( UNIVERSAL::isa( $val, 'SCALAR' ) ) || $sth->{Database} ->set_err( 1, "need a scalar ref to bind_param_inout, not $val" ); # check for positive $max_len ( $max_len > 0 ) || $sth->{Database} ->set_err( 1, "need to specify a maximum length to bind_param_inout" ); my $tracker = $sth->FETCH('mock_my_history'); $tracker->bound_param( $param_num, $val ); return 1; } sub execute_array { my ( $sth, $attr, @bind_values ) = @_; # no bind values means we're relying on prior calls to bind_param_array() # for our data my $tracker = $sth->FETCH('mock_my_history'); # don't use a reference; there's some magic attached to it somewhere # so make it a lovely, simple array as soon as possible my @bound = @{ $tracker->bound_params() }; foreach my $p (@bound) { my $result = $sth->execute( @$p ); # store the result from execute() if ArrayTupleStatus attribute is # passed push @{ $attr->{ArrayTupleStatus} }, $result if (exists $attr->{ArrayTupleStatus}); } # TODO: the docs say: # When called in scalar context the execute_array() method returns the # number of tuples executed, or undef if an error occurred. Like # execute(), a successful execute_array() always returns true regardless # of the number of tuples executed, even if it's zero. If there were any # errors the ArrayTupleStatus array can be used to discover which tuples # failed and with what errors. # When called in list context the execute_array() method returns two # scalars; $tuples is the same as calling execute_array() in scalar # context and $rows is the number of rows affected for each tuple, if # available or -1 if the driver cannot determine this. # We have glossed over this... return scalar @bound; } sub execute { my ( $sth, @params ) = @_; my $dbh = $sth->{Database}; unless ( $dbh->{mock_can_connect} ) { $dbh->set_err( 1, "No connection present" ); return 0; } unless ( $dbh->{mock_can_execute} ) { $dbh->set_err( 1, "Cannot execute" ); return 0; } $dbh->{mock_can_execute}++ if $dbh->{mock_can_execute} < 0; my $tracker = $sth->FETCH('mock_my_history'); if ( $tracker->has_failure() ) { $dbh->set_err( $tracker->get_failure() ); return 0; } if (@params) { $tracker->bind_params(@params); } if ( my $session = $dbh->{mock_session} ) { eval { my $state = $session->current_state; $session->verify_statement( $sth->{Statement}); $session->verify_bound_params( $tracker->bound_params() ); # Load a copy of the results to return (minus the field # names) into the tracker my @results = @{ $state->{results} }; shift @results; $tracker->{return_data} = \@results; }; if ($@) { my $session_error = $@; chomp $session_error; $sth->set_err( 1, "Session Error: ${session_error}" ); return; } } $tracker->mark_executed; my $fields = $tracker->fields; $sth->STORE( NUM_OF_PARAMS => $tracker->num_params ); # handle INSERT statements and the mock_last_insert_ids # We should only increment these things after the last successful INSERT. # -RobK, 2007-10-12 #use Data::Dumper;warn Dumper $dbh->{mock_last_insert_ids}; if ( $dbh->{Statement} =~ /^\s*?insert\s+into\s+(\S+)/i ) { if ( $dbh->{mock_last_insert_ids} && exists $dbh->{mock_last_insert_ids}{$1} ) { $dbh->{mock_last_insert_id} = $dbh->{mock_last_insert_ids}{$1}++; } else { $dbh->{mock_last_insert_id}++; } } #warn "$dbh->{mock_last_insert_id}\n"; # always return 0E0 for Selects if ( $dbh->{Statement} =~ /^\s*?select/i ) { return '0E0'; } return ( $sth->rows() || '0E0' ); } sub fetch { my ($sth) = @_; my $dbh = $sth->{Database}; unless ( $dbh->{mock_can_connect} ) { $dbh->set_err( 1, "No connection present" ); return; } unless ( $dbh->{mock_can_fetch} ) { $dbh->set_err( 1, "Cannot fetch" ); return; } $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0; my $tracker = $sth->FETCH('mock_my_history'); my $record = $tracker->next_record or return; if ( my @cols = $tracker->bind_cols() ) { for my $i ( grep { ref $cols[$_] } 0 .. $#cols ) { ${ $cols[$i] } = $record->[$i]; } } return $record; } sub fetchrow_array { my ($sth) = @_; my $row = $sth->DBD::Mock::st::fetch(); return unless ref($row) eq 'ARRAY'; return @{$row}; } sub fetchrow_arrayref { my ($sth) = @_; return $sth->DBD::Mock::st::fetch(); } sub fetchrow_hashref { my ( $sth, $name ) = @_; my $dbh = $sth->{Database}; # handle any errors since we are grabbing # from the tracker directly unless ( $dbh->{mock_can_connect} ) { $dbh->set_err( 1, "No connection present" ); return; } unless ( $dbh->{mock_can_fetch} ) { $dbh->set_err( 1, "Cannot fetch" ); return; } $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0; # first handle the $name, it will default to NAME $name ||= 'NAME'; # then fetch the names from the $sth (per DBI spec) my $fields = $sth->FETCH($name); # now check the tracker ... my $tracker = $sth->FETCH('mock_my_history'); # and collect the results if ( my $record = $tracker->next_record() ) { my @values = @{$record}; return { map { $_ => shift(@values) } @{$fields} }; } return undef; } #XXX Isn't this supposed to return an array of hashrefs? -RobK, 2007-10-15 sub fetchall_hashref { my ( $sth, $keyfield ) = @_; my $dbh = $sth->{Database}; # handle any errors since we are grabbing # from the tracker directly unless ( $dbh->{mock_can_connect} ) { $dbh->set_err( 1, "No connection present" ); return; } unless ( $dbh->{mock_can_fetch} ) { $dbh->set_err( 1, "Cannot fetch" ); return; } $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0; my $tracker = $sth->FETCH('mock_my_history'); my $rethash = {}; # get the name set by my $name = $sth->{Database}->FETCH('FetchHashKeyName') || 'NAME'; my $fields = $sth->FETCH($name); # check if $keyfield is not an integer if ( !( $keyfield =~ /^-?\d+$/ ) ) { my $found = 0; # search for index of item that matches $keyfield foreach my $index ( 0 .. scalar( @{$fields} ) ) { if ( $fields->[$index] eq $keyfield ) { $found++; # now make the keyfield the index $keyfield = $index; # and jump out of the loop :) last; } } unless ($found) { $dbh->set_err( 1, "Could not find key field '$keyfield'" ); return; } } # now loop through all the records ... while ( my $record = $tracker->next_record() ) { # copy the values so as to preserve # the original record... my @values = @{$record}; # populate the hash $rethash->{ $record->[$keyfield] } = { map { $_ => shift(@values) } @{$fields} }; } return $rethash; } sub finish { my ($sth) = @_; $sth->FETCH('mock_my_history')->is_finished('yes'); } sub rows { my ($sth) = @_; $sth->FETCH('mock_num_rows'); } sub FETCH { my ( $sth, $attrib ) = @_; $sth->trace_msg("Fetching ST attribute '$attrib'\n"); my $tracker = $sth->{mock_my_history}; $sth->trace_msg( "Retrieved tracker: " . ref($tracker) . "\n" ); # NAME attributes if ( $attrib eq 'NAME' ) { return [ @{ $tracker->fields } ]; } elsif ( $attrib eq 'NAME_lc' ) { return [ map { lc($_) } @{ $tracker->fields } ]; } elsif ( $attrib eq 'NAME_uc' ) { return [ map { uc($_) } @{ $tracker->fields } ]; } # NAME_hash attributes elsif ( $attrib eq 'NAME_hash' ) { my $i = 0; return { map { $_ => $i++ } @{ $tracker->fields } }; } elsif ( $attrib eq 'NAME_hash_lc' ) { my $i = 0; return { map { lc($_) => $i++ } @{ $tracker->fields } }; } elsif ( $attrib eq 'NAME_hash_uc' ) { my $i = 0; return { map { uc($_) => $i++ } @{ $tracker->fields } }; } # others elsif ( $attrib eq 'NUM_OF_FIELDS' ) { return $tracker->num_fields; } elsif ( $attrib eq 'NUM_OF_PARAMS' ) { return $tracker->num_params; } elsif ( $attrib eq 'TYPE' ) { my $num_fields = $tracker->num_fields; return [ map { $DBI::SQL_VARCHAR } ( 0 .. $num_fields ) ]; } elsif ( $attrib eq 'Active' ) { return $tracker->is_active; } elsif ( $attrib !~ /^mock/ ) { if ( $sth->{Database}->{mock_attribute_aliases} ) { if ( exists ${ $sth->{Database}->{mock_attribute_aliases}->{st} } {$attrib} ) { my $mock_attrib = $sth->{Database}->{mock_attribute_aliases}->{st}->{$attrib}; if ( ref($mock_attrib) eq 'CODE' ) { return $mock_attrib->($sth); } else { return $sth->FETCH($mock_attrib); } } } return $sth->SUPER::FETCH($attrib); } # now do our stuff... if ( $attrib eq 'mock_my_history' ) { return $tracker; } if ( $attrib eq 'mock_statement' ) { return $tracker->statement; } elsif ( $attrib eq 'mock_params' ) { return $tracker->bound_params; } elsif ( $attrib eq 'mock_records' ) { return $tracker->return_data; } elsif ( $attrib eq 'mock_num_records' || $attrib eq 'mock_num_rows' ) { return $tracker->num_rows; } elsif ( $attrib eq 'mock_current_record_num' ) { return $tracker->current_record_num; } elsif ( $attrib eq 'mock_fields' ) { return $tracker->fields; } elsif ( $attrib eq 'mock_is_executed' ) { return $tracker->is_executed; } elsif ( $attrib eq 'mock_is_finished' ) { return $tracker->is_finished; } elsif ( $attrib eq 'mock_is_depleted' ) { return $tracker->is_depleted; } else { die "I don't know how to retrieve statement attribute '$attrib'\n"; } } sub STORE { my ( $sth, $attrib, $value ) = @_; $sth->trace_msg("Storing ST attribute '$attrib'\n"); if ( $attrib =~ /^mock/ ) { return $sth->{$attrib} = $value; } elsif ( $attrib =~ /^NAME/ ) { # no-op... return; } else { $value ||= 0; return $sth->SUPER::STORE( $attrib, $value ); } } sub DESTROY { undef } 1; DBD-Mock-1.45/lib/DBD/Mock/StatementTrack.pm0000644000175000017500000001046211654534326020114 0ustar marianomarianopackage DBD::Mock::StatementTrack; use strict; use warnings; sub new { my ( $class, %params ) = @_; # these params have default values # but can be overridden $params{return_data} ||= []; $params{fields} ||= []; $params{bound_params} ||= []; $params{statement} ||= ""; $params{failure} ||= undef; # these params should never be overridden # and should always start out in a default # state to assure the sanity of this class $params{is_executed} = 'no'; $params{is_finished} = 'no'; $params{current_record_num} = 0; # NOTE: # changed from \%params here because that # would bind the hash sent in so that it # would reflect alterations in the object # this violates encapsulation my $self = bless {%params}, $class; return $self; } sub has_failure { my ($self) = @_; $self->{failure} ? 1 : 0; } sub get_failure { my ($self) = @_; @{ $self->{failure} }; } sub num_fields { my ($self) = @_; return scalar @{ $self->{fields} }; } sub num_rows { my ($self) = @_; return scalar @{ $self->{return_data} }; } sub num_params { my ($self) = @_; return scalar @{ $self->{bound_params} }; } sub bind_col { my ( $self, $param_num, $ref ) = @_; $self->{bind_cols}->[ $param_num - 1 ] = $ref; } sub bound_param { my ( $self, $param_num, $value ) = @_; # Basic support for named parameters if ( $param_num !~ /^\d+/ ) { $param_num = $self->num_params + 1; } $self->{bound_params}->[ $param_num - 1 ] = $value; return $self->bound_params; } sub bound_param_trailing { my ( $self, @values ) = @_; push @{ $self->{bound_params} }, @values; } sub bind_cols { my $self = shift; return @{ $self->{bind_cols} || [] }; } sub bind_params { my ( $self, @values ) = @_; @{ $self->{bound_params} } = @values; } # Rely on the DBI's notion of Active: a statement is active if it's # currently in a SELECT and has more records to fetch sub is_active { my ($self) = @_; return 0 unless $self->statement =~ /^\s*select/ism; return 0 unless $self->is_executed eq 'yes'; return 0 if $self->is_depleted; return 1; } sub is_finished { my ( $self, $value ) = @_; if ( defined $value && $value eq 'yes' ) { $self->{is_finished} = 'yes'; $self->current_record_num(0); $self->{return_data} = []; } elsif ( defined $value ) { $self->{is_finished} = 'no'; } return $self->{is_finished}; } #################### # RETURN VALUES sub mark_executed { my ($self) = @_; $self->is_executed('yes'); $self->current_record_num(0); } sub next_record { my ($self) = @_; return if $self->is_depleted; my $rec_num = $self->current_record_num; my $rec = $self->return_data->[$rec_num]; $self->current_record_num( $rec_num + 1 ); return $rec; } sub is_depleted { my ($self) = @_; return ( $self->current_record_num >= scalar @{ $self->return_data } ); } # DEBUGGING AID sub to_string { my ($self) = @_; return join "\n" => ( $self->{statement}, "Values: [" . join( '] [', @{ $self->{bound_params} } ) . "]", "Records: on $self->{current_record_num} of " . scalar( @{ $self->return_data } ) . "\n", "Executed? $self->{is_executed}; Finished? $self->{is_finished}" ); } # PROPERTIES # boolean sub is_executed { my ( $self, $yes_no ) = @_; $self->{is_executed} = $yes_no if defined $yes_no; return ( $self->{is_executed} eq 'yes' ) ? 'yes' : 'no'; } # single-element fields sub statement { my ( $self, $value ) = @_; $self->{statement} = $value if defined $value; return $self->{statement}; } sub current_record_num { my ( $self, $value ) = @_; $self->{current_record_num} = $value if defined $value; return $self->{current_record_num}; } # multi-element fields sub return_data { my ( $self, @values ) = @_; push @{ $self->{return_data} }, @values if scalar @values; return $self->{return_data}; } sub fields { my ( $self, @values ) = @_; push @{ $self->{fields} }, @values if scalar @values; return $self->{fields}; } sub bound_params { my ( $self, @values ) = @_; push @{ $self->{bound_params} }, @values if scalar @values; return $self->{bound_params}; } 1; DBD-Mock-1.45/lib/DBD/Mock/Pool/0000755000175000017500000000000012041122556015520 5ustar marianomarianoDBD-Mock-1.45/lib/DBD/Mock/Pool/db.pm0000644000175000017500000000015311654534326016455 0ustar marianomarianopackage DBD::Mock::Pool::db; use strict; use warnings; our @ISA = qw(DBI::db); sub disconnect { 1 } 1; DBD-Mock-1.45/lib/DBD/Mock/dr.pm0000644000175000017500000000514711654534326015574 0ustar marianomarianopackage DBD::Mock::dr; use strict; use warnings; our $imp_data_size = 0; sub connect { my ( $drh, $dbname, $user, $auth, $attributes ) = @_; if ( $drh->{'mock_connect_fail'} == 1 ) { $drh->set_err( 1, "Could not connect to mock database" ); return; } $attributes ||= {}; if ( $dbname && $DBD::Mock::AttributeAliasing ) { # this is the DB we are mocking $attributes->{mock_attribute_aliases} = DBD::Mock::_get_mock_attribute_aliases($dbname); $attributes->{mock_database_name} = $dbname; } # holds statement parsing coderefs/objects $attributes->{mock_parser} = []; # holds all statements applied to handle until manually cleared $attributes->{mock_statement_history} = []; # ability to fake a failed DB connection $attributes->{mock_can_connect} = 1; # ability to make other things fail :) $attributes->{mock_can_prepare} = 1; $attributes->{mock_can_execute} = 1; $attributes->{mock_can_fetch} = 1; my $dbh = DBI::_new_dbh( $drh, { Name => $dbname } ) || return; return $dbh; } sub FETCH { my ( $drh, $attr ) = @_; if ( $attr =~ /^mock_/ ) { if ( $attr eq 'mock_connect_fail' ) { return $drh->{'mock_connect_fail'}; } elsif ( $attr eq 'mock_data_sources' ) { unless ( defined $drh->{'mock_data_sources'} ) { $drh->{'mock_data_sources'} = ['DBI:Mock:']; } return $drh->{'mock_data_sources'}; } else { return $drh->SUPER::FETCH($attr); } } else { return $drh->SUPER::FETCH($attr); } } sub STORE { my ( $drh, $attr, $value ) = @_; if ( $attr =~ /^mock_/ ) { if ( $attr eq 'mock_connect_fail' ) { return $drh->{'mock_connect_fail'} = $value ? 1 : 0; } elsif ( $attr eq 'mock_data_sources' ) { if ( ref($value) ne 'ARRAY' ) { $drh->set_err( 1, "You must pass an array ref of data sources" ); return; } return $drh->{'mock_data_sources'} = $value; } elsif ( $attr eq 'mock_add_data_sources' ) { return push @{ $drh->{'mock_data_sources'} } => $value; } } else { return $drh->SUPER::STORE( $attr, $value ); } } sub data_sources { my $drh = shift; return map { (/^DBI\:Mock\:/i) ? $_ : "DBI:Mock:$_" } @{ $drh->FETCH('mock_data_sources') }; } # Necessary to support DBI < 1.34 # from CPAN RT bug #7057 sub disconnect_all { # no-op } sub DESTROY { undef } 1; DBD-Mock-1.45/lib/DBD/Mock/Pool.pm0000644000175000017500000000056411654534326016076 0ustar marianomarianopackage DBD::Mock::Pool; use strict; use warnings; my $connection; sub connect { return $connection if $connection; # according to the code before my tweaks, this could be a class # name, but it was never used - DR, 2008-11-08 shift unless ref $_[0]; my $drh = shift; return $connection = bless $drh->connect(@_), 'DBD::Mock::Pool::db'; } 1; DBD-Mock-1.45/MYMETA.yml0000644000175000017500000000073312041122554014277 0ustar marianomariano--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DBD-Mock no_index: directory: - t - inc requires: DBI: 1.3 Test::Exception: 0.31 Test::More: 0.47 version: 1.45 DBD-Mock-1.45/t/0000755000175000017500000000000012041122556013022 5ustar marianomarianoDBD-Mock-1.45/t/002_dr_handle.t0000644000175000017500000000532511603226735015524 0ustar marianomarianouse strict; use Test::More tests => 24; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $drh = DBI->install_driver("Mock"); isa_ok($drh, 'DBI::dr'); is($drh->{Name}, 'Mock', '... got the right name'); is($drh->{Version}, $DBD::Mock::VERSION, '... got the right version'); is($drh->{Attribution}, 'DBD Mock driver by Chris Winters & Stevan Little (orig. from Tim Bunce)', '... got the right attribution'); # make sure we always get the same one back { my $drh2 = DBI->install_driver("Mock"); isa_ok($drh2, 'DBI::dr'); is($drh, $drh2, '... got the same driver'); } is_deeply( [ $drh->data_sources() ], [ 'DBI:Mock:' ], '... got the expected data sources'); $drh->{mock_data_sources} = [ 'test', 'DBI:Mock:mysql' ]; is_deeply( [ $drh->data_sources() ], [ 'DBI:Mock:test', 'DBI:Mock:mysql' ], '... got the expected data sources'); $drh->{mock_add_data_sources} = 'foo'; is_deeply( [ $drh->data_sources() ], [ 'DBI:Mock:test', 'DBI:Mock:mysql', 'DBI:Mock:foo' ], '... got the expected data sources'); { # connect through the driver handle my $dbh = $drh->connect(); isa_ok($dbh, 'DBI::db'); is($dbh->{Driver}, $drh, '... our driver is as we expect'); $dbh->disconnect(); } { # check the mock_connect_fail attribute is($drh->{mock_connect_fail}, 0, '... the default is set not to fail'); # make sure the this only affects the initial connect my $_dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($_dbh, 'DBI::db'); # now no more connections $drh->{mock_connect_fail} = 1; is($drh->{mock_connect_fail}, 1, '... we are set to fail'); eval { DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); }; ok($@, '... could not connect (as expected)'); like($@, qr/^DBI connect\(\'\'\,\'\'\,\.\.\.\) failed\: Could not connect to mock database/, #' '... got the error we expected too'); # make sure the handle we created before the change works eval { $_dbh->prepare( "SELECT foo FROM bar" ) }; ok(!$@, '... we should not have an exception here'); $drh->{mock_connect_fail} = 0; is($drh->{'mock_connect_fail'}, 0, '... we are set not to fail'); my $dbh; eval { $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); }; ok(!$@, '... could connect (as expected)'); isa_ok($dbh, 'DBI::db'); } { # check other attributes $drh->{mock_nothing} = 100; ok(!defined($drh->{mock_nothing}), '... we only support our attributes'); $drh->{nothing} = 100; ok(!defined($drh->{nothing}), '... we only support our attributes'); } DBD-Mock-1.45/t/013_st_execute_bound_params.t0000644000175000017500000000500211603226735020500 0ustar marianomarianouse strict; use Test::More tests => 18; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?'; { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); my $sth = eval { $dbh->prepare( $sql ) }; eval { $sth->bind_param( 2, 'bar' ); $sth->bind_param( 1, 'baz' ); }; ok( ! $@, 'Parameters bound to statement handle with bind_param()' ); eval { $sth->execute() }; ok( ! $@, 'Called execute() ok (empty, after bind_param calls)' ); my $t_params = $sth->{mock_my_history}->bound_params; is( scalar @{ $t_params }, 2, 'Correct number of parameters bound (method on tracker)' ); is( $t_params->[0], 'baz', 'Statement handle stored bound parameter from bind_param() (method on tracker)' ); is( $t_params->[1], 'bar', 'Statement handle stored bound parameter from bind_param() (method on tracker)' ); my $a_params = $sth->{mock_params}; is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (attribute)' ); is( $a_params->[0], 'baz', 'Statement handle stored bound parameter from bind_param() (attribute)' ); is( $a_params->[1], 'bar', 'Statement handle stored bound parameter from bind_param() (attribute)' ); } { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); my $sth = eval { $dbh->prepare( 'begin dbms_output.get_line(?,?); end;' ) }; my ($bar, $baz) = ('bar', 'baz'); eval { $sth->bind_param_inout( 2, \$bar, 10 ); $sth->bind_param_inout( 1, \$baz, 100 ); }; diag $@ if $@; ok(!$@, 'Parameters bound to statement handle with bind_param_inout()' ); eval { $sth->execute() }; ok( ! $@, 'Called execute() ok (empty, after bind_param_inout calls)' ); my $t_params = $sth->{mock_my_history}->bound_params; is( scalar @{ $t_params }, 2, 'Correct number of parameters bound (method on tracker)' ); is( $t_params->[0], \$baz, 'Statement handle stored bound parameter from bind_param_inout() (method on tracker)' ); is( $t_params->[1], \$bar, 'Statement handle stored bound parameter from bind_param_inout() (method on tracker)' ); my $a_params = $sth->{mock_params}; is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (attribute)' ); is( $a_params->[0], \$baz, 'Statement handle stored bound parameter from bind_param_inout() (attribute)' ); is( $a_params->[1], \$bar, 'Statement handle stored bound parameter from bind_param_inout() (attribute)' ); } DBD-Mock-1.45/t/024_selcol_fetchhash.t0000644000175000017500000000361711603226735017110 0ustar marianomarianouse 5.006; use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $swallow_sql = "SELECT id, type, inventory_id, species FROM birds WHERE species='swallow'"; my $items_sql = "SELECT id, name, weight FROM items"; my @resultList = ( { sql => $swallow_sql, results => [ [ 'id', 'type', 'inventory_id' ], [ '1', 'european', '42' ], [ '27', 'african', '2' ], ], }, { sql => $items_sql, results => [ [ 'id', 'name', 'weight' ], [ '2', 'coconuts', 'fairly hefty' ], [ '42', 'not coconuts', 'pretty light' ], ], }, ); my $coco_hash = { 'id' => '2', 'name' => 'coconuts', 'weight' => 'fairly hefty', }; my $not_coco_hash = { 'id' => '42', 'name' => 'not coconuts', 'weight' => 'pretty light', }; my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); { my $res; foreach $res (@resultList) { $dbh->{mock_add_resultset} = $res; } } { my $res; my @expected = ('1','27'); eval { $res = $dbh->selectcol_arrayref($swallow_sql); }; isa_ok(\$res, "REF"); isa_ok($res, "ARRAY"); is_deeply($res, \@expected, "Checking if selectcol_arrayref works."); } { my %expected = (1 => 'european', 27 => 'african'); my $res = eval { $dbh->selectcol_arrayref($swallow_sql, {Columns=>[1, 2]}) }; is_deeply( { @{$res || []} }, \%expected, 'Checking if selectcol_arrayref works with Columns attribute' ); } is_deeply( $dbh->selectall_hashref($items_sql, 'id', "Checking selectall_hashref with named key."), { '2' => $coco_hash, '42' => $not_coco_hash, }, '... selectall_hashref worked correctly'); is_deeply( $dbh->selectall_hashref($items_sql, 1, "Checking selectall_hashref with named key."), { 'coconuts' => $coco_hash, 'not coconuts' => $not_coco_hash, }, '... selectall_hashref worked correctly'); DBD-Mock-1.45/t/bug_0001.t0000644000175000017500000000143511603226735014436 0ustar marianomariano# This is RT #15602 # The bug that was reported did not appear, but it did expose # another bug with consecutive executes() use strict; use Test::More tests => 4; use_ok('DBI'); my $dbh = DBI->connect( 'dbi:Mock:', '', '', { PrintError => 0 } ); isa_ok($dbh, 'DBI::db'); my $SQL = "select foo from bar where a = ? and b = ?"; my $s = DBD::Mock::Session->new("bugdemo", { statement=> $SQL, bound_params=>[1,2], results=>[['foo'],[1]] }, { statement=> $SQL, bound_params=>[3,4], results=>[['foo'],[1]], }, ); $dbh->{mock_session} = $s; my $sth=$dbh->prepare($SQL); eval { ok( !$sth->execute(3,4), "Bind failed" ); ok( $sth->execute(1,2), "Bind passed" ); }; # Shuts up warning when object is destroyed undef $dbh->{mock_session}; DBD-Mock-1.45/t/023_statement_failure.t0000644000175000017500000001174311603226735017323 0ustar marianomarianouse strict; use Test::More tests => 28; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test misc. attributes { my $dbh = DBI->connect('DBI:Mock:', 'user', 'pass'); isa_ok($dbh, 'DBI::db'); $dbh->{mock_add_resultset} = { sql => 'SELECT foo FROM bar', results => DBD::Mock->NULL_RESULTSET, failure => [ 5, 'Ooops!' ], }; $dbh->{PrintError} = 0; $dbh->{RaiseError} = 1; my $sth = eval { $dbh->prepare('SELECT foo FROM bar') }; ok(!$@, '$sth handle prepared correctly'); isa_ok($sth, 'DBI::st'); eval { $sth->execute() }; ok( $@, '$sth handled executed and died' ); $dbh->{mock_add_resultset} = { sql => 'SELECT bar FROM foo', results => [ [ 'bar' ], [1], [2], [3], [4], [5], [6], [7], [8], [9], [10] ] }; #test new error generators $dbh->{mock_can_prepare} = 0; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 1; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_arrayref) { 1; } }; ok($@ =~ /Cannot prepare/, '$sth handle failed to prepare'); $dbh->{mock_can_prepare} = -3; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 1; my $i = 0; for (1 .. 10) { $i++; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_arrayref) { 1; } }; last if $@; } ok($@ =~ /Cannot prepare/, "$@ should contain 'Cannot prepare'"); ok($i == 4, "$i should be 4"); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 0; $dbh->{mock_can_fetch} = 1; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_arrayref) { 1; } }; ok($@ =~ /Cannot execute/, '$sth handle failed to execute'); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = -3; $dbh->{mock_can_fetch} = 1; $i = 0; for (1 .. 10) { $i++; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_arrayref) { 1; } }; last if $@; } ok($@ =~ /Cannot execute/, "$@ should contain 'Cannot execute'"); ok($i == 4, "$i should be 4"); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 0; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_arrayref) { 1; } }; ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch'); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 0; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my @row = $sth->fetchrow_array) { 1; } }; ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch'); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 0; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; while (my $row = $sth->fetchrow_hashref) { 1; } }; ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch'); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = 0; eval { my $sth = $dbh->prepare("SELECT bar FROM foo"); $sth->execute; my @row = $sth->fetchall_arrayref; }; ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch'); $dbh->{mock_can_prepare} = 1; $dbh->{mock_can_execute} = 1; $dbh->{mock_can_fetch} = -100; { my $sth; eval { $sth = $dbh->prepare("select bar from foo"); $sth->execute; }; ok(!$@, "prepare and execute should work"); isa_ok($sth, 'DBI::st'); eval { my $row = $sth->fetch }; ok(!$@, "fetch should work"); ok($dbh->{mock_can_fetch}==-99, "$dbh->{mock_can_fetch} should be -99"); eval { my $row = $sth->fetchrow_arrayref }; ok(!$@, "fetch should work"); ok($dbh->{mock_can_fetch}==-98, "$dbh->{mock_can_fetch} should be -98"); eval { my @row = $sth->fetchrow_array }; ok(!$@, "fetch should work"); ok($dbh->{mock_can_fetch}==-97, "$dbh->{mock_can_fetch} should be -97"); eval { my $row = $sth->fetchrow_hashref }; ok(!$@, "fetch should work"); ok($dbh->{mock_can_fetch}==-96, "$dbh->{mock_can_fetch} should be -96"); eval { my @rows = $sth->fetchall_arrayref }; ok(!$@, "fetch should work"); ok($dbh->{mock_can_fetch}==-95, "$dbh->{mock_can_fetch} should be -95"); } } DBD-Mock-1.45/t/027_named_parameters.t0000644000175000017500000000330311654534326017120 0ustar marianomarianouse strict; use warnings; use Test::More tests => 5; BEGIN { use_ok('DBD::Mock'); } my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); my $session = DBD::Mock::Session->new( ( { statement => 'SELECT * FROM foo WHERE id = ? and active = ?', bound_params => [ '613', 'yes' ], results => [ ['foo'], [10] ] }, { statement => 'SELECT * FROM foo WHERE id = ? and active = ?', bound_params => [ '613', 'yes' ], results => [ ['foo'], [10] ] }, { statement => 'SELECT * FROM foo WHERE id = :id and active = :active', bound_params => [ '101', 'no' ], results => [ ['bar'], [15] ] }, { statement => 'SELECT * FROM foo WHERE id = :id and active = :active', bound_params => [ '101', 'no' ], results => [ ['bar'], [15] ] }, ) ); $dbh->{mock_session} = $session; my $sth = $dbh->prepare('SELECT * FROM foo WHERE id = ? and active = ?'); $sth->bind_param( 1 => '613' ); $sth->bind_param( 2 => 'yes' ); ok( $sth->execute, 'Execute using positional parameters' ); $sth = $dbh->prepare('SELECT * FROM foo WHERE id = ? and active = ?'); ok( $sth->execute( '613', 'yes' ), 'Execute using positional parameters #2' ); $sth = $dbh->prepare('SELECT * FROM foo WHERE id = :id and active = :active'); $sth->bind_param( ':id' => '101' ); $sth->bind_param( ':active' => 'no' ); ok( $sth->execute, 'Execute using named parameters' ); $sth = $dbh->prepare('SELECT * FROM foo WHERE id = :id and active = :active'); ok( $sth->execute( '101', 'no' ), 'Execute using named parameters #2' ); DBD-Mock-1.45/t/000_basic.t0000644000175000017500000000011611603226735014654 0ustar marianomarianouse strict; use Test::More tests => 1; BEGIN { use_ok( 'DBD::Mock' ); } DBD-Mock-1.45/t/014_st_execute_pass_params.t0000644000175000017500000000213011603226735020337 0ustar marianomarianouse strict; use Test::More tests => 9; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?'; { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); my $sth = eval { $dbh->prepare( $sql ) }; eval { $sth->execute( 'baz', 'bar' ) }; ok( ! $@, 'Called execute() ok (inline params)' ); my $t_params = $sth->{mock_my_history}->bound_params; is( scalar @{ $t_params }, 2, 'Correct number of parameters bound (inline; method on tracker)' ); is( $t_params->[0], 'baz', 'Statement handle stored bound inline parameter (method on tracker)' ); is( $t_params->[1], 'bar', 'Statement handle stored bound inline parameter (method on tracker)' ); my $a_params = $sth->{mock_my_history}->bound_params; is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (inline; attribute)' ); is( $a_params->[0], 'baz', 'Statement handle stored bound inline parameter (attribute)' ); is( $a_params->[1], 'bar', 'Statement handle stored bound inline parameter (attribute)' ); } DBD-Mock-1.45/t/018_mock_statement_track.t0000644000175000017500000001350211626560230020004 0ustar marianomarianouse strict; use Test::More tests => 68; BEGIN { use_ok('DBD::Mock'); } { # check the available methods can_ok("DBD::Mock::StatementTrack", 'new'); my $st_track = DBD::Mock::StatementTrack->new(); isa_ok($st_track, 'DBD::Mock::StatementTrack'); can_ok($st_track, 'num_fields'); can_ok($st_track, 'num_params'); can_ok($st_track, 'bound_param'); can_ok($st_track, 'bound_param_trailing'); can_ok($st_track, 'is_active'); can_ok($st_track, 'is_finished'); can_ok($st_track, 'mark_executed'); can_ok($st_track, 'next_record'); can_ok($st_track, 'is_depleted'); can_ok($st_track, 'to_string'); can_ok($st_track, 'is_executed'); can_ok($st_track, 'statement'); can_ok($st_track, 'current_record_num'); can_ok($st_track, 'return_data'); can_ok($st_track, 'fields'); can_ok($st_track, 'bound_params'); } { # check the default state my $st_track = DBD::Mock::StatementTrack->new(); isa_ok($st_track, 'DBD::Mock::StatementTrack'); is($st_track->num_fields(), 0, '... we have no fields in the default'); is_deeply($st_track->fields(), [], '... we have no fields in the default'); is($st_track->num_params(), 0, '... we have no bound params in the default'); is_deeply($st_track->bound_params(), [], '... we have no bound params in the default'); is_deeply($st_track->return_data(), [], '... we have no return data in the default'); is($st_track->current_record_num(), 0, '... our current record num is 0 in the default'); is($st_track->statement(), '', '... our statement is a blank string in the default'); is($st_track->is_executed(), 'no', '... our statement is not executed in the default'); ok($st_track->is_depleted(), '... the default state is depleted'); ok(!defined($st_track->next_record()), '... the default state has no next record since it is depleted'); is($st_track->is_finished(), 'no', '... our statement is not finished in the default'); is($st_track->is_active(), 0, '... the default state is not active'); } { # check a pre-defined state my %params = ( return_data => [ [1, 1, 1], [2, 2, 2], [3, 3, 3] ], fields => [ 'foo', 'bar', 'baz' ], bound_params => [ 'baz' ], statement => 'SELECT foo FROM bar WHERE baz = ?' ); my $st_track = DBD::Mock::StatementTrack->new(%params); isa_ok($st_track, 'DBD::Mock::StatementTrack'); is($st_track->num_fields(), 3, '... we have the expected num of fields'); is_deeply($st_track->fields(), $params{fields}, '... we have the expected fields'); is($st_track->num_params(), 1, '... we have the expected num of bound params'); is_deeply($st_track->bound_params(), $params{bound_params}, '... we have the expected bound params'); is_deeply($st_track->return_data(), $params{return_data}, '... we have the expected return data'); is($st_track->current_record_num(), 0, '... our current record num is 0 in the default'); is($st_track->statement(), $params{statement}, '... our statement as expected '); is($st_track->is_executed(), 'no', '... our statement is not executed'); ok(!$st_track->is_depleted(), '... the state is not depleted'); is($st_track->is_finished(), 'no', '... our statement is not finished'); is($st_track->is_active(), 0, '... the default state is active'); # now lets alter that state # and make sure changes reflect is_deeply( $st_track->bound_param(2, 'foo'), [ 'baz', 'foo' ], '... we have the expected bound params'); $st_track->bound_param_trailing('bar', 'foobar'); is_deeply( $st_track->bound_params(), [ 'baz', 'foo', 'bar', 'foobar' ], '... we have the expected bound params'); is($st_track->num_params(), 4, '... we have the expected num of bound params'); { my $old_SQL = $st_track->statement(); my $SQL = 'INSERT INTO foo (foo, bar, baz) VALUE(1, 2, 3)'; $st_track->statement($SQL); is($st_track->statement(), $SQL, '... our statement as expected '); is($st_track->is_active(), 0, '... with an INSERT we are not considered active'); $st_track->statement($old_SQL); is($st_track->statement(), $old_SQL, '... restore our statement'); } $st_track->mark_executed(); is($st_track->is_executed(), 'yes', '... our statement is now executed'); is($st_track->current_record_num(), 0, '... our current record num is 0'); is($st_track->is_active(), 1, '... we are active now that we are executed'); for (1 .. 3) { ok(!$st_track->is_depleted(), '... the state is not depleted'); is_deeply( $st_track->next_record(), [ $_, $_, $_ ], '... got the next record as expected'); is($st_track->current_record_num(), $_, '... our current record num is now ' . $_); } ok(!defined($st_track->next_record()), '... no more records'); ok($st_track->is_depleted(), '... we are now depleted'); is($st_track->is_active(), 0, '... we are no longer active now that we are depleted'); is($st_track->is_finished(), 'no', '... passing in nothing just returns the value'); $st_track->is_finished('yes'); is($st_track->is_finished(), 'yes', '... our statement is now finished'); $st_track->is_finished('nothing'); is($st_track->is_finished(), 'no', '... our statement is no longer finished'); } DBD-Mock-1.45/t/017_st_can_connect.t0000644000175000017500000000445411603226735016574 0ustar marianomarianouse strict; use Test::More tests => 23; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, "DBI::db"); ok($dbh->{RaiseError}, '... RaiseError is set correctly'); ok(! $dbh->{PrintError}, '... PrintError is set correctly'); my $sth_exec = $dbh->prepare('SELECT foo FROM bar'); isa_ok($sth_exec, "DBI::st"); # turn off the handle between the prepare and execute... $dbh->{mock_can_connect} = 0; # check our value is correctly set is($dbh->{mock_can_connect}, 0, '... can connect is set to 0'); # and check the side effects of that ok(!$dbh->{Active}, '... the handle is not Active'); ok(!$dbh->ping(), '... and ping returns false'); # now try to execute it eval { $sth_exec->execute() }; ok($@, '... we got an exception'); like($@, qr/No connection present/, '... we got the expected execption'); # turn off the database between execute and fetch $dbh->{mock_can_connect} = 1; # check our value is correctly set is($dbh->{mock_can_connect}, 1, '... can connect is set to 1'); # and check the side effects of that ok($dbh->{Active}, '... the handle is Active'); ok($dbh->ping(), '... and ping returns true'); $dbh->{mock_add_resultset} = [[ qw(foo bar ) ], # column headers [ qw(this that ) ], # first row values [ qw(never seen) ]]; # second row values my $sth_fetch = $dbh->prepare('SELECT foo, bar FROM baz'); isa_ok($sth_fetch, "DBI::st"); eval { $sth_fetch->execute() }; ok(!$@, '... executed without exception'); my $row = eval { $sth_fetch->fetchrow_arrayref() }; ok(!$@, '... the first row was returned without execption'); is_deeply($row, [ qw(this that) ], '... we got back the expected data in the first row'); # now turn off the database $dbh->{mock_can_connect} = 0; # check our value is correctly set is($dbh->{mock_can_connect}, 0, '... can connect is set to 0'); # and check the side effects of that ok(!$dbh->{Active}, '... the handle is not Active'); ok(!$dbh->ping(), '... and ping returns false'); $row = eval { $sth_fetch->fetchrow_arrayref() }; ok($@, '... we got the exception'); like($sth_fetch->errstr, qr/^No connection present/, '... fetching row against inactive db throws expected exception' ); DBD-Mock-1.45/t/bug_0003.t0000755000175000017500000000256411654534326014453 0ustar marianomariano#!/usr/bin/perl use Test::More tests => 3; use strict; use warnings; use Test::Exception; use DBI; use DBD::Mock; # This tests that spurious extra ->execute invocations fail with a # useful message. This is because there was a bug in which # DBD::Mock->verify_bound_params didn't check that the session had run # out, and on return out-of-bounds element of the state array is # accessed, causing an unhelpful error "Can't use an undefined value # as an ARRAY reference at ../lib/DBD/Mock.pm line 635." my @session = ( { 'statement' => 'INSERT INTO foo (bar) values (?);', 'results' => [], 'bound_params' => [1] }, ); my $dbh = DBI->connect('dbi:Mock:', '', '', { PrintError => 0, RaiseError => 1}); # Add just part of the expected session, such that the next step would be a 'BEGIN WORK' $dbh->{mock_session} = DBD::Mock::Session->new(@session); # now execute the steps in the session my $step = $session[0]; my $sth = $dbh->prepare($step->{statement}); ok $sth, "prepare statement"; my $params = $step->{bound_params} || []; ok $sth->execute(@$params), "execute statement"; # Session expects that to be all. So let's surprise it with another # ->execute. It should fail appropriately. throws_ok { ok $sth->execute(@$params), } qr/\QSession states exhausted, only '1' in DBD::Mock::Session\E/, "fails on executing one too many times"; DBD-Mock-1.45/t/022_DBD_Mock_Session_bound_params.t0000644000175000017500000001341311603226735021402 0ustar marianomarianouse strict; use Test::More tests => 29; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, 'DBI::db'); my $session = DBD::Mock::Session->new(( { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 100 ], results => [[ 'foo' ], [ 10 ]] }, { statement => 'SELECT bar FROM foo WHERE baz = ?', bound_params => [ 125 ], results => [[ 'bar' ], [ 15 ]] }, )); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE baz = ?'); $sth->execute(100); my ($result) = $sth->fetchrow_array(); is($result, 10, '... got the right value'); }; ok(!$@, '... everything worked as planned'); eval { my $sth = $dbh->prepare('SELECT bar FROM foo WHERE baz = ?'); $sth->execute(125); my ($result) = $sth->fetchrow_array(); is($result, 15, '... got the right value'); }; ok(!$@, '... everything worked as planned'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, 'DBI::db'); my $session = DBD::Mock::Session->new(( { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 100 ], results => [[ 'foo' ], [ 10 ]] }, { statement => 'SELECT bar FROM foo WHERE baz = 125', results => [[ 'bar' ], [ 15 ]] }, { statement => 'DELETE FROM bar WHERE baz = ?', results => [[], [], []], bound_params => [ 100 ] } )); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE baz = ?'); $sth->execute(100); my ($result) = $sth->fetchrow_array(); is($result, 10, '... got the right value'); }; ok(!$@, '... first state worked as planned'); eval { my $sth = $dbh->prepare('SELECT bar FROM foo WHERE baz = 125'); $sth->execute(); my ($result) = $sth->fetchrow_array(); is($result, 15, '... got the right value'); }; ok(!$@, '... second state worked as planned'); eval { my $sth = $dbh->prepare('DELETE FROM bar WHERE baz = ?'); $sth->execute(100); is($sth->rows(), 2, '... got the right number of affected rows'); }; ok(!$@, '... third state worked as planned'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } # check some errors { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, 'DBI::db'); my $session = DBD::Mock::Session->new(( { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 100 ], results => [[ 'foo' ], [ 10 ]] } )); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE baz = ?'); $sth->execute(100, 200); my ($result) = $sth->fetchrow_array(); }; ok($@, '... everything failed as planned'); like($@, qr/Session Error\: Not the same number of bound params in current state in DBD\:\:Mock\:\:Session/, '... everything failed as planned'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, 'DBI::db'); my $session = DBD::Mock::Session->new(( { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 100 ], results => [[ 'foo' ], [ 10 ]] } )); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE baz = ?'); $sth->execute(200); my ($result) = $sth->fetchrow_array(); }; ok($@, '... everything failed as planned'); like($@, qr/Session Error\: Bound param 0 do not match in current state in DBD\:\:Mock\:\:Session/, '... everything failed as planned'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, 'DBI::db'); my $session = DBD::Mock::Session->new(( { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 100 ], results => [[ 'foo' ], [ 10 ]] }, { statement => 'SELECT foo FROM bar WHERE baz = ?', bound_params => [ 125 ], results => [[ 'foo' ], [ 15 ]] }, )); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE baz = ?'); $sth->execute(100); my ($result) = $sth->fetchrow_array(); is($result, 10, '... first execute got the right value'); $sth->execute(125); ($result) = $sth->fetchrow_array(); is($result, 15, '... second execute got the right value'); }; ok(!$@, '... everything worked as planned'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } DBD-Mock-1.45/t/010_rollback.t0000755000175000017500000000512611654524045015377 0ustar marianomarianouse strict; use Test::More tests => 38; BEGIN { use_ok('DBI'); } my $dbh = DBI->connect( 'dbi:Mock:', '', '' ); isa_ok($dbh, 'DBI::db'); $dbh->{PrintError} = 0; ################################################################################ $dbh->{AutoCommit} = 0; ok( $dbh->{AutoCommit} == 0, "AutoCommit is off" ); ok( $dbh->commit, 'commit() returns true' ); ok( $dbh->rollback, 'rollback() returns true' ); ok( !defined $dbh->begin_work, "begin_work() fails if AutoCommit is off" ); is( $DBI::errstr, 'AutoCommit is off, you are already within a transaction'); my $history = $dbh->{mock_all_history}; ok( @$history == 2, "Correct number of statements" ); is( $history->[0]->statement, 'COMMIT' ); ok( @{$history->[0]->bound_params} == 0, 'No parameters' ); is( $history->[1]->statement, 'ROLLBACK' ); ok( @{$history->[1]->bound_params} == 0, 'No parameters' ); ok( $dbh->{AutoCommit} == 0, "AutoCommit is still off" ); $dbh->{mock_clear_history} = 1; ################################################################################ $dbh->{AutoCommit} = 1; ok( $dbh->{AutoCommit} == 1, "AutoCommit is on" ); ok( !defined $dbh->commit, "Commit returns false" ); is( $DBI::errstr, "commit ineffective with AutoCommit" ); ok( !defined $dbh->rollback, "Rollback returns false" ); is( $DBI::errstr, "rollback ineffective with AutoCommit" ); ok( $dbh->{AutoCommit} == 1, "AutoCommit is still on" ); $history = $dbh->{mock_all_history}; ok( @$history == 0, "Correct number of statements" ); $dbh->{mock_clear_history} = 1; ################################################################################ $dbh->{AutoCommit} = 1; ok( $dbh->{AutoCommit} == 1, "AutoCommit is on" ); ok( $dbh->begin_work, 'begin_work() returns true' ); ok( $dbh->{AutoCommit} == 0, "AutoCommit is now off" ); ok( $dbh->rollback, 'rollback() returns true' ); ok( $dbh->{AutoCommit} == 1, "AutoCommit is back on" ); ok( $dbh->begin_work, 'begin_work() returns true' ); ok( $dbh->{AutoCommit} == 0, "AutoCommit is now off" ); ok( $dbh->commit, 'rollback() returns true' ); ok( $dbh->{AutoCommit} == 1, "AutoCommit is back on" ); $history = $dbh->{mock_all_history}; ok( @$history == 4, "Correct number of statements" ); is( $history->[0]->statement, 'BEGIN WORK' ); ok( @{$history->[0]->bound_params} == 0, 'No parameters' ); is( $history->[1]->statement, 'ROLLBACK' ); ok( @{$history->[1]->bound_params} == 0, 'No parameters' ); is( $history->[2]->statement, 'BEGIN WORK' ); ok( @{$history->[2]->bound_params} == 0, 'No parameters' ); is( $history->[3]->statement, 'COMMIT' ); ok( @{$history->[3]->bound_params} == 0, 'No parameters' ); DBD-Mock-1.45/t/011_st_execute_empty.t0000644000175000017500000000260711654611006017165 0ustar marianomarianouse strict; use Test::More tests => 15; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?'; { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); my $sth = eval { $dbh->prepare( $sql ) }; ok( ! $@, 'Statement handle prepared ok' ); is( ref( $sth ), 'DBI::st', 'Statement handle returned of the proper type' ); is( $sth->{mock_my_history}->statement, $sql, 'Statement handle stores SQL (method on tracker)' ); is( $sth->{mock_statement}, $sql, 'Statement handle stores SQL (attribute)' ); is( $sth->{mock_is_executed}, 'no', 'Execute flag not set yet' ); my $rows = eval { $sth->execute() }; ok( ! $@, 'Called execute() ok (no params)' ); is($rows, '0E0', '... we got back 0E0 for num of rows'); is( $sth->{mock_is_executed}, 'yes', 'Execute flag set after execute()' ); my $t_params = $sth->{mock_my_history}->bound_params; is( scalar @{ $t_params }, 0, 'No parameters tracked (method on tracker)' ); my $a_params = $sth->{mock_params}; is( scalar @{ $a_params }, 0, 'No parameters tracked (attribute)' ); is( $sth->{mock_is_finished}, 'no', 'Finished flag not set yet' ); eval { $sth->finish }; ok( ! $@, 'Called finish() ok' ); is( $sth->{mock_is_finished}, 'yes', 'Finished flag set after finish()' ); } DBD-Mock-1.45/t/015_st_fetch_records.t0000644000175000017500000000567411603226735017137 0ustar marianomarianouse strict; use Test::More tests => 43; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } #use Data::Dumper qw( Dumper ); my @rs_foo = ( [ 'this', 'that' ], [ 'this_one', 'that_one' ], [ 'this_two', 'that_two' ], ); my $foo_sql = 'SELECT this, that FROM foo'; my @rs_login = ( [ 'login', 'first_name', 'last_name' ], [ 'cwinters', 'Chris', 'Winters' ], [ 'bflay', 'Bobby', 'Flay' ], [ 'alincoln', 'Abe', 'Lincoln' ], ); my $login_sql = 'SELECT login, first_name, last_name FROM foo'; my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); # Seed the handle with two resultsets # the first one ordered $dbh->{mock_add_resultset} = [ @rs_foo ]; # the second one named $dbh->{mock_add_resultset} = { sql => $login_sql, results => \@rs_login }; # run the first one { my ( $sth ); eval { $sth = $dbh->prepare( $foo_sql ); $sth->execute(); }; check_resultset( $sth, [ @rs_foo ] ); } { my ( $sth ); eval { $sth = $dbh->prepare( $login_sql ); $sth->execute(); }; check_resultset( $sth, [ @rs_login ] ); } { my ( $sth ); eval { $sth = $dbh->prepare( q{INSERT INTO foo VALUES ( 'Don Corleone' )} ); $sth->execute(); }; ok( ! $sth->{Active}, '...this should not be an active handle' ); } sub check_resultset { my ( $sth, $check ) = @_; my $fields = shift @{ $check }; is( $sth->{mock_num_records}, scalar @{ $check }, 'Correct number of records reported by statement' ); is( $sth->{mock_num_rows}, scalar @{ $check }, 'Correct number of rows reported by statement' ); is( $sth->rows, scalar @{ $check }, 'Correct number of rows reported by statement' ); is( $sth->{mock_current_record_num}, 0, 'Current record number correct before fetching' ); ok( $sth->{Active}, '... this should be an active handle' ); for ( my $i = 0; $i < scalar @{ $check }; $i++ ) { my $rec_num = $i + 1; my $this_check = $check->[$i]; my $this_rec = $sth->fetchrow_arrayref; my $num_fields = scalar @{ $this_check }; is( scalar @{ $this_rec }, $num_fields, "Record $rec_num, correct number of fields ($num_fields)" ); for ( my $j = 0; $j < $num_fields; $j++ ) { my $field_num = $j + 1; is( $this_rec->[$j], $this_check->[$j], "Record $rec_num, field $field_num" ); } is( $sth->{mock_current_record_num}, $rec_num, "Record $rec_num, current record number tracked" ); if ( $rec_num == scalar @{ $check } ) { ok( $sth->{mock_is_depleted}, 'Resultset depleted properly' ); ok( ! $sth->{Active}, '...this should not be an active handle anymore' ); } else { ok( ! $sth->{mock_is_depleted}, 'Resultset not yet depleted' ); } } } DBD-Mock-1.45/t/025_mock_last_insert_id.t0000644000175000017500000000311211603226735017615 0ustar marianomarianouse 5.006; use strict; use warnings; use Test::More tests => 12; use DBI; my $dbh = DBI->connect( 'DBI:Mock:', '', '' ) || die "Cannot create handle: $DBI::errstr\n"; $dbh->{mock_start_insert_id} = ['Foo', 123]; $dbh->{mock_start_insert_id} = ['Baz', 345]; { my $sth = $dbh->prepare('INSERT INTO Foo (foo, bar) values (?, ?)'); $sth->execute(15, 17); is($dbh->{mock_last_insert_id}, 123, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 123, '... got the right insert id from last_insert_id'); $sth->execute(16, 18); is($dbh->{mock_last_insert_id}, 124, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 124, '... got the right insert id from last_insert_id'); $sth->execute(19, 34); is($dbh->{mock_last_insert_id}, 125, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 125, '... got the right insert id from last_insert_id'); } { my $sth = $dbh->prepare('INSERT INTO Baz (foo, bar) values (?, ?)'); $sth->execute(90, 41); is($dbh->{mock_last_insert_id}, 345, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 345, '... got the right insert id from last_insert_id'); $sth->execute(32, 71); is($dbh->{mock_last_insert_id}, 346, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 346, '... got the right insert id from last_insert_id'); $sth->execute(77, 42); is($dbh->{mock_last_insert_id}, 347, '... got the right insert id'); is($dbh->last_insert_id((undef)x4), 347, '... got the right insert id from last_insert_id'); } DBD-Mock-1.45/t/005_db_parser.t0000644000175000017500000000770711603226735015556 0ustar marianomarianouse strict; use Test::More tests => 26; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } { my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{RaiseError}, 1, '... make sure RaiseError is set correctly'); # check parse sub-refs my $parser = sub { my ($sql) = @_; die "incorrect use of '*'\n" if $sql =~ /^SELECT \*/; }; eval { $dbh->{mock_add_parser} = $parser; }; ok(!$@, '... parser successfully added to dbh'); is($dbh->{mock_parser}->[0], $parser, '... the same parser is stored'); my $sth1 = eval { $dbh->prepare('SELECT myfield FROM mytable') }; isa_ok($sth1, "DBI::st"); my $sth2 = eval { $dbh->prepare( 'SELECT * FROM mytable' ) }; ok(!defined($sth2), '... we should get nothing back from here'); like($@, qr/Failed to parse statement\. Error\: incorrect use of \'\*\'\. Statement\: SELECT \* FROM mytable/, '... parser failure generated correct error'); $dbh->disconnect(); } # parser class { package MyParser; sub new { return bless {} } sub parse { my ($self, $sql) = @_; die "incorrect use of '*'\n" if $sql =~ /^SELECT \*/; } } { my $dbh = DBI->connect('DBI:Mock:', '', '', { PrintError => 1 }); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{PrintError}, 1, '... make sure PrintError is set correctly'); # check parse objects my $parser = MyParser->new(); eval { $dbh->{mock_add_parser} = $parser; }; ok(!$@, '... parser successfully added to dbh'); is($dbh->{mock_parser}->[0], $parser, '... the same parser is stored'); my $sth1 = eval { $dbh->prepare('SELECT myfield FROM mytable') }; isa_ok($sth1, "DBI::st"); { # isolate the warn handler local $SIG{__WARN__} = sub { my $msg = shift; like($msg, qr/incorrect use of \'\*\'\. Statement\: SELECT \* FROM mytable/, #' '...got the expected warning'); }; my $sth2 = eval { $dbh->prepare( 'SELECT * FROM mytable' ) }; ok(!defined($sth2), '... we should get nothing back from here'); } $dbh->disconnect(); } { # pass in a bad parser my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{RaiseError}, 1, '... make sure RaiseError is set correctly'); eval { $dbh->{mock_add_parser} = "Fail"; }; like($@, qr/Parser must be a code reference or /, '... bad parser successfully not added to dbh'); eval { $dbh->{mock_add_parser} = []; }; like($@, qr/Parser must be a code reference or /, '... bad parser successfully not added to dbh'); } { # check it with PrintError too my $dbh = DBI->connect('DBI:Mock:', '', ''); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{PrintError}, 1, '... make sure PrintError is set correctly'); { # isolate the warn handler local $SIG{__WARN__} = sub { my $msg = shift; like($msg, qr/Parser must be a code reference or /, '... bad parser successfully not added to dbh'); }; ok(!defined($dbh->{mock_add_parser} = {}), '... this returns undef too'); my $test = "Fail"; ok(!defined($dbh->{mock_add_parser} = \$test), '... this returns undef too'); } } DBD-Mock-1.45/t/021_DBD_Mock_Session.t0000644000175000017500000003010611655013540016640 0ustar marianomarianouse strict; use Test::More tests => 55; BEGIN { use_ok('DBD::Mock'); } use DBI; { package Login::Test; my $MAX_LOGIN_FAILURES = 3; sub login { my ($dbh, $u, $p) = @_; # look for the right username and password my ($user_id) = $dbh->selectrow_array("SELECT user_id FROM users WHERE username = '$u' AND password = '$p'"); # if we find one, then ... if ($user_id) { # log the event and return true $dbh->do("INSERT INTO event_log (event) VALUES('User $user_id logged in')"); return 'LOGIN SUCCESSFUL'; } # if we don't find one then ... else { # see if the username exists ... my ($user_id, $login_failures) = $dbh->selectrow_array("SELECT user_id, login_failures FROM users WHERE username = '$u'"); # if we do have a username, and the password doesnt match then ... if ($user_id) { # if we have not reached the max allowable login failures then ... if ($login_failures < $MAX_LOGIN_FAILURES) { # update the login failures $dbh->do("UPDATE users SET login_failures = (login_failures + 1) WHERE user_id = $user_id"); return 'BAD PASSWORD'; } # otherwise ... else { # we must update the login failures, and lock the account $dbh->do("UPDATE users SET login_failures = (login_failures + 1), locked = 1 WHERE user_id = $user_id"); return 'USER ACCOUNT LOCKED'; } } else { return 'USERNAME NOT FOUND'; } } } } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); my $session = DBD::Mock::Session->new({ statement => '', results => []}); isa_ok($session, 'DBD::Mock::Session'); is($session->name(), 'Session 1', '... got the first default session name'); $dbh->{mock_session} = $session; my $fetched_session = $dbh->{mock_session}; is($fetched_session, $session, '... it is the same session we put in'); $dbh->{mock_session} = undef; ok(!defined($dbh->{mock_session}), '... we no longer have a session in there'); my $session2 = DBD::Mock::Session->new({ statement => '', results => []}); isa_ok($session2, 'DBD::Mock::Session'); is($session2->name(), 'Session 2', '... got the second default session name'); } { my $successful_login = DBD::Mock::Session->new('successful_login' => ( { statement => "SELECT user_id FROM users WHERE username = 'user' AND password = '****'", results => [[ 'user_id' ], [ 1 ]] }, { statement => "INSERT INTO event_log (event) VALUES('User 1 logged in')", results => [] } )); isa_ok($successful_login, 'DBD::Mock::Session'); is($successful_login->name(), 'successful_login', '... got the right name'); my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); $dbh->{mock_session} = $successful_login; is(Login::Test::login($dbh, 'user', '****'), 'LOGIN SUCCESSFUL', '... logged in successfully'); # check the reusablity # it is not reusable now eval { Login::Test::login($dbh, 'user', '****') }; ok($@, '... got the exception'); like($@, qr/Session Error\: Session states exhausted/, '... got the exception we expected'); # reset the DBD::Mock::Session object $successful_login->reset; # and it is re-usable now is(Login::Test::login($dbh, 'user', '****'), 'LOGIN SUCCESSFUL', '... logged in successfully'); } { my $bad_username = DBD::Mock::Session->new('bad_username' => ( { statement => qr/SELECT user_id FROM users WHERE username = \'.*?\' AND password = \'.*?\'/, #' results => [[ 'user_id' ], [ undef ]] }, { statement => qr/SELECT user_id, login_failures FROM users WHERE username = \'.*?\'/, #' results => [[ 'user_id', 'login_failures' ], [ undef, undef ]] } )); isa_ok($bad_username, 'DBD::Mock::Session'); is($bad_username->name(), 'bad_username', '... got the right name'); my $dbh = DBI->connect('dbi:Mock:', '', ''); $dbh->{mock_session} = $bad_username; is(Login::Test::login($dbh, 'user', '****'), 'USERNAME NOT FOUND', '... username is not found'); } { my $bad_password = DBD::Mock::Session->new('bad_password' => ( { statement => sub { $_[0] eq "SELECT user_id FROM users WHERE username = 'user' AND password = '****'" }, results => [[ 'user_id' ], [ undef]] }, { statement => sub { $_[0] eq "SELECT user_id, login_failures FROM users WHERE username = 'user'" }, results => [[ 'user_id', 'login_failures' ], [ 1, 0 ]] }, { statement => sub { $_[0] eq "UPDATE users SET login_failures = (login_failures + 1) WHERE user_id = 1" }, results => [] } )); isa_ok($bad_password, 'DBD::Mock::Session'); is($bad_password->name(), 'bad_password', '... got the right name'); my $dbh = DBI->connect('dbi:Mock:', '', ''); $dbh->{mock_session} = $bad_password; is(Login::Test::login($dbh, 'user', '****'), 'BAD PASSWORD', '... username is found, but the password is wrong'); } { my $lock_user_account = DBD::Mock::Session->new('lock_user_account' => ( { statement => "SELECT user_id FROM users WHERE username = 'user' AND password = '****'", results => [[ 'user_id' ], [ undef]] }, { statement => qr/SELECT user_id, login_failures FROM users WHERE username = \'.*?\'/, #' results => [[ 'user_id', 'login_failures' ], [ 1, 4 ]] }, { statement => sub { $_[0] eq "UPDATE users SET login_failures = (login_failures + 1), locked = 1 WHERE user_id = 1" }, results => [] } )); isa_ok($lock_user_account, 'DBD::Mock::Session'); is($lock_user_account->name(), 'lock_user_account', '... got the right name'); my $dbh = DBI->connect('dbi:Mock:', '', ''); $dbh->{mock_session} = $lock_user_account; is(Login::Test::login($dbh, 'user', '****'), 'USER ACCOUNT LOCKED', '... username is found, and the password is wrong, and the user account is now locked'); } # now check some errors { my $not_enough_statements = DBD::Mock::Session->new(( { statement => "SELECT user_id FROM users WHERE username = 'user' AND password = '****'", results => [[ 'user_id' ], [ undef]] }, { statement => qr/SELECT user_id, login_failures FROM users WHERE username = \'.*?\'/, #' results => [[ 'user_id', 'login_failures' ], [ 1, 4 ]] }, # ... removed one statement here which DBI will be looking for )); isa_ok($not_enough_statements, 'DBD::Mock::Session'); my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); $dbh->{mock_session} = $not_enough_statements; eval { Login::Test::login($dbh, 'user', '****'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/Session Error\: Session states exhausted\, /, '... got the error we expected'); } { eval { DBD::Mock::Session->new() }; ok(defined($@), '... got an error, as expected'); like($@, qr/^You must specify at least one session state/, '... got the error we expected'); eval { DBD::Mock::Session->new([]) }; ok(defined($@), '... got an error, as expected'); like($@, qr/^You must specify session states as HASH refs/, '... got the error we expected'); eval { DBD::Mock::Session->new('session') }; ok(defined($@), '... got an error, as expected'); like($@, qr/^You must specify at least one session state/, '... got the error we expected'); eval { DBD::Mock::Session->new('session', []) }; ok(defined($@), '... got an error, as expected'); like($@, qr/^You must specify session states as HASH refs/, '... got the error we expected'); eval { DBD::Mock::Session->new('session', { statement => '', results => [] }, []) }; ok(defined($@), '... got an error, as expected'); like($@, qr/^You must specify session states as HASH refs/, '... got the error we expected'); } { eval { my $session = DBD::Mock::Session->new('session' => {}); $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Bad state \'0\' in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { eval { my $session = DBD::Mock::Session->new('session' => { statement => "" }); $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Bad state \'0\' in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { eval { my $session = DBD::Mock::Session->new('session' => { results => [] }); $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Bad state \'0\' in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { eval { my $session = DBD::Mock::Session->new('session' => { statement => [], results => [] }); $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Bad \'statement\' value \'ARRAY\(0x[a-f0-9]+\)\' in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { my $session = DBD::Mock::Session->new('session' => { statement => "SELECT foo FROM baz", results => [] } ); isa_ok($session, 'DBD::Mock::Session'); eval { $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Statement does not match current state in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { my $session = DBD::Mock::Session->new('session' => { statement => qr/SELECT foo FROM baz/, results => [] } ); isa_ok($session, 'DBD::Mock::Session'); eval { $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Statement does not match current state \(with Regexp\) in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { my $session = DBD::Mock::Session->new('session' => { statement => sub { 0 }, results => [] } ); isa_ok($session, 'DBD::Mock::Session'); eval { $session->verify_statement(DBI->connect('dbi:Mock:', '', ''), 'SELECT foo FROM bar'); }; ok(defined($@), '... got an error, as expected'); like($@, qr/^Statement does not match current state \(with CODE ref\) in DBD::Mock::Session \(session\)/, '... got the error we expected'); } { my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); my $session = DBD::Mock::Session->new('session' => { statement => 'Some SQL', results => [] } ); isa_ok($session, 'DBD::Mock::Session'); $dbh->{mock_session} = $session; eval { $dbh->disconnect; }; ok(defined($@), '... got an error, as expected'); like($@, qr/^DBH->finish called when session still has states left/, '... got the error we expected'); # Shuts up warning when object is destroyed undef $dbh->{mock_session}; } DBD-Mock-1.45/t/001_db_handle.t0000644000175000017500000000722611603226735015505 0ustar marianomarianouse strict; use Test::More tests => 24; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test misc. attributes { my $dbh = DBI->connect('DBI:Mock:', 'user', 'pass'); isa_ok($dbh, 'DBI::db'); is($dbh->{Name}, '', '... if no db-name is given'); ok( $dbh->{AutoCommit}, '... AutoCommit DB attribute defaults to set' ); # DBI will handle attributes with 'private_', 'dbi_' or , # 'dbd_' prefixes but all others, we need to handle. $dbh->{mysql_insertid} = 10; is($dbh->{mysql_insertid}, 10, '... this attribute should be 10'); # DBI will handle these $dbh->{private_insert_id} = 15; is($dbh->{private_insert_id}, 15, '... this attribute should be 15'); $dbh->{dbi_attribute} = 2000; is($dbh->{dbi_attribute}, 2000, '... this attribute should be 2000'); $dbh->{dbd_attr} = 15_000; is($dbh->{dbd_attr}, 15_000, '... this attribute should be 15,000'); $dbh->disconnect(); } # test setting attributes post-connect { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); $dbh->{RaiseError} = 1; $dbh->{PrintError} = 1; $dbh->{AutoCommit} = 1; ok( $dbh->{RaiseError}, 'RaiseError DB attribute set after connect()' ); ok( $dbh->{PrintError}, 'PrintError DB attribute set after connect()' ); ok( $dbh->{AutoCommit}, 'AutoCommit DB attribute set after connect()' ); $dbh->disconnect(); } # test setting them during connect { my $dbh = DBI->connect( 'DBI:Mock:', '', '', { RaiseError => 1, PrintError => 1, AutoCommit => 1 } ); ok( $dbh->{RaiseError}, 'RaiseError DB attribute set in connect()' ); ok( $dbh->{PrintError}, 'PrintError DB attribute set in connect()' ); ok( $dbh->{AutoCommit}, 'AutoCommit DB attribute set in connect()' ); $dbh->disconnect(); } # test setting attributes with false values during connect { my $dbh = DBI->connect( 'DBI:Mock:', '', '', { RaiseError => 0, PrintError => 0, AutoCommit => 0 } ); ok( ! $dbh->{RaiseError}, 'RaiseError DB attribute unset in connect()' ); ok( ! $dbh->{PrintError}, 'PrintError DB attribute unset in connect()' ); ok( ! $dbh->{AutoCommit}, 'AutoCommit DB attribute unset in connect()' ); $dbh->disconnect(); } { my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); is_deeply( [ $dbh->data_sources() ], [ 'DBI:Mock:' ], '... got the right data sources'); $dbh->{'mock_add_data_sources'} = 'foo'; is_deeply( [ $dbh->data_sources() ], [ 'DBI:Mock:', 'DBI:Mock:foo' ], '... got the right data sources'); } { my $dbh = DBI->connect( 'DBI:Mock:', '', '', { RaiseError => 0, PrintError => 0, PrintWarn => 0, AutoCommit => 0, } ); $dbh->{RaiseError} = 1; $dbh->{PrintError} = 1; $dbh->{PrintWarn} = 1; $dbh->{AutoCommit} = 1; ok( $dbh->{RaiseError}, 'RaiseError DB attribute set in connect() and then changed' ); ok( $dbh->{PrintError}, 'PrintError DB attribute set in connect() and then changed' ); ok( $dbh->{PrintWarn}, 'PrintWarn DB attribute set in connect() and then changed' ); ok( $dbh->{AutoCommit}, 'AutoCommit DB attribute set in connect() and then changed' ); $dbh->disconnect(); } DBD-Mock-1.45/t/020_db_pool.t0000644000175000017500000000364511603226735015225 0ustar marianomarianouse strict; use Test::More tests => 16; BEGIN { use_ok( 'DBD::Mock' => qw(Pool) ); use_ok('DBI'); } # check that the pool works { my $dbh = DBI->connect("DBI:Mock:", '', '', {RaiseError => 1 }); isa_ok($dbh, 'DBD::Mock::Pool::db'); my $dbh2 = DBI->connect("DBI:Mock:", '', '', {RaiseError => 1 }); isa_ok($dbh2, 'DBD::Mock::Pool::db'); is($dbh, $dbh2, '... these handles should be the same'); ok($dbh->disconnect(), '... this will not actually do anything just return true'); ok($dbh2->disconnect(), '... this will not actually do anything just return true'); } # check that the pool holds result sets # in an scope indepenent manner { # set up handle from pool my $dbh = DBI->connect("DBI:Mock:", '', '', {RaiseError => 1 }); isa_ok($dbh, 'DBD::Mock::Pool::db'); $dbh->{mock_add_resultset} = [[ 'foo', 'bar', 'baz' ], [ 1, 2, 3 ]]; ok($dbh->disconnect(), '... not really disconnecting, just returning true'); } { # execute a statement, and expect the results my $dbh = DBI->connect("DBI:Mock:", '', '', {RaiseError => 1 }); isa_ok($dbh, 'DBD::Mock::Pool::db'); my $sth = $dbh->prepare("SELECT foo, bar, baz FROM whatever"); $sth->execute(); is_deeply( $sth->fetchrow_arrayref(), [ 1, 2, 3 ], '... got our row correctly' ); $sth->finish(); ok($dbh->disconnect(), '... not really disconnecting, just returning true'); } { # check our statement history my $dbh = DBI->connect("DBI:Mock:", '', ''); isa_ok($dbh, 'DBD::Mock::Pool::db'); my $history = $dbh->{mock_all_history}; is(scalar @{$history}, 1, '... we executed 1 statement'); is( $history->[0]->statement(), "SELECT foo, bar, baz FROM whatever", '... this the statement we executed'); ok($dbh->disconnect(), '... not really disconnecting, just returning true'); } DBD-Mock-1.45/t/009_info.t0000755000175000017500000000037111654524045014546 0ustar marianomarianouse strict; use Test::More tests => 3; BEGIN { use_ok('DBI'); } my $dbh = DBI->connect( 'dbi:Mock:', '', '' ); isa_ok($dbh, 'DBI::db'); $dbh->{mock_get_info} = { foo => 4 }; is( $dbh->get_info( 'foo' ), '4', "Retrieved info successfully" ); DBD-Mock-1.45/t/012_st_handle.t0000644000175000017500000000307411603226735015545 0ustar marianomarianouse strict; use Test::More tests => 15; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test misc. attributes { my $dbh = DBI->connect('DBI:Mock:', 'user', 'pass'); isa_ok($dbh, 'DBI::db'); $dbh->{mock_add_resultset} = [[ 'Foo', 'Bar', 'Baz' ],[ 1, 1, 1 ]]; my $sth = eval { $dbh->prepare('SELECT Foo, Bar, Baz FROM FooBarBaz') }; ok(!$@, '... $sth handle prepared ok'); isa_ok($sth, 'DBI::st'); is($sth->{Statement}, 'SELECT Foo, Bar, Baz FROM FooBarBaz', '... got the right statement'); is($sth->{Database}, $dbh, '... got the right Database handle'); is($sth->{NUM_OF_FIELDS}, 3, '... got the right number of fields'); is($sth->{NUM_OF_PARAMS}, 0, '... got the right number of params'); is_deeply( $sth->{NAME}, [ 'Foo', 'Bar', 'Baz' ], '... got the right NAME attributes'); is_deeply( $sth->{NAME_lc}, [ 'foo', 'bar', 'baz' ], '... got the right NAME_lc attributes'); is_deeply( $sth->{NAME_uc}, [ 'FOO', 'BAR', 'BAZ' ], '... got the right NAME_uc attributes'); is_deeply( $sth->{NAME_hash}, { Foo => 0, Bar => 1, Baz => 2 }, '... got the right NAME_hash attributes'); is_deeply( $sth->{NAME_hash_lc}, { foo => 0, bar => 1, baz => 2 }, '... got the right NAME_hash_lc attributes'); is_deeply( $sth->{NAME_hash_uc}, { FOO => 0, BAR => 1, BAZ => 2 }, '... got the right NAME_hash_uc attributes'); } DBD-Mock-1.45/t/026_st_bind_col.t0000644000175000017500000000357011603226735016071 0ustar marianomarianouse 5.006; use strict; use warnings; use Test::More tests => 12; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $dbh = DBI->connect( 'DBI:Mock:', '', '' ); $dbh->{mock_add_resultset} = [ [ 'id', 'type', 'inventory_id' ], [ '1', 'european', '42' ], [ '27', 'african', '2' ], ]; my $sth = $dbh->prepare( 'SELECT id, type, inventory_id FROM Swallow' ); $sth->execute(); { my ($id, $type, $inventory_id); $sth->bind_col( 1, \$id ); $sth->bind_col( 2, \$type ); $sth->bind_col( 3, \$inventory_id ); ok( $sth->fetch(), 'fetch() returned data' ); is( $id, 1, 'bind_col to $id == 1' ); is( $type, 'european', 'bind_col to $type == "european"' ); is( $inventory_id, 42, 'bind_col to $inventory_id == 42' ); } { my %hash; $sth->bind_columns( \( @hash{ qw( id type inventory_id ) } ) ); ok( $sth->fetch(), 'fetch() returned data' ); is( $hash{id}, 27, 'bind_columns with hash, id == 1' ); is( $hash{type}, 'african', 'bind_columns with hash, type == "african"' ); is( $hash{inventory_id}, 2, 'bind_columns with hash, inventory_id == 2' ); } { ok( ! $sth->fetchrow_arrayref(), 'fetchrow_arrayref returns false after data is exhausted, even with bound columns' ); } { $dbh->{mock_clear_history} = 1; my @rows = ( [ '1', 'european', '42' ], [ '27', 'african', '2' ], ); $dbh->{mock_add_resultset} = [ [ 'id', 'type', 'inventory_id' ], @rows, ]; my $results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow' ); is_deeply( $results, \@rows, 'bind_col implementation does not break selectall_* methods' ); } DBD-Mock-1.45/t/998_pod.t0000644000175000017500000000022011603226735014403 0ustar marianomarianouse strict; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); DBD-Mock-1.45/t/029_multiple_prepare_statements.t0000644000175000017500000000253611655005073021433 0ustar marianomarianouse 5.006; use strict; use warnings; use Test::Exception; use Test::More tests => 7; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $dbh = DBI->connect( 'DBI:Mock:', '', '', { RaiseError => 1 } ); my $mock_session = DBD::Mock::Session->new( { statement => qr/SELECT name, id FROM person/, results => [ [ 'name', 'id' ], [ 'Charles', 2 ], [ 'Wall', 3 ], ] }, { statement => qr/SELECT email FROM client/, results => [ [ 'name', 'email' ], [ 'Charles', 'noreply@nodomain.com' ], [ 'Wall', 'noreply@nodomain.com' ], ] } ); $dbh->{mock_session} = $mock_session; my $first_sth; my $second_sth; lives_ok( sub { $second_sth = $dbh->prepare("SELECT email FROM client"); $first_sth = $dbh->prepare("SELECT name, id FROM person"); $first_sth->execute(); $second_sth->execute(); my $row = $first_sth->fetchrow_hashref; is( $row->{name}, 'Charles', 'First statement first column' ); is( $row->{id}, '2', 'First statement second column' ); $row = $second_sth->fetchrow_hashref; is( $row->{name}, 'Charles', 'Second statement first column' ); is( $row->{email}, 'noreply@nodomain.com', 'Second statement second column' ); }, 'Prepare two statements' ); DBD-Mock-1.45/t/007_mock_attribute_aliases.t0000644000175000017500000000441211603226735020322 0ustar marianomarianouse strict; use Test::More tests => 25; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } { # aliasing is off my $dbh; eval { $dbh = DBI->connect('dbi:Mock:mysql', '', ''); }; ok(!$@, '... got our non-mock DB successfully'); isa_ok($dbh, 'DBI::db'); ok(!defined($dbh->{mock_attribute_aliases}), '... nothing here'); ok(!$dbh->{mock_database_name}, '... nothing here'); } # now turn it on $DBD::Mock::AttributeAliasing++; { # but without a dbname it does nothing my $dbh; eval { $dbh = DBI->connect('dbi:Mock:', '', ''); }; ok(!$@, '... got our non-mock DB successfully'); isa_ok($dbh, 'DBI::db'); ok(!defined($dbh->{mock_attribute_aliases}), '... nothing here'); ok(!$dbh->{mock_database_name}, '... nothing here'); } # now test the error eval { DBI->connect('dbi:Mock:Fail', '', ''); }; like($@, qr/Attribute aliases not available for \'Fail\'/, '... got the error we expected'); # test the MySQL mock db { my $dbh; eval { $dbh = DBI->connect('dbi:Mock:mysql', '', ''); }; ok(!$@, '... got our mock DB successfully'); isa_ok($dbh, 'DBI::db'); is($dbh->{mock_database_name}, 'mysql', '... and its the name we expected'); ok(defined($dbh->{mock_attribute_aliases}), '... got something here'); is(ref($dbh->{mock_attribute_aliases}), 'HASH', '... and its the hash we expected'); my $sth = $dbh->prepare('INSERT INTO Foo (bar) VALUES(NULL)'); isa_ok($sth, 'DBI::st'); $sth->execute(); is($dbh->{mysql_insertid}, 1, '... our alias works'); } # and test it with the lowercasing { my $dbh; eval { $dbh = DBI->connect('dbi:Mock:MySQL', '', ''); }; ok(!$@, '... got our mock DB successfully'); isa_ok($dbh, 'DBI::db'); is($dbh->{mock_database_name}, 'MySQL', '... and its the name we expected'); ok(defined($dbh->{mock_attribute_aliases}), '... got something here'); is(ref($dbh->{mock_attribute_aliases}), 'HASH', '... and its the hash we expected'); my $sth = $dbh->prepare('INSERT INTO Foo (bar) VALUES(NULL)'); isa_ok($sth, 'DBI::st'); $sth->execute(); is($dbh->{mysql_insertid}, 1, '... our alias works'); } DBD-Mock-1.45/t/019_mock_statement_track_iterator.t0000644000175000017500000000272711603226735021731 0ustar marianomarianouse strict; use Test::More tests => 22; BEGIN { use_ok('DBD::Mock'); } # just test the iterator plain { my $i = DBD::Mock::StatementTrack::Iterator->new([ 1 .. 5 ]); isa_ok($i, 'DBD::Mock::StatementTrack::Iterator'); is($i->next(), 1, '... got 1'); is($i->next(), 2, '... got 2'); is($i->next(), 3, '... got 3'); is($i->next(), 4, '... got 4'); is($i->next(), 5, '... got 5'); ok(!defined($i->next()), '... got undef'); $i->reset(); is($i->next(), 1, '... got 1'); is($i->next(), 2, '... got 2'); is($i->next(), 3, '... got 3'); is($i->next(), 4, '... got 4'); is($i->next(), 5, '... got 5'); ok(!defined($i->next()), '... got undef'); } # and now test it within context my $dbh = DBI->connect('DBI:Mock:', '', ''); isa_ok($dbh, 'DBI::db'); my $i = $dbh->{mock_all_history_iterator}; isa_ok($i, 'DBD::Mock::StatementTrack::Iterator'); ok(!defined($i->next()), '... nothing in the iterator'); $dbh->prepare("INSERT INTO nothing (nothing) VALUES('nada')"); ok(defined($i->next()), '... now something in the iterator (which is what we want)'); $dbh->prepare("INSERT INTO nothing (nothing) VALUES('nada')"); my $next = $i->next(); ok(defined($next), '... something in the iterator'); isa_ok($next, 'DBD::Mock::StatementTrack'); is($next->statement, "INSERT INTO nothing (nothing) VALUES('nada')", '... its our old insert statement too'); ok(!defined($i->next()), '... now nothing in the iterator'); DBD-Mock-1.45/t/999_pod_coverage.t0000644000175000017500000000036311654534326016273 0ustar marianomarianouse strict; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; plan tests => 1; pod_coverage_ok( 'DBD::Mock' ,{ trustme => [ qr/CLONE|driver/ ], }); DBD-Mock-1.45/t/bug_0002.t0000755000175000017500000000741711654534326014454 0ustar marianomariano#!/usr/bin/perl use Test::More tests => 15; use strict; use warnings; use Test::Exception; use DBI; use DBD::Mock; # This test is designed to expose the bug found in the DBD::Mock # methods begin_work, commit and rollback (RT #66815), where a failing # ->prepare invocation (returning nothing) is not detected and the # undefined value resulting is used anyway. In this test, as in the # example found in the wild, the failure is triggered by exhaustion of # the session states. # # This is a list of sessions designed to engineer the right condition # to trigger the bug. They all start with a dummy statement (so that # there are at least two states) then the final statement is removed # before it is passed to DBD::Mock::Session->new (which requires at # least one state). The final statements are 'BEGIN WORK', 'COMMIT' # and 'ROLLBACK', respectively. # # Hence, when the test tries to invoke the final state, the session # will have run out and DBD::Mock->verify_statement will cause the # prepare method to fail. my @cases = ( 'begin_work' => [ { statement => 'SELECT something FROM somewhere', results => [], }, { statement => 'BEGIN WORK', results => [], }, ], 'commit' => [ { statement => 'SELECT something FROM somewhere', results => [], }, { statement => 'BEGIN WORK', results => [], }, { statement => 'INSERT INTO foo (bar) VALUES (?);', results => [], bound_params => [1], }, { statement => 'COMMIT', results => [], }, ], 'rollback' => [ { statement => 'SELECT something FROM somewhere', results => [], }, { statement => 'BEGIN WORK', results => [], }, { statement => 'INSERT INTO foo (bar) VALUES (?);', results => [], bound_params => [1], }, { statement => 'ROLLBACK', results => [], }, ], ); while(@cases) { my ($name, $states) = splice @cases, 0, 2; my $case_name = "case $name"; my $dbh = DBI->connect('dbi:Mock:', '', '', { PrintError => 0, RaiseError => 1 }); # Add all but the last state of the expected session my $missing_state = pop @$states; my $num_states = @$states; $dbh->{mock_session} = DBD::Mock::Session->new($name => @$states); # Execute the initial dummy statement. my $state = $states->[0]; my $sth = $dbh->prepare($state->{statement}); ok $sth, "$case_name: prepare statement"; ok $sth->execute(), "$case_name: execute statement"; # Now try and do the next steps in @session, but using the # appropriate transaction methods directly. This should fail when # the session is exhausted with a useful message. (The original # bug meant that the message got clobbered by "Can't call method # 'execute' on an undefined value".) throws_ok { # This stlibatement is always the same. ok $dbh->begin_work, "$case_name: start transaction"; my $state = $states->[2]; my $sth = $dbh->prepare($state->{statement}); ok $sth, "$case_name: prepare statement"; ok $sth->execute(@{$state->{bound_params}}), "$case_name: execute statement"; # get the final operation from the session my $operation = lc $missing_state->{statement}; ok $dbh->$operation, "$case_name: $operation transaction"; } qr/\QSession states exhausted, only '$num_states' in DBD::Mock::Session\E/; } DBD-Mock-1.45/t/016_mock_add_resultset_test.t0000644000175000017500000000511011603226735020513 0ustar marianomarianouse strict; use Test::More tests => 19; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test the ability to overwrite a # hash based 'mock_add_resultset' # and have it work as expected # tests for the return value of execute below as well my $dbh = DBI->connect('dbi:Mock:', '', ''); isa_ok($dbh, 'DBI::db'); $dbh->{mock_add_resultset} = { sql => 'SELECT foo FROM bar', results => [[ 'foo' ], [ 10 ]] }; { my $sth = $dbh->prepare('SELECT foo FROM bar'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement'); my ($result) = $sth->fetchrow_array(); is($result, 10, '... got the result we expected'); $sth->finish(); } $dbh->{mock_add_resultset} = { sql => 'SELECT foo FROM bar', results => [[ 'foo' ], [ 50 ]] }; { my $sth = $dbh->prepare('SELECT foo FROM bar'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement'); my ($result) = $sth->fetchrow_array(); is($result, 50, '... got the result we expected'); $sth->finish(); } # get it again { my $sth = $dbh->prepare('SELECT foo FROM bar'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement'); my ($result) = $sth->fetchrow_array(); is($result, 50, '... got the result we expected'); $sth->finish(); } # and one more time for good measure { my $sth = $dbh->prepare('SELECT foo FROM bar'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement'); my ($result) = $sth->fetchrow_array(); is($result, 50, '... got the result we expected'); $sth->finish(); } ## test the return value of execute $dbh->{mock_add_resultset} = { sql => 'INSERT INTO foo VALUES(bar)', results => [[], []] }; # check no SELECT statements { my $sth = $dbh->prepare('INSERT INTO foo VALUES(bar)'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, 1, '... got back 1 for rows with our INSERT statement'); $sth->finish(); } $dbh->{mock_add_resultset} = { sql => 'UPDATE foo SET(bar = "baz")', results => [[], [], [], [], []] }; # check no SELECT statements { my $sth = $dbh->prepare('UPDATE foo SET(bar = "baz")'); isa_ok($sth, 'DBI::st'); my $rows = $sth->execute(); is($rows, 4, '... got back 4 for rows with our UPDATE statement'); $sth->finish(); } DBD-Mock-1.45/t/028_bind_columns.t0000644000175000017500000000202011654572673016270 0ustar marianomarianouse 5.006; use strict; use warnings; use Test::Exception; use Test::More tests => 6; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $dbh = DBI->connect( 'DBI:Mock:', '', '', { RaiseError => 1 } ); my $mock_session = DBD::Mock::Session->new( { statement => qr/SELECT/, bound_params => [ 'US', '%joe%' ], results => [ [ 'person.person_id', 'person.person_country', 'person.person_name' ], [ 1, 'AR', 'Joe Something' ], [ 2, 'UY', 'Joe That' ], [ 3, 'AR', 'Joe' ], ] } ); $dbh->{mock_session} = $mock_session; my $sth = $dbh->prepare("SELECT ..."); $sth->execute( 'US', '%joe%' ); my %row; lives_ok( sub { $sth->bind_columns( \( @row{ @{ $sth->{NAME_lc} } } ) ); }, 'Bind columns' ); ok( exists $row{'person.person_name'}, 'First column' ); ok( exists $row{'person.person_country'}, 'Second column' ); ok( exists $row{'person.person_id'}, 'Third column' ); DBD-Mock-1.45/t/006_prepare_cached.t0000644000175000017500000000205611626576200016533 0ustar marianomarianouse strict; use Test::More tests => 11; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } my $dbh = DBI->connect('dbi:Mock:', '', ''); isa_ok($dbh, 'DBI::db'); foreach my $i ( 1 .. 2 ) { my $sth = $dbh->prepare('SELECT foo FROM bar WHERE x = ?'); $sth->execute($i); my $history = $dbh->{mock_all_history}; is(scalar(@{$history}), $i, "... have $i statement executions"); } $dbh->{mock_clear_history} = 1; my $history = $dbh->{mock_all_history}; is(scalar(@{$history}), 0, '... the history has been is cleared'); foreach my $i ( 1 .. 2 ) { my $sth = $dbh->prepare_cached('SELECT foo FROM bar WHERE x = ?'); $sth->execute($i); my $history = $dbh->{mock_all_history}; is(scalar(@{$history}), $i, "... have $i statement executions"); } my $st_track = $dbh->{mock_all_history}->[0]; isa_ok($st_track, 'DBD::Mock::StatementTrack'); is($st_track->statement, 'SELECT foo FROM bar WHERE x = ?', '... our statements match'); my $params = $st_track->bound_params; is(scalar(@{$params}), 1, '... got the expected amount of params'); DBD-Mock-1.45/t/008_db_connect_cached.t0000644000175000017500000000063611603226735017177 0ustar marianomarianouse strict; use Test::More tests => 5; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test that connect cached works as expected. { my $dbh = DBI->connect_cached('DBI:Mock:', 'user', 'pass'); isa_ok($dbh, 'DBI::db'); my $dbh2 = DBI->connect_cached('DBI:Mock:', 'user', 'pass'); isa_ok($dbh2, 'DBI::db'); is($dbh, $dbh2, '.. these should be the same handles'); } DBD-Mock-1.45/t/004_misc_mock_attr.t0000644000175000017500000000436511603226735016607 0ustar marianomarianouse strict; use Test::More tests => 27; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test misc. attributes of $dbh my $dbh = DBI->connect('DBI:Mock:', '', ''); isa_ok($dbh, 'DBI::db'); $dbh->{AutoCommit} = 1; ok($dbh->{AutoCommit}, '... it handles AutoCommit as well'); $dbh->{AutoCommit} = 0; ok(! $dbh->{AutoCommit}, '... and turns off AutoCommit as well'); for (0 .. 5) { my $sth = $dbh->prepare('SELECT * FROM foo'); $sth->execute(); } is(scalar(@{$dbh->{mock_all_history}}), 6, '... we have 6 statements'); $dbh->{mock_clear_history} = 1; is(scalar(@{$dbh->{mock_all_history}}), 0, '... we have 0 statements'); # test the misc. attributes of $sth $dbh->{mock_add_resultset} = [['foo'], [1], [2], [3]]; my $SQL = 'SELECT foo FROM bar WHERE baz = ?'; # prepare a statement my $sth = $dbh->prepare($SQL); # mock_is_executed is($sth->{mock_is_executed}, 'no', '... not executed yet'); # execute and bind the param $sth->execute('test'); is($sth->{mock_is_executed}, 'yes', '... has been executed now'); # mock_my_history my $history = $sth->{mock_my_history}; ok($history, '... got something back for our history'); isa_ok($history, 'DBD::Mock::StatementTrack'); # mock_statement is($sth->{mock_statement}, $SQL, '... our statement is as expected'); # mock_fields is_deeply( $sth->{mock_fields}, [ 'foo' ], '... our fields is as expected'); # mock_records is_deeply( $sth->{mock_records}, [[1], [2], [3]], '... we have 3 records'); # mock_num_records is($sth->{mock_num_records}, 3, '... we have 3 records'); # mock_current_record_num is($sth->{mock_current_record_num}, 0, '... we are at record number 0'); # mock_is_finished is($sth->{mock_is_finished}, 'no', '... we are not yet finished'); # mock_is_depleted ok(!$sth->{mock_is_depleted}, '... nor are we depleted'); for (1 .. 3) { is(($sth->fetchrow_array())[0], $_, '... got the expected row'); is($sth->{mock_current_record_num}, $_, '... we are at record number ' . $_); } # mock_is_depleted ok($sth->{mock_is_depleted}, '... now we are depleted'); # mock_is_finished is($sth->{mock_is_finished}, 'no', '... we are not yet finished'); $sth->finish(); # mock_is_finished is($sth->{mock_is_finished}, 'yes', '... and we are now finished'); DBD-Mock-1.45/t/003_db_can_connect.t0000644000175000017500000000517411603226735016526 0ustar marianomarianouse strict; use Test::More tests => 22; BEGIN { use_ok('DBD::Mock'); use_ok('DBI'); } # test this as an exception { my $dbh = DBI->connect('DBI:Mock:', '', '', { RaiseError => 1, PrintError => 0 }); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{RaiseError}, 1, '... make sure RaiseError is set correctly'); # check to see it is active in the first place ok($dbh->{Active}, '...our handle with the default settting is Active' ); ok($dbh->ping(), '...and successfuly pinged handle' ); $dbh->{mock_can_connect} = 0; # check our value is correctly set is($dbh->{mock_can_connect}, 0, '... can connect is set to 0'); # and check the side effects of that ok(!$dbh->{Active}, '...our handle is no longer Active after setting mock_can_connect'); ok(!$dbh->ping(), '...and unsuccessfuly pinged handle (good)'); my $sth = eval { $dbh->prepare( "SELECT foo FROM bar" ) }; ok($@, '... we should have an exception'); like($@, qr/No connection present/, 'Preparing statement against inactive handle throws expected exception' ); like($dbh->errstr, qr/^No connection present/, 'Preparing statement against inactive handle sets expected DBI error' ); $dbh->disconnect(); } # and now test this as a warning { my $dbh = DBI->connect('DBI:Mock:', '', '', { PrintError => 1 }); isa_ok($dbh, "DBI::db"); # check to be sure this is set, otherwise # the test wont be set up right is($dbh->{PrintError}, 1, '... make sure PrintError is set correctly'); # check to see it is active in the first place ok($dbh->{Active}, '...our handle with the default settting is Active' ); ok($dbh->ping(), '...and successfuly pinged handle' ); $dbh->{mock_can_connect} = 0; # check our value is correctly set is($dbh->{mock_can_connect}, 0, '... can connect is set to 0'); # and check the side effects of that ok(!$dbh->{Active}, '...our handle is no longer Active after setting mock_can_connect'); ok(!$dbh->ping(), '...and unsuccessfuly pinged handle (good)'); { # isolate the warn handler local $SIG{__WARN__} = sub { my $msg = shift; like($msg, qr/No connection present/, '...got the expected warning'); }; my $sth = eval { $dbh->prepare( "SELECT foo FROM bar" ) }; ok(!$@, '... we should not have an exception'); ok(!defined($sth), '... and our statement should be undefined'); } $dbh->disconnect(); } DBD-Mock-1.45/Changes0000644000175000017500000003164512041122471014057 0ustar marianomarianoRevision history for Perl extension DBD::Mock. {{NEXT}} - Add git-repo url to meta-data 1.43 - Segregated into different packages - Removed code coverage from POD - Fixed bug rt49537 Basic support for named parameters - Fixed bug rt70421 Build.PL now contains Test::Exception 1.42 - Fixed bug rt66815 DBD::Mock::Session error clobbered - Fixed bug rt69460 Info on META.yml is outdated - Fixed bug rt69055 Spelling mistakes in POD - RaiseError now works 1.41 June 22, 2011 - Changed incorrect verion number 1.40 June 19, 2011 - Fixed bug rt44591 second preapre giving an error - Fixed bug rt57981 warnings during clone - Fixed bug rt63191 Synopsis errors - Fixed bug rt66813 Google's group link in the POD 1.39 November 9, 2008 - If a statement handle had bound columns, then the fetch() and fetchrow_arrayref() methods never returned false. After they exhausted their data, they kept returning empty array references. - Hid all packaged but DBD::Mock from PAUSE. 1.38 November 8, 2008 - Bumped minimum Perl to 5.8.1, since that's what DBI requires. - Fixed incorrect use of no_plan in t/025_mock_last_insert_id.t. - The handling of attributes passed to the constructor was not correct. The major symptom was that attributes (such as RaiseError) which were passed to the constructor could not be overridden in the database handle which was returned from connect(). As a result, some attributes set to a false value may return '' instead of 0. 1.37 June 12, 2008 - New co-maintainer (aka sucker), Dave Rolsky - Added support for $sth->bind_col() and $sth->bind_cols() - Fixed and clarified docs for the mock_last_insert_id and mock_start_insert_id attributes. The previous docs were both wrong and confusing - Applied patch from RT #35145 to add support for the Column attribute with selectcol_arrayref - patch by Matt Lawrence 1.36 October 18, 2007 - $dbh->last_insert_id() now works as documented - Added a "use 5.006;" in order to put a safeguard on the "use warnings;" statement a little further down. 1.35 July 9, 2007 - Applying path from RT #16951 to return new result set for repeated calls to $sth->execute(). Thanks to Marc Beyer for this. - added tests for this - Fixing RT #25892 to make mock_records method work correctly. - added test for this - applying patch from RT #26604 to fix AutoCommit behavior. Thanks to Ryan Gerry for this. 1.34 July, 29 2006 - Fixed how AutoCommit is handled to avoid $dbh caching (RobK) - Thanks to Chas Owens for patch and test for the mock_can_prepare, mock_can_execute, and mock_can_fetch features. 1.32 Wed Dec 14, 2005 - Fixed RT Bug #15599 - Fixed RT Bug #15602 - converted to Module::Build - removed the VERSION file, and adjusted the numbers in all places needed - added patch from Andrew W. Gibbs to allow the ARRAY version of 'mock_last_insert_id' attribute - added test file as well - added docs on it too - $sth->execute now returns the number of rows as per the DBI docs - added some tests for this >> DBD::Mock::Session - now allows regexp's in the bound_params list so that you can check your params are 'like' something, and not exactly something - Improved error messages 0.28 Wen July 13, 2005 - update to patch from Andrew McHarg to fix behavior in selectcol_arrayref() methods and tests - fix version in META.yml - some refactoring of fetchall_hashref(), fetchrow_hashref() to incorporate DBD-Mock error handling. 0.27 Mon July 11, 2005 - added NULL_RESULTSET constant - now allowing errors to be set with mock_add_resultset. Support is currently experimental, see the file 't/023_statement_failure.t' and the EXPERIMENTAL section of the docs for more information. - added patch from Collin Winter to fix a bug in the begin_work(), commit() and rollback() methods - added patch from Andrew McHarg for the fetchall_hashref(), fetchrow_hashref() and selectcol_arrayref() methods and tests 0.26 Fri Apr 08 2005 - added Rob Kinyon to the AUTHORS list - added get_info() and set_info() - added tests for this - added bind_param_inout() for DBD::Mock::st code from Thilo Planz (Thanks Thilo) - added tests for this - added mock_data_sources and mock_add_data_sources properties for the Driver and Database handles - added tests and docs for this - added begin_work(), commit() and rollback() method implementations which wrap the prepare() method and deal with the AutoCommit value per the DBI spec. - added tests and docs for this 0.25 Sat Feb 26 2005 - removed the DBD::Mock::_error_handler routine since it was actually redundant with the DBI::set_err method. This was actually the source of the RT Bug #11515 which was found by Shlomi Fish (thanks Shlomi) - adjusted some tests for this fix 0.24 Fri Jan 28 2005 - added the reset() method to the DBD::Mock::Session object so that a session can be used more than once. - added tests for this - added docs for this - fixed a bug where the HASH version of 'mock_add_resultset' would consume the result sets and they would not be reusable. We now copy the result sets so that every time the statement is called the same results are returned - did not need to add docs for this, they already documented this as the behavior (hence calling this a bug) - added tests for this 0.23 Tues Jan 25 2005 - removed the trace log tests from t/10_db_handle.t since they seemed to be a source of issues on Win32. My rationale is that it is a DBI thing, and therefore does not need to be tested by DBD::Mock. - added a few more tests to t/11_dr_handle.t to test the 'mock_connect_fail' feature - added some clarification in the docs about the 'mock_connect_fail' feature as well. 0.22 Mon Jan 24 2005 - added the 'mock_connect_fail' boolean attribute for the DBD::Mock driver handle, this will prevent DBI from connecting. It can be used to simulate a bad DSN or something like that. - added tests and documentation for this. - Thanks to Justin DeVuyst for this idea. 0.21 Sun Jan 16 2005 > DBD::Mock::Session - added the optional 'bound_params' slot for the DBD::Mock::Session object - added tests for this - added documentation for this - added error to handle cases where there are not enough states in a DBD::Mock::Session object. - added tests for this - added documentation for this - added the ability to remove a session (by setting it to a false value) - added tests for this - added documenation for this > DBD::Mock - added test to check about overwriting hash-based result sets with 'mock_add_resultset' attribute - added documentation for this 0.20 Fri Jan 14 2005 - Modified a set of tests in t/10_db_handle.t to pass on Cygwin. Thanks to Rob Kinyon for this code. This code now uses File::Temp to make the temp log file in a cross platform manner. If File::Temp is not found on the system, then the tests are skipped. 0.19 Fri Jan 7 2005 - changed the VERSION in lib/DBD/Mock.pm to be 1.23, allow me to explain... Chris Winters (the original author ) used the CVS derived VERSION, which when I took over the module (8 versions ago) was at 1.15. Since I was not using Chris's CVS repo to store this I decided to give Mock.pm the VERSION number found in the VERSION file. Well,... PAUSE's indexer doesn't like it since it is a lower number and would complain every time I uploaded a new version. I ignored these complaints (at my own peril) until now. I found out recently that if you had version 0.11 or below installed (where the Mock.pm was version 1.15 or below), then installing through the CPAN shell would tell you DBD::Mock was up to date, even though it wasn't. So in order to fix this issue, and make sure that all those who want to install and update DBD::Mock easily, I changed the version number of DBD::Mock to be 1.23 to reflect the number of updates I have done since Chris handed it over to me. *sigh* Okay good, thats off my chest now. 0.18 Wed Jan 5 2005 - added reset() method to the DBD::Mock::StatementTrack::Iterator object - added test and docs for this - added the DBD::Mock::Session object and added the support for it in the DBD::Mock driver - added tests and docs for this - Thanks to Rob Kinyon and Chris Winters for their feedback on this feature - some general POD cleanup and formatting 0.17 Thurs Nov 4 2004 - added the following items: - a 'mock_num_rows' attribute which will give you the number of records affected/returned by the last statement - a num_rows method in the DBD::Mock::StatementTrack object, which is where the above attribute gets it's value - added the 'rows' method for statement handles (which didnt work before) 0.16 Sat Oct 30 2004 - minor change to the DBD::Mock::StatementTrack::Iterator behavior. It no longer derefs the history array, so it maintains a reference to it and therefore can be used like this: get-statement-iterator run-query check-next-statement-in-iterator run-query check-next-statement-in-iterator ... This prevents the need to re-fetch the iterator after each query. 0.15 Fri Oct 29 2004 - added the DBD::Mock::StatementTrack::Iterator object which can be accessed from the 'mock_all_history_iterator' attribute. - write the docs and test for it 0.14 Fri Oct 29 2004 - added the mock_last_insert_id attribute which will get incremented upon each INSERT query run. - added tests and docs for this - added the mock_start_insert_id attirbute so that you can both reset and set the start number for mock_last_insert_id - added tests and docs for this ** EXPERIMENTAL FEATURE (use caution) ** - added a feature to alias attributes. Basically it allows you to alias an expected attribute like 'mysql_insertid' to something DBD::Mock already has like 'mock_last_insert_id'. Right now this feature is highly experimental, and has been added as a first attempt automatically handle some of the DBD specific attributes which are commonly used/accessed in DBI programming. 0.13 Thurs Oct 28 2004 - added prepare_cached as suggested by Rob Kinyon in RT bug #7331. Also added his test script in 15_prepare_cached.t 0.12 Thurs Sept 2 2004 ** First version maintained by Stevan Little ** - built up the test suite to 89.7% coverage - removed the undocumented 'mock_auto_commit' since it really was not very useful at this point. - added the DBD::Mock::Pool functionality - added tests for this - added documentation for this - added pod.t to test suite - removed AUTOLOAD in DBD::Mock::StatementTrack and replaced it with hand coded methods (sorry I really dislike AUTOLOAD) - centralized error handling in DBD::Mock::_error_handler 0.11 Fri Jul 23 10:35:13 EDT 2004 - Fix CPAN Bug #7057: add a no-op 'disconnect_all()' to DBD::Mock::dr to support DBI versions earlier than 1.34. - Add the ability to create SQL parsers that get fired on a prepare(). This way you can ensure your application generates correct SQL and have the system fail at the right time. Thanks to Rob Kinyon for the idea. 0.10 Sat May 8 14:12:39 EDT 2004 - Incorporate number of patches from Stevan Little to implement 'mock_can_connect', which allows you to simulate a downed database. Add supporting tests for database and statement usage. - Add the ability for 'mock_add_resultset' to associate a resultset with a particular SQL statement. Thanks to Stevan for the idea. - Add documentation for database handle property 'mock_add_resultset' 0.02 Tue Mar 9 12:56:54 EST 2004 Add 'VERSION' to MANIFEST, thanks to Mike Castle for the note. 0.01 Sun Mar 7 23:24:24 EST 2004 Initial version spawned from DBD::NullP shipped with the DBI. Many thanks much to Tim Bunce for the pointer and the original code. DBD-Mock-1.45/META.yml0000664000175000017500000000073312041122556014035 0ustar marianomariano--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DBD-Mock no_index: directory: - t - inc requires: DBI: 1.3 Test::Exception: 0.31 Test::More: 0.47 version: 1.45 DBD-Mock-1.45/README0000644000175000017500000000162711603226735013454 0ustar marianomarianoDBD::Mock ===================== This is a simple mock DBD implementation used for testing. It's entirely self-contained so that you can extract the single library file (DBD/Mock.pm), put it in your own distribution and be able to run DBI-based tests even though you don't have information about a database. (If you're doing so you should probably get rid of the docs to save space...) INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: DBI (wouldn't make too much sense without it...) COPYRIGHT AND LICENCE Copyright (C) 2004 Chris Winters Copyright (C) 2004-2007 Stevan Little This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ========================================DBD-Mock-1.45/MYMETA.json0000644000175000017500000000160112041122554014442 0ustar marianomariano{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DBD-Mock", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DBI" : "1.3", "Test::Exception" : "0.31", "Test::More" : "0.47" } } }, "release_status" : "stable", "version" : "1.45" } DBD-Mock-1.45/MANIFEST0000644000175000017500000000237712041122556013721 0ustar marianomarianoBuild.PL Changes lib/DBD/Mock.pm lib/DBD/Mock/db.pm lib/DBD/Mock/dr.pm lib/DBD/Mock/Pool.pm lib/DBD/Mock/Pool/db.pm lib/DBD/Mock/Session.pm lib/DBD/Mock/st.pm lib/DBD/Mock/StatementTrack.pm lib/DBD/Mock/StatementTrack/Iterator.pm Makefile.PL MANIFEST This list of files MYMETA.json MYMETA.yml README t/000_basic.t t/001_db_handle.t t/002_dr_handle.t t/003_db_can_connect.t t/004_misc_mock_attr.t t/005_db_parser.t t/006_prepare_cached.t t/007_mock_attribute_aliases.t t/008_db_connect_cached.t t/009_info.t t/010_rollback.t t/011_st_execute_empty.t t/012_st_handle.t t/013_st_execute_bound_params.t t/014_st_execute_pass_params.t t/015_st_fetch_records.t t/016_mock_add_resultset_test.t t/017_st_can_connect.t t/018_mock_statement_track.t t/019_mock_statement_track_iterator.t t/020_db_pool.t t/021_DBD_Mock_Session.t t/022_DBD_Mock_Session_bound_params.t t/023_statement_failure.t t/024_selcol_fetchhash.t t/025_mock_last_insert_id.t t/026_st_bind_col.t t/027_named_parameters.t t/028_bind_columns.t t/029_multiple_prepare_statements.t t/998_pod.t t/999_pod_coverage.t t/bug_0001.t t/bug_0002.t t/bug_0003.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) DBD-Mock-1.45/Build.PL0000644000175000017500000000120512041122471014045 0ustar marianomarianouse Module::Build; use 5.008001; use strict; use warnings; my $build = Module::Build->new( module_name => 'DBD::Mock', license => 'perl', requires => { 'perl' => '5.6.0', 'DBI' => 1.30, }, optional => {}, build_requires => { 'Test::More' => '0.47', 'Test::Exception' => '0.31', }, create_makefile_pl => 'traditional', recursive_test_files => 1, add_to_cleanup => [ '*.bak', ], meta_merge => { resources => { repository => 'https://github.com/bluescreen10/dbd-mock', }, }, ); $build->create_build_script;