Context Navigation

source: tests/webinject/webinjectgui.pl @ 0105685

gcc484ntopperl-5.22

Last change on this file since 0105685 was c5c522c, checked in by Edwin Eefting <edwin@datux.nl>, 8 years ago
initial commit, transferred from cleaned syn3 svn tree
Property mode set to `100755`
File size: 26.4 KB

Rev	Line
[c5c522c]	1	#!/usr/bin/perl -w
	2
	3	# Copyright 2004-2006 Corey Goldberg (corey@goldb.org)
	4	#
	5	# This file is part of WebInject.
	6	#
	7	# WebInject is free software; you can redistribute it and/or modify
	8	# it under the terms of the GNU General Public License as published by
	9	# the Free Software Foundation; either version 2 of the License, or
	10	# (at your option) any later version.
	11	#
	12	# WebInject is distributed in the hope that it will be useful,
	13	# but without any warranty; without even the implied warranty of
	14	# merchantability or fitness for a particular purpose. See the
	15	# GNU General Public License for more details.
	16
	17
	18	use Tk;
	19	use Tk::Stderr;
	20	use Tk::ROText;
	21	use Tk::Compound;
	22	use Tk::ProgressBar::Mac;
	23	use Tk::NoteBook;
	24	use Tk::PNG;
	25
	26	$\| = 1; #don't buffer output to STDOUT
	27
	28
	29	$mw = MainWindow->new(
	30	-title => 'WebInject - HTTP Test Tool (version 1.41)',
	31	-bg => '#666699',
	32	-takefocus => '1', #start on top
	33	);
	34
	35	$mw->geometry("750x650+0+0"); #size and screen placement
	36	$mw->InitStderr; #redirect all STDERR to a window
	37	$mw->raise; #put application in front at startup
	38	$mw->bind('<F5>' => \&engine); #F5 key makes it run
	39
	40
	41	if (-e "icon.gif") { #if icon graphic exists, use it
	42	$mw->update();
	43	$icon = $mw->Photo(-file => 'icon.gif');
	44	$mw->iconimage($icon);
	45	}
	46
	47
	48	if (-e "logo.gif") { #if logo graphic exists, use it
	49	$mw->Photo('logogif', -file => "logo.gif");
	50	$mw->Label(
	51	-image => 'logogif',
	52	-bg => '#666699',
	53	)->place(qw/-x 305 -y 12/); $mw->update();
	54	}
	55
	56
	57	$menubar = $mw->Frame(qw/-relief flat -borderwidth 2/);
	58	$menubar->place(qw/-x 0 -y 0/);
	59	$menubar->configure(-background => '#666699'); #menu outline
	60
	61	$filemenu = $menubar->Menubutton(
	62	-text => 'File',
	63	-foreground => 'white',
	64	-background => '#666699',
	65	-activebackground => '#666699',
	66	-activeforeground => 'black',
	67	-tearoff => '0',
	68	)->pack(qw/-side left/);
	69
	70
	71	$filemenu->command(
	72	-label => 'Restart',
	73	-background => '#666699',
	74	-activebackground => '#EFEFEF',
	75	-foreground => 'white',
	76	-activeforeground => 'black',
	77	-command => sub{gui_restart();}
	78	);
	79
	80
	81	$filemenu->command(
	82	-label => 'Exit',
	83	-background => '#666699',
	84	-activebackground => '#EFEFEF',
	85	-foreground => 'white',
	86	-activeforeground => 'black',
	87	-command => sub{exit;}
	88	);
	89
	90
	91	$viewmenu = $menubar->Menubutton(
	92	-text => 'View',
	93	-foreground => 'white',
	94	-background => '#666699',
	95	-activebackground => '#666699',
	96	-activeforeground => 'black',
	97	-tearoff => '0',
	98	)->pack(qw/-side left/);
	99
	100
	101	$viewmenu->command(
	102	-label => 'config.xml',
	103	-background => '#666699',
	104	-activebackground => '#EFEFEF',
	105	-foreground => 'white',
	106	-activeforeground => 'black',
	107	-command => sub{viewconfig();}
	108	);
	109
	110
	111	$aboutmenu = $menubar->Menubutton(
	112	-text => 'About',
	113	-foreground => 'white',
	114	-background => '#666699',
	115	-activebackground => '#666699',
	116	-activeforeground => 'black',
	117	-tearoff => '0',
	118	)->pack(qw/-side left/);
	119
	120
	121	$aboutmenu->command(
	122	-label => 'About WebInject',
	123	-background => '#666699',
	124	-activebackground => '#EFEFEF',
	125	-foreground => 'white',
	126	-activeforeground => 'black',
	127	-command => sub{about();}
	128	);
	129
	130
	131	$mw->Label(
	132	-text => 'Engine Status:',
	133	-bg => '#666699',
	134	-fg => '#FFFFFF',
	135	)->place(qw/-x 12 -y 100/); $mw->update();
	136
	137
	138	$out_window = $mw->Scrolled(ROText, #engine status window
	139	-scrollbars => 'e',
	140	-background => '#EFEFEF',
	141	-width => '103',
	142	-height => '7',
	143	)->place(qw/-x 12 -y 118/); $mw->update();
	144
	145
	146	$tabs = $mw->NoteBook(
	147	-backpagecolor => '#666699',
	148	-background => '#EFEFEF', #color for active tab
	149	-foreground => 'black', #text color for active tab
	150	-inactivebackground => '#BFBFBF', #color for inactive tabs
	151	)->place(qw/-x 12 -y 240/); #outer notebook object
	152
	153
	154	$status_tab = $tabs->add('statustab', -label => 'Status'); $mw->update();
	155
	156
	157	$statustab_canvas = $status_tab->Canvas(
	158	-width => '719',
	159	-height => '365',
	160	-highlightcolor => '#CCCCCC',
	161	-background => '#EFEFEF',
	162	)->pack(); $mw->update(); #canvas to fill tab (to place widgets into)
	163
	164
	165	$statustab_buttoncanvas = $statustab_canvas->Canvas(
	166	-width => '700',
	167	-height => '24',
	168	-background => '#666699',
	169	)->place(qw/-x 10 -y 334/); $mw->update(); #canvas to place buttons into
	170
	171
	172	$minimalcheckbx = 'minimal_off'; #give it a default value
	173	$statustab_buttoncanvas->Label(
	174	-text => 'Minimal Output',
	175	-bg => '#666699',
	176	-fg => 'white',
	177	)->place(qw/-x 49 -y 4/); $mw->update();
	178	$statustab_buttoncanvas->Checkbutton(
	179	-text => '', #using a text widget instead
	180	-onvalue => 'minimal_on',
	181	-offvalue => 'minimal_off',
	182	-variable => \$minimalcheckbx,
	183	-background => '#666699',
	184	-activebackground => '#666699',
	185	-highlightbackground => '#666699',
	186	)->place(qw/-x 20 -y 2/); $mw->update();
	187
	188
	189	$timercheckbx = 'timer_off'; #give it a default value
	190	$statustab_buttoncanvas->Label(
	191	-text => 'Response Timer Output',
	192	-bg => '#666699',
	193	-fg => 'white',
	194	)->place(qw/-x 199 -y 4/); $mw->update();
	195	$statustab_buttoncanvas->Checkbutton(
	196	-text => '', #using a text widget instead
	197	-onvalue => 'timer_on',
	198	-offvalue => 'timer_off',
	199	-variable => \$timercheckbx,
	200	-background => '#666699',
	201	-activebackground => '#666699',
	202	-highlightbackground => '#666699',
	203	)->place(qw/-x 170 -y 2/); $mw->update();
	204
	205
	206	$status_window = $statustab_canvas->Scrolled(ROText, #test case status monitor window
	207	-scrollbars => 'e',
	208	-background => '#EFEFEF',
	209	-width => '102',
	210	-height => '23',
	211	)->place(qw/-x 0 -y 0/); $mw->update();
	212	$status_window->tagConfigure('red', -foreground => '#FF3333'); #define tag for font color
	213	$status_window->tagConfigure('green', -foreground => '#009900'); #define tag for font color
	214
	215
	216	$monitorenabledchkbx = 'monitor_on'; #give it a default value
	217	$mw->Label(
	218	-text => 'Disable Monitor',
	219	-bg => '#666699',
	220	-fg => 'white',
	221	)->place(qw/-x 189 -y 242/); $mw->update();
	222	$monitor_enabledchkbx = $mw->Checkbutton(
	223	-text => '', #using a text widget instead
	224	-onvalue => 'monitor_off',
	225	-offvalue => 'monitor_on',
	226	-variable => \$monitorenabledchkbx,
	227	-background => '#666699',
	228	-activebackground => '#666699',
	229	-highlightbackground => '#666699',
	230	-command => sub{monitor_enable_disable();},
	231	)->place(qw/-x 160 -y 240/); $mw->update();
	232	monitor_enable_disable(); #call sub to enable and create monitor
	233
	234
	235	$stop_button = $mw->Button->Compound;
	236	$stop_button->Text(-text => "Stop");
	237	$stop_button = $mw->Button(
	238	-width => '50',
	239	-height => '13',
	240	-background => '#EFEFEF',
	241	-activebackground => '#666699',
	242	-foreground => '#000000',
	243	-activeforeground => '#FFFFFF',
	244	-borderwidth => '3',
	245	-image => $stop_button,
	246	-command => sub{$stop = 'yes';}
	247	)->place; $mw->update(); #create this button but don't place it yet
	248
	249
	250	$rtc_button = $mw->Button->Compound;
	251	$rtc_button->Text(-text => "Run");
	252	$rtc_button = $mw->Button(
	253	-width => '50',
	254	-height => '13',
	255	-background => '#EFEFEF',
	256	-activebackground => '#666699',
	257	-foreground => '#000000',
	258	-activeforeground => '#FFFFFF',
	259	-borderwidth => '3',
	260	-image => $rtc_button,
	261	-command => sub{engine();}
	262	)->place(qw/-x 110 -y 65/); $mw->update();
	263	$rtc_button->focus();
	264
	265
	266	$progressbar = $mw->ProgressBar(
	267	-width => '420',
	268	-bg => '#666699'
	269	)->place(qw/-x 176 -y 65/); $mw->update();
	270
	271
	272	$status_ind = $mw->Canvas(
	273	-width => '28', #engine status indicator
	274	-height => '9',
	275	-background => '#666699',
	276	)->place(qw/-x 621 -y 69/); $mw->update();
	277
	278
	279	#load the Engine
	280	if (-e "./webinject.pl") {
	281	do "./webinject.pl"
	282	}
	283	#test if the Engine was loaded
	284	unless (defined &engine){
	285	print STDERR "Error: I can not load the test engine (webinject.pl)!\n\n";
	286	print STDERR "Check to make sure webinject.pl exists.\n";
	287	print STDERR "If it is not missing, you are most likely missing some Perl modules it requires.\n";
	288	print STDERR "Try running the engine by itself and see what modules it complains about.\n\n";
	289	}
	290
	291
	292
	293
	294	MainLoop;
	295
	296
	297
	298
	299	#------------------------------------------------------------------
	300	sub gui_initial { #this runs when engine is first loaded
	301
	302	#vars set in test engine
	303	$currentcasefile = '';
	304	$latency = '';
	305	$casecount = '';
	306	$case{description1} = '';
	307	$totalruncount = '';
	308	$runcount = '';
	309	$failedcount = '';
	310	$passedcount = '';
	311	$casefailedcount = '';
	312	$casepassedcount = '';
	313	$totalruntime = '';
	314	$stop = 'no';
	315	$plotclear = 'no';
	316
	317
	318	$out_window->delete('0.0','end'); #clear window before starting
	319
	320	$status_window->delete('0.0','end'); #clear window before starting
	321
	322	$status_ind->configure(-background => '#FF9900'); #change status color amber while running
	323
	324	$rtc_button->placeForget; #remove the run button
	325	$stop_button->place(qw/-x 110 -y 65/); #place the stop button
	326
	327	$monitor_enabledchkbx->configure(-state => 'disabled'); #disable button while running
	328
	329	$out_window->insert("end", "Starting Webinject Engine... \n\n");
	330	$out_window->see("end");
	331	}
	332	#------------------------------------------------------------------
	333	sub gui_restart { #kill the entire app and restart it
	334	if ($0 =~ /webinjectgui.pl/) {
	335	exec 'perl ./webinjectgui.pl';
	336	}
	337	if ($0 =~ /webinjectgui.exe/) {
	338	exec './webinjectgui.exe';
	339	}
	340	}
	341	#------------------------------------------------------------------
	342	sub gui_processing_msg {
	343	$out_window->insert("end", "processing test case file:\n$currentcasefile\n\n", 'bold');
	344	$out_window->see("end");
	345	}
	346	#------------------------------------------------------------------
	347	sub gui_statusbar {
	348	$percentcomplete = ($runcount/$casecount)*100;
	349	$progressbar->set($percentcomplete); #update progressbar with current status
	350	}
	351	#------------------------------------------------------------------
	352	sub gui_tc_descript {
	353	unless ($minimalcheckbx eq "minimal_on") {
	354	unless ($case{description1} =~ /dummy test case/) {
	355	$status_window->insert("end", "- $case{description1}\n");
	356	$status_window->see("end");
	357	}
	358	}
	359	}
	360	#------------------------------------------------------------------
	361	sub gui_status_passed {
	362	$status_window->insert("end", "PASSED\n", 'green');
	363	$status_window->see("end");
	364	}
	365	#------------------------------------------------------------------
	366	sub gui_status_failed {
	367	if ($1 and $2) {
	368	$status_window->insert("end", "FAILED ($1$2)\n", 'red');
	369	$status_window->see("end");
	370	}
	371	else {
	372	$status_window->insert("end", "FAILED\n", 'red');
	373	$status_window->see("end");
	374	}
	375	}
	376	#------------------------------------------------------------------
	377	sub gui_timer_output {
	378	if ($timercheckbx eq "timer_on") {
	379	$status_window->insert("end", "$latency s\n");
	380	$status_window->see("end");
	381	}
	382	}
	383	#------------------------------------------------------------------
	384	sub gui_final {
	385
	386	$out_window->insert("end", "Execution Finished... see results.html file for detailed output report");
	387	$out_window->see("end");
	388
	389	$status_window->insert("end", "\n\n------------------------------\nTotal Run Time: $totalruntime seconds\n");
	390	$status_window->insert("end", "\nTest Cases Run: $totalruncount\nTest Cases Passed: $casepassedcount\nTest Cases Failed: $casefailedcount\nVerifications Passed: $passedcount\nVerifications Failed: $failedcount\n");
	391	$status_window->see("end");
	392
	393	if ($failedcount > 0) { #change status color to reflect failure or all tests passed
	394	$status_ind->configure(-background => '#FF3333'); #red
	395	}
	396	else {
	397	$status_ind->configure(-background => '#009900'); #green
	398	}
	399
	400
	401	$monitor_enabledchkbx->configure(-state => 'normal'); #re-enable button after finish
	402	}
	403	#------------------------------------------------------------------
	404	sub gui_updatemontab {
	405
	406	if ($monitorenabledchkbx ne 'monitor_off') { #don't try to update if monitor is disabled in gui
	407
	408	if ((-e "plot.png") and (($graphtype ne 'nograph') or ($plotclear ne 'yes'))) { #if plot graphic exists, put it in canvas
	409
	410	$montab_plotcanvas->Photo('plotgraph', -file => "plot.png");
	411	$montab_plotcanvas->Label(-image => 'plotgraph')->place(qw/-x 7 -y 0/);
	412	}
	413	}
	414	}
	415	#------------------------------------------------------------------
	416	sub gui_updatemonstats { #update timers and counts in monitor tab
	417
	418	if ($monitorenabledchkbx ne 'monitor_off') { #don't try to update if monitor is disabled in gui
	419
	420	$mintime_text->configure(-text => "Min: $minresponse sec");
	421	$maxtime_text->configure(-text => "Max: $maxresponse sec");
	422	$avgtime_text->configure(-text => "Avg: $avgresponse sec");
	423	$runcounttotal_text->configure(-text => "Total: $totalruncount");
	424	$runcountcasespassed_text->configure(-text => "Passed: $casepassedcount");
	425	$runcountcasespfailed_text->configure(-text => "Failed: $casefailedcount");
	426	}
	427	}
	428	#------------------------------------------------------------------
	429	sub gui_stop { #flip button and do cleanup when user clicks Stop
	430
	431	$stop_button->placeForget; #remove the stop botton
	432	$rtc_button->place(qw/-x 110 -y 65/); #place the stop button
	433
	434	$progressbar->set(-1); #update progressbar back to zero
	435
	436	$mw->update();
	437
	438	gui_final();
	439	}
	440	#------------------------------------------------------------------
	441	sub gui_cleargraph { #remove graph
	442
	443	if (-e "plot.png") { unlink "plot.png"; } #delete a plot file if it exists so an old one is never rendered
	444
	445	$montab_plotcanvas->destroy; #destroy the canvas
	446
	447	$montab_plotcanvas = $montab_canvas->Canvas(
	448	-width => '718',
	449	-height => '240',
	450	-background => '#EFEFEF',
	451	)->place(qw/-x 0 -y 0/); $mw->update(); #canvas to place graph into
	452	}
	453	#------------------------------------------------------------------
	454	sub gui_cleargraph_button { #remove graph then set value to truncate log
	455
	456	gui_cleargraph();
	457
	458	$plotclear = 'yes'; #set value so engine knows to truncate plot log
	459	}
	460	#------------------------------------------------------------------
	461	sub about {
	462
	463	$about = MainWindow->new(
	464	-title => 'About WebInject',
	465	-bg => '#666699',
	466	-takefocus => '1', #start on top
	467	);
	468	$about->raise; #put in front
	469	$about->geometry("320x200+200+200"); #size and screen placement
	470	if (-e "icon.gif") { #if icon graphic exists, use it
	471	$about->update();
	472	$icon = $about->Photo(-file => 'icon.gif');
	473	$about->iconimage($icon);
	474	}
	475
	476
	477	$about_text = $about->ROText(
	478	-width => '100', #make these big. window size is controlled by geometry instead
	479	-height => '100',
	480	-background => '#666699',
	481	-foreground => 'white',
	482	)->pack;
	483
	484	$about_text->insert("end", qq\|
	485	WebInject
	486	©2004-2006 Corey Goldberg
	487
	488	Please visit www.webinject.org
	489	for information and documentation.
	490
	491	WebInject is Free and Open Source.
	492	Licensed under the terms of the GNU GPL.
	493	\|);
	494
	495	}
	496	#------------------------------------------------------------------
	497	sub viewconfig {
	498
	499	$viewconfig = MainWindow->new(
	500	-title => 'config.xml',
	501	-bg => '#666699',
	502	-takefocus => '1', #start on top
	503	);
	504	$viewconfig->raise; #put in front
	505	$viewconfig->geometry("500x400+200+200"); #size and screen placement
	506	if (-e "logo.gif") { #if icon graphic exists, use it
	507	$viewconfig->update();
	508	$icon = $viewconfig->Photo(-file => 'icon.gif');
	509	$viewconfig->iconimage($icon);
	510	}
	511
	512
	513	$config_text = $viewconfig->ROText(
	514	-width => '100', #make these big. window size is controlled by geometry instead
	515	-height => '100',
	516	-background => '#666699',
	517	-foreground => 'white',
	518	)->pack;
	519
	520
	521	open(CONFIG, "config.xml") or die "\nERROR: Failed to open config.xml file\n\n"; #open file handle
	522	@configfile = <CONFIG>; #read the file into an array
	523
	524	$config_text->insert("end", @configfile);
	525
	526	close(CONFIG);
	527	}
	528	#------------------------------------------------------------------
	529	sub monitor_enable_disable {
	530
	531	if ($monitorenabledchkbx eq 'monitor_on') { #create the monitor tab and all it's widgets
	532
	533	$mon_tab = $tabs->add('montab', -label => 'Monitor'); $mw->update(); #add the notebook tab
	534
	535
	536	$montab_canvas = $mon_tab->Canvas(
	537	-width => '719',
	538	-height => '365',
	539	-background => '#EFEFEF',
	540	)->place(qw/-x 0 -y 0/); $mw->update(); #canvas to fill tab (to place widgets into)
	541
	542
	543	$montab_plotcanvas = $montab_canvas->Canvas(
	544	-width => '718',
	545	-height => '240',
	546	-background => '#EFEFEF',
	547	)->place(qw/-x 0 -y 0/); $mw->update(); #canvas to place graph into
	548
	549
	550	$clear_graph = $mon_tab->Button->Compound;
	551	$clear_graph->Text(-text => "Clear Graph");
	552	$clear_graph = $mon_tab->Button(
	553	-width => '70',
	554	-height => '13',
	555	-background => '#EFEFEF',
	556	-activebackground => '#666699',
	557	-foreground => '#000000',
	558	-activeforeground => '#FFFFFF',
	559	-borderwidth => '3',
	560	-image => $clear_graph,
	561	-command => sub{gui_cleargraph_button();}
	562	)->place(qw/-x 630 -y 310/); $mw->update();
	563
	564
	565	$montab_buttoncanvas = $montab_canvas->Canvas(
	566	-width => '700',
	567	-height => '26',
	568	-background => '#666699',
	569	)->place(qw/-x 10 -y 334/); $mw->update(); #canvas to place buttons into
	570
	571
	572	$montab_buttoncanvas->Label(
	573	-text => 'Line Graph',
	574	-bg => '#666699',
	575	-fg => 'white',
	576	)->place(qw/-x 49 -y 4/); $mw->update();
	577	$radiolinegraph = $montab_buttoncanvas->Radiobutton(
	578	-value => 'lines',
	579	-variable => \$graphtype,
	580	-indicatoron => 'true',
	581	-background => '#666699',
	582	-activebackground => '#666699',
	583	-highlightbackground => '#666699',
	584	)->place(qw/-x 20 -y 2/); $mw->update();
	585
	586
	587	$radiolinegraph->select; #select as default
	588
	589
	590	$montab_buttoncanvas->Label(
	591	-text => 'Impulse Graph',
	592	-bg => '#666699',
	593	-fg => 'white',
	594	)->place(qw/-x 199 -y 4/); $mw->update();
	595	$montab_buttoncanvas->Radiobutton(
	596	-value => 'impulses',
	597	-variable => \$graphtype,
	598	-background => '#666699',
	599	-activebackground => '#666699',
	600	-highlightbackground => '#666699',
	601	)->place(qw/-x 170 -y 2/); $mw->update();
	602
	603
	604	$montab_buttoncanvas->Label(
	605	-text => 'No Graph',
	606	-bg => '#666699',
	607	-fg => 'white',
	608	)->place(qw/-x 349 -y 4/); $mw->update();
	609	$montab_buttoncanvas->Radiobutton(
	610	-value => 'nograph',
	611	-variable => \$graphtype,
	612	-background => '#666699',
	613	-activebackground => '#666699',
	614	-highlightbackground => '#666699',
	615	-command => sub{gui_cleargraph();} #remove graph from view
	616	)->place(qw/-x 320 -y 2/); $mw->update();
	617
	618
	619	$resptime_label = $montab_canvas->Label(
	620	-width => '25',
	621	-height => '1',
	622	-background => '#EFEFEF',
	623	-foreground => 'black',
	624	-relief => 'flat',
	625	-anchor => 'w',
	626	)->place(qw/-x 12 -y 245/); $mw->update();
	627	$resptime_label->configure(-text => 'Response Times:');
	628
	629
	630	$minresponse = 'N/A'; #set initial value for timer display
	631	$mintime_text = $montab_canvas->Label(
	632	-width => '25',
	633	-height => '1',
	634	-background => '#EFEFEF',
	635	-foreground => 'black',
	636	-relief => 'flat',
	637	-anchor => 'w',
	638	)->place(qw/-x 32 -y 265/); $mw->update();
	639	$mintime_text->configure(-text => "Min: $minresponse sec");
	640
	641
	642	$maxresponse = 'N/A'; #set initial value for timer display
	643	$maxtime_text = $montab_canvas->Label(
	644	-width => '25',
	645	-height => '1',
	646	-background => '#EFEFEF',
	647	-foreground => 'black',
	648	-relief => 'flat',
	649	-anchor => 'w',
	650	)->place(qw/-x 32 -y 285/); $mw->update();
	651	$maxtime_text->configure(-text => "Max: $maxresponse sec");
	652
	653
	654	$avgresponse = 'N/A'; #set initial value for timer display
	655	$avgtime_text = $montab_canvas->Label(
	656	-width => '25',
	657	-height => '1',
	658	-background => '#EFEFEF',
	659	-foreground => 'black',
	660	-relief => 'flat',
	661	-anchor => 'w',
	662	)->place(qw/-x 32 -y 305/); $mw->update();
	663	$avgtime_text->configure(-text => "Avg: $avgresponse sec");
	664
	665
	666	$runcount_label = $montab_canvas->Label(
	667	-width => '25',
	668	-height => '1',
	669	-background => '#EFEFEF',
	670	-foreground => 'black',
	671	-relief => 'flat',
	672	-anchor => 'w',
	673	)->place(qw/-x 250 -y 245/); $mw->update();
	674	$runcount_label->configure(-text => 'Runtime Counts:');
	675
	676
	677	$totalruncount = 'N/A'; #set initial value for count display
	678	$runcounttotal_text = $montab_canvas->Label(
	679	-width => '25',
	680	-height => '1',
	681	-background => '#EFEFEF',
	682	-foreground => 'black',
	683	-relief => 'flat',
	684	-anchor => 'w',
	685	)->place(qw/-x 270 -y 265/); $mw->update();
	686	$runcounttotal_text->configure(-text => "Total: $totalruncount");
	687
	688
	689	$casepassedcount = 'N/A'; #set initial value for count display
	690	$runcountcasespassed_text = $montab_canvas->Label(
	691	-width => '25',
	692	-height => '1',
	693	-background => '#EFEFEF',
	694	-foreground => 'black',
	695	-relief => 'flat',
	696	-anchor => 'w',
	697	)->place(qw/-x 270 -y 285/); $mw->update();
	698	$runcountcasespassed_text->configure(-text => "Passed: $casepassedcount");
	699
	700
	701	$casefailedcount = 'N/A'; #set initial value for count display
	702	$runcountcasespfailed_text = $montab_canvas->Label(
	703	-width => '25',
	704	-height => '1',
	705	-background => '#EFEFEF',
	706	-foreground => 'black',
	707	-relief => 'flat',
	708	-anchor => 'w',
	709	)->place(qw/-x 270 -y 305/); $mw->update();
	710	$runcountcasespfailed_text->configure(-text => "Failed: $casefailedcount");
	711
	712
	713	} #end monitor create
	714
	715
	716
	717	if ($monitorenabledchkbx eq 'monitor_off') { #delete the tab when disabled
	718	$mon_tab = $tabs->delete('montab', -label => 'Monitor'); $mw->update();
	719	}
	720
	721	}
	722	#------------------------------------------------------------------
	723	sub gui_no_plotter_found { #if gnuplot not specified, notify on gui
	724
	725	$montab_plotcanvas->Label(
	726	-text => "Sorry, I can't display the graph.\nMake sure you have gnuplot on your system and it's location is specified in config.xml. ",
	727	-bg => '#EFEFEF',
	728	-fg => 'black',
	729	)->place(qw/-x 95 -y 100/); $mw->update();
	730	}
	731
	732	#------------------------------------------------------------------

Note: See TracBrowser for help on using the repository browser.

Download in other formats: