File: 06_create.t

package info (click to toggle)
liborlite-perl 1.97-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 524 kB
  • sloc: perl: 3,693; sql: 97; makefile: 2
file content (151 lines) | stat: -rw-r--r-- 3,492 bytes parent folder | download | duplicates (5)
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#!/usr/bin/perl

# Tests database creation, pragmas and versions

use strict;

BEGIN {
	$|  = 1;
	$^W = 1;
}

use Test::More tests => 25;
use File::Spec::Functions ':ALL';
use t::lib::Test;





#####################################################################
# Simple Test Creation

SCOPE: {
	# Set up the file
	my $file = test_db();

	# Create the test package
	eval <<"END_PERL"; die $@ if $@;
package My::Test1;

use strict;
use ORLite {
	file   => '$file',
	create => 1,
	tables => 0,
	append => 'sub append { 2 }',
};

1;
END_PERL

	ok( My::Test1->can('connect'), 'Created read code'  );
	ok( My::Test1->can('begin'),   'Created write code' );

	# Test ability to get and set pragmas
	is( My::Test1->pragma('schema_version' ), 0, 'schema_version is zero' );
	is( My::Test1->pragma('user_version' ), 0, 'user_version is zero' );
	is( My::Test1->pragma('user_version', 2 ), 2, 'Set user_version' );
	is( My::Test1->pragma('user_version' ), 2, 'Confirm user_version changed' );

	# Test that the schema_version is updated as expected
	ok( My::Test1->do('create table foo ( bar int )'), 'Created test table' );
	is( My::Test1->pragma('schema_version' ), 1, 'schema_version is zero' );

	# Test the appending of additional code
	is( My::Test1->append, 2, 'append params works as expected' );
}





#####################################################################
# Complex Test Case

SCOPE: {
	# Set up the file
	my $file = test_db();

	# Create the test package
	eval <<"END_PERL"; die $@ if $@;
package My::Test2;

use strict;
use ORLite {
	file   => '$file',
	create => sub {
		my \$dbh = shift;

		# Set up the test database
		\$dbh->do( 'create table foo ( bar int not null primary key )' );
		\$dbh->do( 'pragma user_version = 2' );
		\$dbh->do( 'insert into foo values ( 5 )' );
		\$dbh->do( 'insert into foo values ( ? )', {}, 7 );

		return 1;
	},
	user_version => 2,
};

1;
END_PERL

	# Transaction basics
	ok( My::Test2->can('connect'), 'Created read code'  );
	ok( My::Test2->can('begin'),   'Created write code' );

	# Test ability to get and set pragmas
	is( My::Test2->pragma('schema_version'), 1, 'schema_version is zero' );
	is( My::Test2->pragma('user_version'),   2, 'Confirm user_version changed' );

	# Check for the existance of the generated table and objects
	my @object = My::Test2::Foo->select;
	is( scalar(@object), 2, 'Found 2 Foo objects' );
	isa_ok( $object[0], 'My::Test2::Foo' );
	isa_ok( $object[1], 'My::Test2::Foo' );
	is( $object[0]->bar, 5, '->foo ok' );
	is( $object[1]->bar, 7, '->foo ok' );

	# Make sure it's a full readwrite interface
	my $create = My::Test2::Foo->create( bar => 3 );
	isa_ok( $create, 'My::Test2::Foo' );
	is( $create->bar, 3, '->bar ok' );
}





######################################################################
# Appending with tables

SCOPE: {
	# Set up the file
	my $file = test_db();
	my $dbh  = create_ok(
		file    => catfile(qw{ t 02_basics.sql }),
		connect => [ "dbi:SQLite:$file" ],
	);

	# Create the second test package (with tables)
	eval <<"END_PERL"; die $@ if $@;
package My::Test3;

use strict;
use ORLite {
	file   => '$file',
	create => 1,
	append => 'sub append { 2 }',
};

1;
END_PERL

	ok( My::Test3->can('connect'), 'Created read code'  );
	ok( My::Test3->can('begin'),   'Created write code' );
	ok( My::Test3::TableOne->can('select'), 'Created table code' );

	# When generating tables, we still append to the right place
	is( My::Test3->append, 2, 'append params works as expected' );
}