use Tk;
use English;
use File::Basename;
use Cwd;
require Tk::FileSelect;
require Tk::Dialog;
require Tk::HList;
use diagnostics -verbose;
use Tk::Columns;

use Tk::DialogBox;
use Tk::NoteBook;
use Tk::ROText;    # and Read-only text box for output panes

#########################################################
##                                      MAIN WINDOW                   
+                           #
#########################################################
my $main = MainWindow->new();
$main->title('My TK_app ');
$main->geometry('800x600');



###  A notebook consisted of 3 pages  ########
my $notebook = $main->NoteBook(
    -dynamicgeometry => 'true',
    -ipadx           => 20,
    -ipady           => 6
   
);

$notebook->pack(
    -expand => "yes",
    -fill   => "both",
    -padx   => 3,
    -pady   => 3,
    -side   => "top"
);

# Divide the working area into
my $Config_p = $notebook->add( "config", -label => "Config", -underlin
+e => 0 );
my $Tc_p = $notebook->add( "Tc", -label => "Test cases", -underline =>
+ 0 );
my $Viewlog_p = $notebook->add( "Viewlog", -label => "Logs", -underlin
+e => 0 );

##        1ST TAB ##################
$input_text_area = $Config_p->Scrolled(
    'Text',
    -wrap       => "none",
    -scrollbars => "se",
    -width      => 40,
    -height     => 25,
    -background => 'WhiteSmoke'
);

$input_text_area->pack( -side => "top", -expand => 1, -fill => 'both' 
+);
$input_text_area->focus();    # gets focus on startup

##        2ST TAB ##################

my $l_Window = $Tc_p->TableEdit( '-file' => 'test.dat', );

$l_Window->Item(
    'Entry',
    '-name'    => 'Date',
    '-default' => sub { localtime(); },
);

$l_Window->Item(
    'Entry',
    '-bg'     => 'white',
    '-relief' => 'sunken',
    '-name'   => 'Internet Address',

    '-expression' => [
        '^[0-9]{1,3}?$',
        '^[0-9]{1,3}?\.$',
        '^[0-9]{1,3}?\.[0-9]{1,3}?$',
        '^[0-9]{1,3}?\.[0-9]{1,3}?\.$',
        '^[0-9]{1,3}?\.[0-9]{1,3}?\.[0-9]{1,3}?$',
        '^[0-9]{1,3}?\.[0-9]{1,3}?\.[0-9]{1,3}?\.$',
        '^[0-9]{1,3}?\.[0-9]{1,3}?\.[0-9]{1,3}?\.[0-9]{1,3}?$',
    ],
);

$l_Window->pack( '-expand' => 'true', '-fill' => 'both' );
$l_Window->GeometryRequest( 400, 200 );

##################        3RD TAB ##################
$inputfr = $Viewlog_p->Frame(
    -relief      => 'groove',
    -label       => 'Test cases panel',
    -borderwidth => 3,

  )->pack(
    -side   => 'top',
    -anchor => 'nw',
    -fill   => 'both',
  );
$incol1fr = $inputfr->Frame(
    -borderwidth => 2,

  )->pack(
    -side   => 'left',
    -anchor => 'nw',
    -fill   => 'both',
  );
$incol2fr = $inputfr->Frame(
    -borderwidth => 2,

  )->pack(
    -side   => 'left',
    -anchor => 'nw',
    -fill   => 'both',
  );
$incol3fr = $inputfr->Frame(
    -borderwidth => 2,

  )->pack(
    -side   => 'left',
    -anchor => 'nw',
    -fill   => 'both',
  );

# Annotation File #
$incol1fr->Label( -text => 'Please select your testcase file (*.pl)', 
+)->pack(
    -side   => 'top',
    -anchor => 'ne',
    -pady   => 3,
);

$testfile_e = $incol2fr->Entry(
    -text          =>'No file selected',
    -state        => 'normal',
    -textvariable => \$testfile_e,
    -width        => 60,
  )->pack(
    -side   => 'top',
    -anchor => 'nw',
    -pady   => 3,
  );

$incol3fr->Button(
    -text        => 'Browse',
    -command     => [ \&selectsinglefile, \$testfile_e, \$main ],
    -borderwidth => 1,
    -padx        => 0,
    -pady        => 0,
  )->pack(
    -side   => 'top',
    -anchor => 'nw',
  );



########     Insert Delete buttons ##############
my $but_frame = $Viewlog_p->Frame();
$but_frame->pack(
    -side   => 'bottom',
    -anchor => "sw",
    -expand => 0,
    -fill   => 'x',
    -padx   => 0
);

$but_frame->Button(
    -text        => 'Insert',
    -command     => [ \&add_lines ],
    -borderwidth => 1,
    -padx        => 0,
    -pady        => 0,
  )->pack(
    -side   => 'left',
    -anchor => 'nw',
  );

$but_frame->Button(
    -text        => 'Delete all',
    -command     => [ \&del_lines ],
    -borderwidth => 2,
    -padx        => 0,
    -pady        => 0,
  )->pack(
    -side   => 'left',
    -anchor => 'nw',
  );


######################      Columns *****************#################
+##

my $Columns = $Viewlog_p->Columns

  (
    '-columnlabels'     => [qw (No File Date Status Action log )],
    '-width'            => '20',
    '-height'           => '60',
    '-sortcommand'      => '$a cmp $b',
    '-listforeground'   => 'blue4',
    '-listbackground'   => 'beige',
    '-buttonbackground' => 'gray',
    '-buttonforeground' => 'black',
    '-selectmode'       => 'extended',
    '-trimcount' => '2',
    '-sort'             => 'true',
  );

$Columns->pack(
    '-anchor' => 'sw',
    '-expand' => 'false',
    '-side'   => 'top',
    '-fill'   => 'both',

);

MainLoop;

sub selectsinglefile {
    my $entryblankref = shift;
    my $entryblank    = $$entryblankref;
    my $mwref         = shift;
    my $mw            = $$mwref;

    my $filetypes = [ [ 'Perl test cases ', ['.pl'] ], [ 'All files', 
+['*'] ] ];
    my $file = $mw->getOpenFile(
        -title            => "Please choose a configuration file",
        -filetypes        => $filetypes,
        -defaultextension => ".pl"
    );

    if ( defined $file and $file ne '' ) {
        $entryblank->delete( 0, 'end' );
        $entryblank->insert( 0, $file );
        $entryblank->xview('end');
    }
}

sub add_lines {
$time=localtime();
($base,$path,$type) = fileparse($testfile_e); 
   $Columns->insert( '0', 1, $base,  $time,  'Running', 'Start', 'Not 
+ready' );


}

sub del_lines {
    $Columns->delete( 0, 'end' );
}
[download]