#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Pane; use Encode; my $topdir= shift || '.'; my @subdirs = get_sub_dirs($topdir); my $mw = tkinit(); $mw->geometry('400x400+100+100'); my $sp = $mw->Scrolled('Pane', -scrollbars=>'osoe', sticky=>'nwse') ->pack(-expand=>1, -fill=>'both' ); my @cbvalues; my @cbnames; my $count = 0; foreach my $d( @subdirs){ $cbnames[$count] = $d; $sp->Checkbutton(-text => $d, -font=>[arial => 12], -onvalue => 1, -offvalue => 0, -variable => \$cbvalues[$count], -font => 'big', -bg => 'white', )->pack(-anchor=>'w')->pack(); $count++; } my $showbutton= $mw->Button(-text=>'Show Selected', -bg => 'lightyellow', -command => sub{ my @selected = (); foreach my $c( 0.. $count ){ if ( $cbvalues[$c] ){ push @selected, $cbnames[$c]; } } print "@selected\n"; } )->pack(); MainLoop(); sub get_sub_dirs { my $dir = shift; opendir my $dh, $dir or die "Error: $!"; my @files = grep !/^\.\.?$/, readdir $dh; @files = map { decode( 'utf8', "$dir/".$_ ) } sort @files; closedir $dh; my @sdirs; for my $file ( @files ) { if(-d $file){push @sdirs,$file;} } return @sdirs; }