1use strict;
2use warnings;
3
4# Before `make install' is performed this script should be runnable with
5# `make test'. After `make install' it should work as `perl test.pl'
6
7######################### We start with some black magic to print on failure.
8
9# Change 1..1 below to 1..last_test_to_print .
10# (It may become useful if the test is moved to ./t subdirectory.)
11
12use DBI;
13
14use DBIx::Tree;
15
16use File::Spec;
17use File::Temp;
18
19use Test::More;
20
21our $compare;
22our $rc;
23
24our $loaded = 0;
25
26# ------------------------------------------------
27
28sub display_tree
29{
30	my(%param) = @_;
31	my $item = $param{item};
32	$item =~ s/^\s+//;
33	$item =~ s/\s+$//;
34
35	$compare .= $item;
36
37} # End of display_tree.
38
39# ------------------------------------------------
40
41$loaded = 1;
42
43ok($loaded == 1, 'Module loaded');
44
45############# create and populate the table we need.
46
47my($dir)  = File::Temp -> newdir;
48my($file) = File::Spec -> catfile($dir, 'test.sqlite');
49my(@opts) =
50(
51$ENV{DBI_DSN}  || "dbi:SQLite:dbname=$file",
52$ENV{DBI_USER} || '',
53$ENV{DBI_PASS} || '',
54);
55
56my $dbh = DBI->connect(@opts, {RaiseError => 0, PrintError => 1, AutoCommit => 1});
57
58ok(defined $dbh, "Connected to $opts[0]");
59
60diag 'You may get a warning here: DBD::SQLite::db prepare failed: no such table: food. Just ignore it';
61
62my($error) = open(my $fh, '<', 't/INSTALL.SQL');
63
64ok($error, 'Opened t/INSTALL.SQL for reading!');
65
66while(<$fh>)
67{
68	chomp;
69
70	# strip out NULL for mSQL
71
72	if (/^create/i and $opts[0] =~ /msql/i) {
73	    s/null//gi;
74	}
75
76	my $sth = $dbh->prepare($_);
77
78	# Skip failure to drop non-existent table.
79
80	next if (! defined $sth);
81
82	my $rc = $sth->execute;
83
84	# ignore drop table.
85
86	if (!$rc)
87	{
88		if (/^drop/i)
89		{
90			diag 'Ignoring failed DROP operation';
91		}
92		else
93		{
94			diag "Failed drop statement: $DBI::errstr";
95		}
96	}
97}
98
99close ($fh);
100
101############# create an instance of the DBIx::Tree
102{
103	# Test traverse().
104
105	my $tree = DBIx::Tree -> new
106		(
107			connection => $dbh,
108			table      => 'food',
109			method     => sub { display_tree(@_) },
110			columns    => ['id', 'food', 'parent_id'],
111			start_id   => '001',
112		);
113
114	ok(ref $tree eq 'DBIx::Tree', 'Create object to read table');
115
116	ok($tree -> _do_query, 'Executed query');
117
118	$tree->traverse;
119
120	ok($compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss', 'Called traverse()');
121}
122
123
124{
125	# Test match_data.
126
127	my $tree = DBIx::Tree -> new
128		(
129			connection => $dbh,
130			table      => 'food',
131			method     => sub { display_tree(@_) },
132			columns    => ['id', 'food', 'parent_id'],
133			start_id   => '001',
134			match_data => 'Dairy',
135		);
136
137	$compare = '';
138
139	$tree->traverse;
140
141	ok($compare eq 'Dairy', 'Another traverse()');
142
143	# Test traverse().
144
145	$compare = '';
146
147	$tree->traverse(start_id => '011', threshold => 2, match_data => '', limit => 2);
148
149	ok($compare eq 'Coffee MilkSkim Milk', 'Test local variables in traverse()');
150
151	$compare = '';
152
153	$tree->traverse;
154
155	ok($compare eq 'Dairy', 'Test default values in traverse()');
156}
157
158{
159	# Test 'sth' in new().
160
161	my $sth = $dbh->prepare('select id, food, parent_id from food order by food');
162	my $tree = DBIx::Tree -> new
163		(
164			connection => $dbh,
165			sth        => $sth,
166			method     => sub { display_tree(@_) },
167			columns    => ['id', 'food', 'parent_id'],
168			start_id   => '001',
169		);
170
171	$compare = '';
172
173	$tree->traverse;
174
175	ok($compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss', 'sth in new()');
176}
177
178{
179	# Test 'sql' in new().
180
181	my $sql = 'select id, food, parent_id from food order by food';
182	my $tree = DBIx::Tree -> new
183		(
184			connection => $dbh,
185			sql        => $sql,
186			method     => sub { display_tree(@_) },
187			columns    => ['id', 'food', 'parent_id'],
188			start_id   => '001',
189		);
190
191	$compare = '';
192
193	$tree->traverse;
194
195	ok($compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss', 'sql in new()');
196
197	# Test recursive option to traverse().
198
199	$compare = '';
200
201	$tree->traverse(recursive => 1);
202
203	ok($compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss', 'recursive option to traverse()');
204}
205
206$dbh->do(q{drop table food});
207$dbh->disconnect;
208
209done_testing;
210