The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#
# Perl/Tk version of Tix4.1.0/demos/samples/DirTree.tcl
#
# Chris Dean <ctdean@cogit.com>

use lib "..";

use strict;
use Tk;
use Tk::DirTree;
use Cwd;

my $top = new MainWindow( -title => "DirTree" );
main( $top );
MainLoop();

sub main {
    my( $top ) = @_;

    my $current_dir = getcwd;

    my $tree = $top->Scrolled( qw/DirTree
                               -width 35 -height 30
                               -selectmode browse -exportselection 1
                               -scrollbars osoe/ );

    my $lab = $top->Label( -text => "Installation Directory:" );
    my $ent = $top->Entry( -textvariable => \$current_dir );

    my $ok = $top->Button( qw/-text Ok -underline 0 -width 6/ );
    my $cancel = $top->Button( qw/-text Cancel -underline 0 -width 6/ );

    $tree->configure(   -browsecmd => sub { $current_dir = shift } );
    $tree->configure(   -command   => sub { do_it( $current_dir ) } );
    $ok->configure(     -command   => sub { do_it( $current_dir ) } );
    $cancel->configure( -command   => sub { exit } );

    $tree->pack(   qw/-expand yes -fill both -padx 10 -pady 10 -side top/ );
    $lab->pack(    qw/-anchor w/ );
    $ent->pack(    qw/-fill x/ );
    $ok->pack(     qw/-side left  -padx 10 -pady 10/ );
    $cancel->pack( qw/-side right -padx 10 -pady 10/ );
}

sub do_it {
    my( $dir ) = @_;
    print "Executing: $dir\n";
    exit;
}