The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

our $compare;
our $rc;

our $loaded = 0;

BEGIN { $| = 1; print "1..11\n"; }
END {print "not ok 1\n" unless $loaded;}

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

sub disp_tree {
    my(%param) = @_;
	#print STDERR ($param{item} || 'N/A'), "\n";
    my $item = $param{item};
    $item =~ s/^\s+//;
    $item =~ s/\s+$//;
    $compare .= $item;
}

use DBI;

use DBIx::Tree;

use File::Spec;
use File::Temp;

$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

############# create and populate the table we need.

my($dir)  = File::Temp -> newdir;
my($file) = File::Spec -> catfile($dir, 'test.sqlite');
my(@opts) =
(
$ENV{DBI_DSN}  || "dbi:SQLite:dbname=$file",
$ENV{DBI_USER} || '',
$ENV{DBI_PASS} || '',
);

my $dbh = DBI->connect(@opts, {RaiseError => 0, PrintError => 1, AutoCommit => 1});
if ( defined $dbh ) {
        print "ok 2\n";
} else {
        print "not ok 2\n";
        die $DBI::errstr;
}

open (INSTALL, "t/INSTALL.SQL")
  or (print "not ok 2\n" and die "Could not open t/INSTALL.SQL for reading!");
while(<INSTALL>) {
        chomp;

	# strip out NULL for mSQL
	#
	if (/^create/i and $opts[0] =~ /msql/i) {
	    s/null//gi;
	}

        my $sth = $dbh->prepare($_);

		# Skip failure to drop non-existent table.

		next if (! defined $sth);

        my $rc = $sth->execute;

        # ignore drop table.
        #
        if (!$rc) {
          if (/^drop/i) {
            print STDERR "Ignoring failed DROP operation.\n"
          } else {
            print "not ok 2\n";
            die "$DBI::errstr";
          }
        }
}
close (INSTALL);

############# create an instance of the DBIx::Tree
{
my $tree = new DBIx::Tree( connection => $dbh,
			   table      => 'food',
			   method     => sub { disp_tree(@_) },
			   columns    => ['id', 'food', 'parent_id'],
			   start_id   => '001');
if(ref $tree eq 'DBIx::Tree') {
    print "ok 3\n";
} else {
    print "not ok 3\n";
}

############# call do_query
if ($tree->_do_query) {
    print "ok 4\n";
} else {
    print "not ok 4\n";
}

############# call tree

$tree->traverse;
$rc = $compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss';
if ($rc == 1) {
    print "ok 5\n";
} else {
    print "not ok 5\n";
}

}
############# create another instance of the DBIx::Tree
{
my $tree = new DBIx::Tree(connection => $dbh,
                          table      => 'food',
                          method     => sub { disp_tree(@_) },
                          columns    => ['id', 'food', 'parent_id'],
                          start_id   => '001',
                          match_data => 'Dairy');
$compare = "";
$tree->traverse;
$rc = $compare eq 'Dairy';

if ($rc == 1) {
    print "ok 6\n";
} else {
    print "not ok 6: $compare\n";
}

############# test local variables in traverse()

$compare = "";
$tree->traverse(start_id => '011', threshold => 2, match_data => '', limit => 2);
$rc = $compare eq 'Coffee MilkSkim Milk';

if ($rc == 1) {
    print "ok 7\n";
} else {
    print "not ok 7: $compare\n";
}

### OK, now see if the default settings still work:

$compare = "";
$tree->traverse;
$rc = $compare eq 'Dairy';

if ($rc == 1) {
    print "ok 8\n";
} else {
    print "not ok 8: $compare\n";
}
}

############# check out 'sth' constructor
{
my $sth = $dbh->prepare('select id, food, parent_id from food order by food');
my $tree = new DBIx::Tree(connection => $dbh,
                          sth        => $sth,
                          method     => sub { disp_tree(@_) },
                          columns    => ['id', 'food', 'parent_id'],
                          start_id   => '001');
$compare = "";
$tree->traverse;
$rc = $compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss';

if ($rc == 1) {
    print "ok 9\n";
} else {
    print "not ok 9: $compare\n";
}
}

############# check out 'sql' constructor
{
my $sql = 'select id, food, parent_id from food order by food';
my $tree = new DBIx::Tree(connection => $dbh,
                          sql        => $sql,
                          method     => sub { disp_tree(@_) },
                          columns    => ['id', 'food', 'parent_id'],
                          start_id   => '001');
$compare = "";
$tree->traverse;
$rc = $compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss';

if ($rc == 1) {
    print "ok 10\n";
} else {
    print "not ok 10: $compare\n";
}

############# check out the recursive function: repeat above tests

$compare = "";
$tree->traverse(recursive => 1);
$rc = $compare eq 'FoodBeans and NutsBeansBlack BeansKidney BeansBlack Kidney BeansRed Kidney BeansNutsPecansDairyBeveragesCoffee MilkSkim MilkWhole MilkCheesesCheddarGoudaMuensterStiltonSwiss';

if ($rc == 1) {
    print "ok 11\n";
} else {
    print "not ok 11: $compare\n";
}
}

############# close the dbh
$dbh->do(q{drop table food});
$dbh->disconnect;