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