File: Test.pm

package info (click to toggle)
liborlite-migrate-perl 1.10-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 248 kB
  • ctags: 152
  • sloc: perl: 1,885; makefile: 2
file content (73 lines) | stat: -rw-r--r-- 1,403 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
package t::lib::Test;

use strict;
use Exporter        ();
use Test::More      ();
use ORLite          ();
use ORLite::Migrate ();
use File::Spec::Functions ':ALL';

use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
        $VERSION = '1.09';
	@ISA     = 'Exporter';
	@EXPORT  = qw{ test_db connect_ok create_ok };
}





#####################################################################
# Test Methods

my %to_delete = ();
END {
	foreach my $file ( sort keys %to_delete ) {
		unlink $file;
	}
}

sub test_db {
	my $file = catfile( @_ ? @_ : 't', 'sqlite.db' );
	unlink $file if -f $file;
	$to_delete{$file} = 1;
	return $file;
}

sub connect_ok {
	my $dbh = DBI->connect(@_);
	Test::More::isa_ok( $dbh, 'DBI::db' );
	return $dbh;
}

sub create_ok {
	my %param = @_;

	# Read the create script
	my $file = $param{file};
	local *FILE;
	local $/ = undef;
	open( FILE, $file )          or die "open: $!";
	defined(my $buffer = <FILE>) or die "readline: $!";
	close( FILE )                or die "close: $!";

	# Get a database connection
	my $dbh = connect_ok( @{$param{connect}} );

	# Create the tables
	my @statements = split( /\s*;\s*/, $buffer );
	foreach my $statement ( @statements ) {
		# Test::More::diag( "\n$statement" );
		$dbh->do($statement);
	}

	# Set the user_version if needed
	if ( $param{user_version} ) {
		$dbh->do("pragma user_version = $param{user_version}");
	}

	return $dbh;
}

1;