use
vars
qw{$VERSION @ISA @EXPORT}
;
BEGIN {
$VERSION
=
'0.11'
;
@ISA
=
'Exporter'
;
@EXPORT
=
qw{ test_db connect_ok create_ok create_dist }
;
}
sub
test_db {
my
$file
= catfile(
@_
?
@_
:
't'
,
'sqlite.db'
);
clear(
$file
);
return
$file
;
}
sub
connect_ok {
my
$dbh
= DBI->
connect
(
@_
);
Test::More::isa_ok(
$dbh
,
'DBI::db'
);
return
$dbh
;
}
sub
create_ok {
my
%param
=
@_
;
my
$file
=
$param
{file};
local
*FILE
;
local
$/ =
undef
;
open
( FILE,
$file
);
my
$buffer
= <FILE>;
close
( FILE );
my
$dbh
= connect_ok( @{
$param
{
connect
}} );
my
@statements
=
split
( /\s*;\s*/,
$buffer
);
foreach
my
$statement
(
@statements
) {
$dbh
->
do
(
$statement
);
}
if
(
$param
{user_version} ) {
$dbh
->
do
(
"pragma user_version = $param{user_version}"
);
}
return
$dbh
;
}
sub
create_dist {
my
$sql_file
=
shift
;
my
$dist
= catdir(
't'
,
'Foo-Bar'
);
clear(
$dist
);
mkdir
$dist
;
create_ok(
file
=> catfile(
't'
,
$sql_file
),
connect
=> [
'dbi:SQLite:'
. catfile(
$dist
,
'sqlite.db'
),
],
);
mkdir
catdir(
$dist
,
'lib'
);
mkdir
catdir(
$dist
,
'lib'
,
'Foo'
);
open
( FILE,
'>'
, catfile(
$dist
,
'lib'
,
'Foo'
,
'Bar.pm'
) );
print
FILE
<<'END_PERL'; close FILE;
package Foo::Bar;
use strict;
use ORLite 'sqlite.db';
1;
END_PERL
mkdir
catdir(
$dist
,
't'
);
WriteXT(
'Test::Pod'
=> catfile(
$dist
,
't'
,
'pod.t'
),
);
return
$dist
;
}
1;