#!/usr/bin/perl -w

use strict;

use Tk;
use Tk::Tree;
use Tk::Label;
use DBIx::Tree;

use vars qw(@list);   # the list of items in the tree.

# Open the file containing the connection string, user id, and password.
#
my @dbiparms;
open (PWD, "../PWD") 
  or die "Could not open PWD for reading!";
while(<PWD>) {
    chomp;
    push @dbiparms, $_;
}
close (PWD);

# Connect to the datasource.
#
use DBI;
my $dbh = DBI->connect(@dbiparms);
if ( !defined $dbh ) {
    die $DBI::errstr;
}

# Create a new instance of the DBIx::Tree object.
#
my $dbtree = new DBIx::Tree( connection => $dbh, 
                            table      => 'food', 
                            method     => sub { disp_tree(@_) },
                            columns    => ['food_id', 'food', 'parent_id'],
                            start_id   => '001');

# Execute the query, and form the tree.
#
$dbtree->traverse;

# Create a new main window.
#
my $top = new MainWindow( -title  => "Tree" );

# Create a scrolled Tree widget.  Behind the scenes, we're forming
# each of the tree elements as a directory style listing. For example,
# Skim Milk is represented as "Dairy/Beverages/Skim Milk".  As long
# as we add the elements in the order in which they appear in the 
# tree, the tree will be able to figure out which element is the
# parent of each node we add.
#
my $tree = $top->Scrolled( 'Tree',
                           -separator       => '/',
                           -exportselection => 1,
                           -scrollbars      => 'osoe',
                           -height => 20,
                           -width  => -1);
# Pack the tree.
#
$tree->pack( -expand => 'yes',
             -fill   => 'both',
             -padx   => 10,
             -pady   => 10,
             -side   => 'top' );

# When we ran $dbtree->tree earlier, the @list array was populated.
# It doesn't have a top element, so we need to pre-pend one to the 
# list ('/' below).
#
foreach ( '/', @list ) {

    # We don't want the user to see "Dairy/Beverages/Skim Milk",
    # so we'll strip off all but the last words for the label.
    #
    my $text = (split( /\//, $_ ))[-1]; 

    # If we're on /, let's make its label blank.
    #
    if ($_ eq '/') {
        $text = "";
    }

    # Add the item (in $_) with $text as the label.
    #
    $tree->add( $_, -text => $text );
    
}

$tree->autosetmode();

my $ok = $top->Button( -text      => 'Ok',
                       -underline => 0,
                       -width     => 6,
                       -command   => sub { $dbh->disconnect; exit } );

my $cancel = $top->Button( -text      => 'Cancel',
                           -underline => 0,
                           -width     => 6,
                           -command   => sub { $dbh->disconnect; exit } );

$ok->pack( -side => 'left', -padx => 10,  -pady => 10 );
$cancel->pack( -side => 'right', -padx => 10, -pady => 10 );

MainLoop();
$dbh->disconnect;

# This is the callback for the $dbtree->tree method. Each time
# A node is added, this method is called.
#
sub disp_tree {

    my %parms = @_;
    my $item = $parms{item};
    my @parent_name = @{ $parms{parent_name} };

    my $treeval = "/";
    foreach (@parent_name) {
        s/^\s+//;
        s/\s+$//;
        $treeval .= "$_/";
    }
    $item =~ s/^\s+//;
    $item =~ s/\s+$//;
    $treeval .= $item;
    push @list, $treeval;
}