Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Re: Advanced GUI with threads

by glenn (Scribe)
on Nov 13, 2013 at 19:55 UTC ( [id://1062444]=note: print w/replies, xml ) Need Help??


in reply to Advanced GUI with threads -working

Ok got it working, here it is full bore:
use File::Basename; use Cwd; use XML::Simple; use Data::Dumper; use Sys::Hostname; use Tk; use Tk::DialogBox; use Tk::ColorEditor; use Tk::BrowseEntry; use Tk::LabEntry; use Tk::Pane; use threads; use threads::shared; use Thread::Semaphore; use Thread::Queue; use strict; use warnings; $^W++; # Turn on warnings my $running : shared = 1; my $xs = new XML::Simple(keeproot=>1, forcearray=>1); my $SYSTEMJOB = $xs->XMLin("<systemlist></systemlist>"); my $sourcepath = dirname(Cwd::abs_path(__FILE__)); #Where am I located + at? unless ($sourcepath =~ m/\\$/) { $sourcepath .= "\\"; } my $reportpath = $sourcepath."Report\\"; my $ver = "6.0"; my @config_options = ("none"); my $CLI = "pathtocommand"; #make sure report folder exists unless (-d $reportpath) { mkdir $reportpath or die "failed to create report directory [$repo +rtpath]\n"; } #retrive license options my $hardware_details_file = "hardware_details.xml"; my $hardwarexml; open( FILE, "< $hardware_details_file" ); while ( my $line = <FILE> ) { $hardwarexml .= $line; } close( FILE ); #build license options hash my %hw_lic_options; my $hardware = $xs->XMLin($hardwarexml); foreach my $product (@{$hardware->{hardwarelist}->[0]->{product}}) { my $mb_dmi = $product->{motherboard}->[0]; push (@{$hw_lic_options{$mb_dmi}}, "none"); foreach my $global (@{$hardware->{hardwarelist}->[0]->{license}->[ +0]->{option}}) { push (@{$hw_lic_options{$mb_dmi}}, $global->{name}->[0]); } foreach my $config (@{$product->{config}}) { my $cfg_name = $config->{name}->[0]; foreach my $lic (@{$config->{license}->[0]->{option}}) { push (@{$hw_lic_options{$mb_dmi}}, $lic->{name}->[0]); } } } #create threads #queues my $discovered = Thread::Queue->new(); #new discovered systems my $addsys = Thread::Queue->new(); #systems to be added to the GUI my $test_start = Thread::Queue->new(); #tests to be executed my $test_done = Thread::Queue->new(); #return data from test threads my $rmsys = Thread::Queue->new(); #systems marked to be removed once t +hey are no longer discovered #semaphores my $writelog = Thread::Semaphore->new(); #sequencal log writing my $datavalidationlimit = 31; #reduce by 1, easy to add 1 to limit bel +ow. Data validation tests require 2 locks while less intensive worker +s only require 1 allowing systems to proceed while blocking intensive + processes my $preformance = Thread::Semaphore->new($datavalidationlimit+1); #IO +meter lock, limits datavalidation but allows IO meter to run without +interferance. my $iometerpreference = Thread::Semaphore->new(); #Allow IO Meter to b +lock grabbing locks from other processes #workers threads->create("discovery", "192.168.0", "172.16", "10.0")->detach(); + #find new systems, push them to formsystemlist threads->create("formsystemlist")->detach(); #dequeue Discovery threads->create("executejob")->detach(); #dequeue test_start #user interface testControl(); MainLoop(); $running = 0; exit 0; #THREADS sub executejob { #$SIG{__DIE__} = sub{ tcrash(threads->tid()); }; while ($running) { #START AND DETACH TEST while ($test_start->pending() > 0) { my $system = $test_start->dequeue(); if ($system->{state}->[0] eq "running") { #this blocks fin +ished tests if ($system->{job}->[0]->{status}->[0] eq "ready") { $system->{job}->[0]->{status}->[0] = "running"; $system->{job}->[0]->{nextjob}->[0] =~ m/(\d+):(\d ++)/; my $test = $1; my $iteration = $2; my $testname = $system->{job}->[0]->{step}->[$test +]; threads->create(\&{$testname}, $system)->detach(); + #test } else { logLine("Test received but job not ready."); logLine(Dumper $system); } } } } } sub formsystemlist { #$SIG{__DIE__} = sub{ tcrash(threads->tid()); }; while (my $ip = $discovered->dequeue() and $running) { my $passwd = "password"; my $license = "none"; my $tag = ""; my $config = "unknown"; my $raidtype = "unknown"; my $serial = "unknown"; my $servicekey = "unknown"; my $hardware = "unknown"; my $cap = 0; #sum of drives capacity my $e = 0; #jbod count my $can = "unknown"; #SBB left or right my $mbInfo = "unknown"; my $software = "unknown"; my $itxvar = "unknown"; #oldest value. Updated by actual syste +m my $peerip = "unknown"; #create XML structure my $sys = "<system>\n"; if ($mbInfo =~ m/X8DTS/) { $sys .= "<alias>0</alias>\n"; $sys .= "<peer>\n"; $sys .= "<ip>$peerip</ip>\n"; $sys .= "<ip>0</ip>\n"; $sys .= "<alias>0</alias>\n"; $sys .= "<volume></volume>\n"; $sys .= "</peer>\n"; } $sys .= "<ip>$ip</ip>\n"; $sys .= "<ip>0</ip>\n"; $sys .= "<hardware>$hardware</hardware>\n"; $sys .= "<volume></volume>\n"; $sys .= "<status>proceed</status>\n"; $sys .= "<state>stopped</state>\n"; $sys .= "<reportpath>$reportpath</reportpath>\n"; $sys .= "<health>unknown</health>\n"; $sys .= "<events>unknown</events>\n"; $sys .= "<serial>". int(rand(99999999999999)+100000000000000) +."</serial>\n"; $sys .= "<servicekey>". int(rand(99999999999999999999999999)) +."</servicekey>\n"; $sys .= "<createtime>".time."</createtime>\n"; #not needed? $sys .= "<filename>unknown</filename>\n"; $sys .= "<reasonforfailure>unknown</reasonforfailure>\n"; $sys .= "<password>$passwd</password>\n"; $sys .= "<license>\n"; $sys .= "<option>$license</option>\n"; $sys .= "<result>unknown</result>\n"; $sys .= "<tag>$tag</tag>\n"; $sys .= "<capacity>$cap</capacity>\n"; $sys .= "<jbods>$e</jbods>\n"; $sys .= "<ITXVAR>$itxvar</ITXVAR>\n"; $sys .= "</license>\n"; $sys .= "<raidtype>$raidtype</raidtype>\n"; $sys .= "<customerConfig>$config</customerConfig>\n"; $sys .= "<customerConfig>unknown</customerConfig>\n"; $sys .= "<job>\n"; $sys .= "<step>configure</step>\n"; $sys .= "<step>beyonddit</step>\n"; $sys .= "<step>iometer</step>\n"; $sys .= "<step>finalReportAnalysis</step>\n"; $sys .= "<step>SetLicense</step>\n"; $sys .= "<step>ConfigureForCustomer</step>\n"; $sys .= "<step>EmailResults</step>\n"; $sys .= "<nextjob>0:0</nextjob>\n"; $sys .= "<status>ready</status>\n"; $sys .= "<datavalidationiterations>24</datavalidationiteration +s>\n"; $sys .= "<datavalidationruntime>3600</datavalidationruntime>\n +"; $sys .= "</job>\n"; $sys .= "<gui>\n"; $sys .= "<progress>Not Running</progress>\n"; $sys .= "</gui>\n"; $sys .= "</system>"; $addsys->enqueue($sys); } } sub discovery { #$SIG{__DIE__} = sub{ tcrash(threads->tid()); }; my @notest = @_; my @myaddress; my $interval = 5; #seconds my $pingtimeout = 50; #milliseconds my $skip = 0; my $ip = ""; my $mask = ""; foreach my $line (qx"ipconfig /all") { chomp($line); #log IP if ($line =~ m/ip address.+: (\d+\.\d+\.\d+\.\d+)/i) { $ip = $1; } elsif ($line =~ m/IPv4 address.+: (\d+\.\d+\.\d+\.\d+)/i) { $ip = $1; } #log mask if ($line =~ m/Subnet Mask.+: (\d+\.\d+\.\d+\.\d+)/i) { $mask = $1; } #push ip and mask if ($ip ne "" and $mask ne "") { push(@myaddress, "$ip,$mask"); $ip = ""; $mask = ""; } } #remove ips to interfaces which need to be excluded for (my $n = 0; $n < @myaddress; $n++) { my ($lip, $lmask) = split(",",$myaddress[$n]); foreach my $addr (@notest) { if ($lip =~ m/$addr/) { #printLog("Will not check for clients on interface $li +p"); splice(@myaddress, $n, 1); $n--; last; } } } #find systems on each accepted interface while ($running) { my $client = int(rand(255)).".".int(rand(255)).".".int(rand(25 +5)).".".int(rand(255)); $discovered->enqueue($client); sleep $interval; } } #GUI sub testControl { my %colors = ( title_bar => '#243e8a', title_txt => '#ffffff', header_bar => '#6e88d5', header_txt => '#000000', sys_even_bg => '#aeaeae', sys_even_txt => '#000000', sys_even_but_txt => '#ffffff', sys_even_but_bg => '#777777', sys_odd_bg => '#cecece', sys_odd_txt => '#000000', sys_odd_but_txt => '#ffffff', sys_odd_but_bg => '#999999', ); my $mainwindow = MainWindow->new(); $mainwindow->geometry( "1300x600" ); $mainwindow->title("DIAG Test Control"); $mainwindow->configure(-background=>$colors{title_bar}); $mainwindow->protocol('WM_DELETE_WINDOW',sub{$mainwindow->messageB +ox(-message=>"Window cannot be closed this way.", -title=>"Disabled") +;return;}); $mainwindow->Label(-text=>"DIAG Test Control [ver: $ver]", -backgr +ound=>$colors{title_bar}, -foreground=>$colors{title_txt}, -font=>['c +ourier', '14', 'bold'])->pack(-side => 'top'); my $lic_grid = $mainwindow->Scrolled('Pane', -background=>$colors{ +header_bar}, -foreground=>$colors{header_txt}, -scrollbars=>'osoe', - +padx=>'10', -sticky => 'n')->pack(-side => 'top', -expand=>1, -fill=> +"both"); my $size = 10; $lic_grid->Label(-text=>"IP Address", -background=>$colors{header_ +bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->gri +d(-row=>1, -column=>0, -sticky=>"nsew"); $lic_grid->Label(-text=>"Serial Number", -background=>$colors{head +er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])-> +grid(-row=>1, -column=>1, -sticky=>"nsew"); $lic_grid->Label(-text=>"License", -background=>$colors{header_bar +}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(- +row=>1, -column=>2, -sticky=>"nsew"); $lic_grid->Label(-text=>"Configuration", -background=>$colors{head +er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])-> +grid(-row=>1, -column=>3, -sticky=>"nsew"); $lic_grid->Label(-text=>"Blink", -background=>$colors{header_bar}, + -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(-ro +w=>1, -column=>4, -sticky=>"nsew"); $lic_grid->Label(-text=>"Data Validation\nIterations", -background +=>$colors{header_bar}, -foreground=>$colors{header_txt}, -font=>[-siz +e => $size])->grid(-row=>1, -column=>5, -columnspan=>3, -sticky=>"nse +w"); $lic_grid->Label(-text=>"Data Validation Run Time", -background=>$ +colors{header_bar}, -foreground=>$colors{header_txt}, -font=>[-size = +> $size])->grid(-row=>1, -column=>8, -columnspan=>9, -sticky=>"nsew") +; $lic_grid->Label(-text=>"Test Time", -background=>$colors{header_b +ar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid +(-row=>1, -column=>17, -sticky=>"nsew"); $lic_grid->Label(-text=>"System\nStatus", -background=>$colors{hea +der_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])- +>grid(-row=>1, -column=>18, -sticky=>"nsew"); $lic_grid->Label(-text=>"System\nState", -background=>$colors{head +er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])-> +grid(-row=>1, -column=>19, -sticky=>"nsew"); $lic_grid->Label(-text=>"Controls", -background=>$colors{header_ba +r}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid( +-row=>1, -column=>20, -columnspan=>2, -sticky=>"nsew"); $lic_grid->Label(-text=>"Progress", -background=>$colors{header_ba +r}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid( +-row=>1, -column=>22, -sticky=>"nsew"); my $loop_collect = $mainwindow->repeat(1000, sub { #PROCESS COMPLETED TEST RESULTS while ($test_done->pending() > 0) { #print "Getting results of test. Have [".$test_done->pendi +ng()."] to process.\n"; my $results = $test_done->dequeue(); for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[ +0]->{system}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}-> +[$count]; if ($system->{servicekey}->[0] eq $results->{serviceke +y}->[0]) { #receive results if ($results->{status}->[0] !~ m/fail/i) { #stop/pause if ($system->{state}->[0] eq "stopping") { #ch +eck from GUI updated global $results->{state}->[0] = "stop"; $results->{job}->[0]->{nextjob}->[0] = "0: +0"; $results->{status}->[0] = "proceed"; $results->{gui}->[0]->{progress}->[0] = "s +topped"; } elsif ($system->{state}->[0] eq "pausing") { + #check from GUI updated global $results->{state}->[0] = "pause"; } elsif ($system->{state}->[0] eq "quitting") +{ #check from quit updated global if ($results->{status}->[0] ne "failure") +{ $results->{status}->[0] = "failure"; $results->{reasonforfailure}->[0] = "m +anual termenation"; $results->{job}->[0]->{nextjob}->[0] = + @{$results->{job}->[0]->{step}}.":0"; } } #set next test my ($test, $iteration) = split(":", $results-> +{job}->[0]->{nextjob}->[0]); if (defined $results->{job}->[0]->{step}->[$te +st]) { if ($results->{job}->[0]->{step}->[$test] +eq "domatrixnano" or $results->{job}->[0]->{step}->[$test] eq "beyond +dit") { $iteration++; if ($iteration > $results->{job}->[0]- +>{datavalidationiterations}->[0]) { $test++; $iteration=0; } } else { $test++; $iteration=0; } } if ($test >= @{$results->{job}->[0]->{step}}) +{ #print "DONE\n"; if ($system->{state}->[0] eq "quitting") { $results->{state}->[0] = "terminated"; $results->{job}->[0]->{status}->[0] = +"terminated"; } else { $results->{state}->[0] = "complete"; $results->{job}->[0]->{status}->[0] = +"ready"; $results->{job}->[0]->{nextjob}->[0] = + "0:0"; } $results->{gui}->[0]->{progress}->[0] = "F +inished"; } else { #print "NEXT\n"; $results->{job}->[0]->{nextjob}->[0] = "$t +est:$iteration"; $results->{job}->[0]->{status}->[0] = "rea +dy"; $results->{job}->[0]->{nextjob}->[0] =~ m/ +(\d+):(\d+)/; $results->{gui}->[0]->{progress}->[0] = $r +esults->{job}->[0]->{step}->[$1]." on iteration [$2]"; } } else { print "set complete from fail\n"; $results->{job}->[0]->{state}->[0] = "complete +"; } leaf_copy($results, $system); $test_start->enqueue($system); #let the thread dec +ided if it needs to run or not. last; } } } }); my $loop_addsys = $mainwindow->repeat(1000, sub{ ADD: while ($addsys->pending() > 0) { if (defined $SYSTEMJOB->{systemlist}->[0]->{system}) { if (@{$SYSTEMJOB->{systemlist}->[0]->{system}} > 25) { + #Reserve some DATA IPs for DIAG controller $addsys->dequeue(); $mainwindow->update(); } } #ADD NEW SYSTEM TO GUI my @test_cfg_options; my $newsys = $xs->XMLin($addsys->dequeue()); #does this system already exist? foreach my $sys (@{$SYSTEMJOB->{systemlist}->[0]->{system} +}) { #if ($sys->{ip}->[0] eq $newsys->{system}->[0]->{ip}-> +[0] or $sys->{servicekey}->[0] eq $newsys->{system}->[0]->{servicekey +}->[0]) { if ($sys->{ip}->[0] eq $newsys->{system}->[0]->{ip}->[ +0]) { $mainwindow->update(); next ADD; } } push(@{$SYSTEMJOB->{systemlist}->[0]->{system}}, $newsys-> +{system}->[0]); my $systemid = @{$SYSTEMJOB->{systemlist}->[0]->{system}} +- 1; my $row_offset = 2; my $row = $systemid + $row_offset; my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$sy +stemid]; $system->{ip}->[1] = find_free_ip(); if (defined $system->{peer}->[0]) { $system->{alias}->[0] = find_free_ip(); $system->{peer}->[0]->{ip}->[1] = find_free_ip(); $system->{peer}->[0]->{alias}->[0] = find_free_ip(); } my $nicetime = convert_time($system->{job}->[0]->{datavali +dationiterations}->[0] * $system->{job}->[0]->{datavalidationruntime} +->[0]); my $bgcolor=$colors{sys_odd_bg}; my $txtcolor=$colors{sys_odd_txt}; my $buttxtcolor=$colors{sys_odd_but_txt}; my $butbgcolor=$colors{sys_odd_but_bg}; if ($row % 2 == 0) { $bgcolor=$colors{sys_even_bg}; $txtcolor=$colors{sys_even_txt}; $buttxtcolor=$colors{sys_even_but_txt}; $butbgcolor=$colors{sys_even_but_bg}; } $lic_grid->Label(-text=>$system->{ip}->[0], -background=>$ +bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -column=>0, -stick +y=>"nsew"); push(@test_cfg_options, $lic_grid->Entry(-textvariable=>\$ +system->{serial}->[0], -background=>"white", -foreground=>$txtcolor, +-width=>16, -highlightthickness=>2, -highlightcolor=>'blue')->grid(-r +ow=>$row, -column=>1, -sticky=>"nsew")); $lic_grid->Button(-state=>"disabled", -text=>"Set License" +, -background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=> +4, -command=>[\&LicenseOptions, $system->{license}->[0]])->grid(-row= +>$row, -column=>2, -sticky=>"nsew"); $lic_grid->Optionmenu(-state=>"disabled", -variable=>\$sys +tem->{customerConfig}->[0], -background=>$butbgcolor, -foreground=>$b +uttxtcolor, -relief=>'raised', -borderwidth=>4, -options=>\@config_op +tions)->grid(-row=>$row, -column=>3, -sticky=>"nsew"); my $but_blink = $lic_grid->Button(-text=>"Blink Unit", -ba +ckground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4)->g +rid(-row=>$row, -column=>4, -sticky=>"nsew"); if ($system->{raidtype}->[0] =~ m/none/i) { $but_blink->configure(-state => 'disabled'); } $lic_grid->Label(-textvariable=>\$system->{job}->[0]->{dat +avalidationiterations}->[0], -background=>$bgcolor, -foreground=>$txt +color, -width => 3)->grid(-row=>$row, -column=>5, -sticky=>"nsew"); push(@test_cfg_options, $lic_grid->Button(-text => "+", -b +ackground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, - +command => sub{$system->{job}->[0]->{datavalidationiterations}->[0]++ +;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati +ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr +id(-row=>$row, -column=>6, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "-", -b +ackground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, - +command => sub{$system->{job}->[0]->{datavalidationiterations}->[0]-- +;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati +ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr +id(-row=>$row, -column=>7, -sticky=>"nsew")); $lic_grid->Label(-textvariable=>\$system->{job}->[0]->{dat +avalidationruntime}->[0], -background=>$bgcolor, -foreground=>$txtcol +or, -width=>8)->grid(-row=>$row, -column=>8, -sticky=>"nsew"); push(@test_cfg_options, $lic_grid->Button(-text => "+1D", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=8 +6400;$nicetime = convert_time($system->{job}->[0]->{datavalidationite +rations}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);}) +->grid(-row=>$row, -column=>9, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "-1D", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=8 +6400;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$sys +tem->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = conve +rt_time($system->{job}->[0]->{datavalidationiterations}->[0] * $syste +m->{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -co +lumn=>10, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "+1H", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=3 +600;$nicetime = convert_time($system->{job}->[0]->{datavalidationiter +ations}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})- +>grid(-row=>$row, -column=>11, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "-1H", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=3 +600;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$syst +em->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = conver +t_time($system->{job}->[0]->{datavalidationiterations}->[0] * $system +->{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -col +umn=>12, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "+5M", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=3 +00;$nicetime = convert_time($system->{job}->[0]->{datavalidationitera +tions}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})-> +grid(-row=>$row, -column=>13, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "-5M", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=3 +00;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$syste +m->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = convert +_time($system->{job}->[0]->{datavalidationiterations}->[0] * $system- +>{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -colu +mn=>14, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "+5S", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=5 +;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati +ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr +id(-row=>$row, -column=>15, -sticky=>"nsew")); push(@test_cfg_options, $lic_grid->Button(-text => "-5S", +-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, + -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=5 +;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$system- +>{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = convert_t +ime($system->{job}->[0]->{datavalidationiterations}->[0] * $system->{ +job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -column +=>16, -sticky=>"nsew")); $lic_grid->Label(-textvariable=>\$nicetime ,-background=>$ +bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -column=>17, -stic +ky=>"nsew"); $lic_grid->Label(-textvariable=>\$system->{status}->[0], - +background=>$bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -colu +mn=>18, -sticky=>"nsew"); $lic_grid->Label(-textvariable=>\$system->{state}->[0], -b +ackground=>$bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -colum +n=>19, -sticky=>"nsew"); my $but_ctl_1 = $lic_grid->Button(-text=>"Start", -backgro +und=>$bgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -foregroun +d=>"black", -background=>"green", -activeforeground=>"green", -active +background=>"black")->grid(-row=>$row, -column=>20, -sticky=>"nsew"); my $but_ctl_2 = $lic_grid->Button(-text=>"Remove", -backgr +ound=>$bgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -foregrou +nd=>"black", -background=>"orange", -activeforeground=>"orange", -act +ivebackground=>"black")->grid(-row=>$row, -column=>21, -sticky=>"nsew +"); $lic_grid->Label(-textvariable=>\$system->{gui}->[0]->{pro +gress}->[0], -background=>$bgcolor, -foreground=>$txtcolor, -width => + 40)->grid(-row=>$row, -column=>22, -sticky=>"nsew"); $but_ctl_1->configure(-command=>[sub{ my $system = $_[0]; my $state = $$system->{state}->[0]; if ($state eq "stopped" or $state eq "completed") { #start my @buttoncolor=("red","yellow"); #check test options my $valid = 1; if ($$system->{job}->[0]->{datavalidationiteration +s}->[0] * $$system->{job}->[0]->{datavalidationruntime}->[0] == 0) { $valid = 0; $mainwindow->messageBox(-type=>"Ok", -title=>" +Test Configuration ERROR", -message=>"Please check your data validati +on paramaters and ensure test length is above zero", -icon=>"error"); } if ($$system->{license}->[0]->{option}->[0] ne "no +ne" and $$system->{license}->[0]->{option}->[0] ne "walgreens" and $$ +system->{license}->[0]->{option}->[0] ne "lenovo") { if ($$system->{license}->[0]->{tag}->[0] eq "" +) { $valid = 0; $mainwindow->messageBox(-type=>"Ok", -titl +e=>"License Configuration ERROR", -message=>"License option not set t +o vaild config. Option [".$$system->{license}->[0]->{option}->[0]."] +with tag [".$$system->{license}->[0]->{tag}->[0]."]", -icon=>"error") +; } } if (length($$system->{serial}->[0]) ne 15) { $valid = 0; $mainwindow->messageBox(-type=>"Ok", -title=>" +Serial Number ERROR", -message=>"Serial number must be 15 charaters", + -icon=>"error"); } if ($valid == 1) { $$system->{state}->[0]="running"; foreach my $button (@test_cfg_options) { $button->configure(-state=>"disabled"); } $but_ctl_1->configure(-text=>"Stop", -foregrou +nd=>"black", -background=>$buttoncolor[0], -activeforeground=>$button +color[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"normal", -text= +>"Pause", -foreground=>"black", -background=>$buttoncolor[1], -active +foreground=>$buttoncolor[1], -activebackground=>"black"); $$system->{job}->[0]->{nextjob}->[0] =~ m/(\d+ +):(\d+)/; $$system->{gui}->[0]->{progress}->[0] = $$syst +em->{job}->[0]->{step}->[$1]." on iteration [$2]"; $test_start->enqueue($$system); } } elsif ($state eq "paused") { #stop my @buttoncolor=("green","yellow"); $$system->{state}->[0]="stopped"; $$system->{job}->[0]->{nextjob}->[0] = "0:0"; $$system->{status}->[0] = "proceed"; $$system->{gui}->[0]->{progress}->[0] = "stopped"; foreach my $button (@test_cfg_options) { $button->configure(-state=>"normal"); } $but_ctl_1->configure(-state=>"normal", -text=>"St +art", -foreground=>"black", -background=>$buttoncolor[0], -activefore +ground=>$buttoncolor[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"disabled", -text=>" +Pause",-foreground=>"black", -background=>$buttoncolor[1], -activefor +eground=>$buttoncolor[1], -activebackground=>"black"); } elsif ($state eq "running" or $state eq "pausing") { #stop $mainwindow->messageBox(-message=>"Please wait for + the system to fully stop before making changes to the test paramater +s.", -title=>"Please Wait"); my @buttoncolor=("green","yellow"); $$system->{state}->[0]="stopping"; $but_ctl_1->configure(-state=>"disabled", -text=>" +Start", -foreground=>"black", -background=>$buttoncolor[0], -activefo +reground=>$buttoncolor[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"disabled", -text=>" +Pause",-foreground=>"black", -background=>$buttoncolor[1], -activefor +eground=>$buttoncolor[1], -activebackground=>"black"); } },(\$system)]); $but_ctl_2->configure(-command=>[sub{ my $system = $_[0]; my $row_offset = $_[1]; my $state = $$system->{state}->[0]; if ($state eq "running") { #pause my @buttoncolor=("red","green"); $$system->{state}->[0]="pausing"; $but_ctl_1->configure(-text=>"Stop", -foreground=> +"black", -background=>$buttoncolor[0], -activeforeground=>$buttoncolo +r[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"disabled", -text=>" +Resume", -foreground=>"black", -background=>$buttoncolor[1], -activef +oreground=>$buttoncolor[1], -activebackground=>"black"); } elsif ($state eq "paused") { #resume my @buttoncolor=("red","yellow"); $$system->{state}->[0]="running"; foreach my $button (@test_cfg_options) { $button->configure(-state=>"disabled"); } $but_ctl_1->configure(-text=>"Stop", -foreground=> +"black", -background=>$buttoncolor[0], -activeforeground=>$buttoncolo +r[0], -activebackground=>"black"); $but_ctl_2->configure(-text=>"Pause", -foreground= +>"black", -background=>$buttoncolor[1], -activeforeground=>$buttoncol +or[1], -activebackground=>"black"); $test_start->enqueue($$system); } elsif ($state eq "new" or $state eq "stopped" or $st +ate eq "completed") { #remove for (my $s = 0; $s < @{$SYSTEMJOB->{systemlist}->[ +0]->{system}}; $s++) { if ($$system->{servicekey}->[0] eq $SYSTEMJOB- +>{systemlist}->[0]->{system}->[$s]->{servicekey}->[0]) { splice($SYSTEMJOB->{systemlist}->[0]->{sys +tem}, $s, 1); my $row = $s+$row_offset; my @widgets = $lic_grid->Subwidget('pane') +->gridSlaves(-row=>$row); foreach my $widget (@widgets) { $widget->gridForget(); } my ($cols, $rows) = $lic_grid->Subwidget(' +pane')->gridSize; for ($row; $row < $rows; $row++) { my $nextrow = $row + 1; my @widgets = $lic_grid->Subwidget('pa +ne')->gridSlaves(-row=>$nextrow); foreach my $widget (@widgets) { $widget->grid(-row=>$row); my $bgcolor=$colors{sys_odd_bg}; my $txtcolor=$colors{sys_odd_txt}; my $buttxtcolor=$colors{sys_odd_bu +t_txt}; my $butbgcolor=$colors{sys_odd_but +_bg}; if ($row % 2 == 0) { $bgcolor=$colors{sys_even_bg}; $txtcolor=$colors{sys_even_txt +}; $buttxtcolor=$colors{sys_even_ +but_txt}; $butbgcolor=$colors{sys_even_b +ut_bg}; } #Button, Label, Optionmenu, Entry if ($widget->class() eq "Button" o +r $widget->class() eq "Optionmenu") { my @commandcolors = ("green", +"yellow", "red", "orange"); unless ($widget->cget('-backgr +ound') ~~ @commandcolors) { $widget->configure(-backgr +ound=>$butbgcolor, -foreground=>$buttxtcolor); } } elsif ($widget->class() eq "Entr +y") { $widget->configure(-background +=>"white", -foreground=>$txtcolor); } else { $widget->configure(-background +=>$bgcolor, -foreground=>$txtcolor); } } } } } } },(\$system, $row_offset)]); $mainwindow->repeat(3000, sub{ if ($system->{state}->[0] eq "complete") { #print "COMPLETE\n"; $system->{state}->[0] = "completed"; my @buttoncolor=("green","orange"); $system->{job}->[0]->{nextjob}->[0] = "0:0"; $system->{status}->[0] = "proceed"; foreach my $button (@test_cfg_options) { $button->configure(-state=>"normal"); } $but_ctl_1->configure(-state=>"normal", -text=>"St +art", -foreground=>"black", -background=>$buttoncolor[0], -activefore +ground=>$buttoncolor[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"normal", -text=>"Re +move",-foreground=>"black", -background=>$buttoncolor[1], -activefore +ground=>$buttoncolor[1], -activebackground=>"black"); } elsif ($system->{state}->[0] eq "stop") { #print "STOPPED\n"; $system->{state}->[0] = "stopped"; my @buttoncolor=("green","orange"); foreach my $button (@test_cfg_options) { $button->configure(-state=>"normal"); } $but_ctl_1->configure(-state=>"normal", -text=>"St +art", -foreground=>"black", -background=>$buttoncolor[0], -activefore +ground=>$buttoncolor[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"normal", -text=>"Re +move",-foreground=>"black", -background=>$buttoncolor[1], -activefore +ground=>$buttoncolor[1], -activebackground=>"black"); $system->{gui}->[0]->{progress}->[0] = "Not Runnin +g"; } elsif ($system->{state}->[0] eq "pause") { #print "PAUSED\n"; $system->{state}->[0] = "paused"; my @buttoncolor=("red","green"); foreach my $button (@test_cfg_options) { $button->configure(-state=>"normal"); } $but_ctl_1->configure(-state=>"normal", -text=>"St +op", -foreground=>"black", -background=>$buttoncolor[0], -activeforeg +round=>$buttoncolor[0], -activebackground=>"black"); $but_ctl_2->configure(-state=>"normal", -text=>"Re +sume",-foreground=>"black", -background=>$buttoncolor[1], -activefore +ground=>$buttoncolor[1], -activebackground=>"black"); } }); }#end while }); my $exitb = $mainwindow->Button(-text=>"Finished", -background=>"l +ight grey", -foreground=>"black", -borderwidth=>4, -font=>[-weight => + "bold"])->pack(-side => 'top', -pady=>4); $exitb->configure(-command=>[sub{ if ($mainwindow->messageBox(-default=>"No", -type=>"YesNo", -t +itle=>"Confirm quit", -message=>"Please confirm manually terminating +all tests and quiting DIAG", -icon=>"warning") eq "Yes") { $_[0]->configure(-state=>"disabled"); quit($mainwindow); } }, $exitb]); $mainwindow->state('zoomed'); } #SUBS sub convert_time ($) { my $time = $_[0]; my $days = int($time / 86400); $time -= ($days * 86400); my $hours = int($time / 3600); $time -= ($hours * 3600); my $minutes = int($time / 60); $time -= ($hours * 60); my $seconds = $time % 60; $days = $days .'d'; $hours = $hours .'h'; $minutes = $minutes . 'm'; return "$days $hours $minutes ${seconds}s"; } sub find_free_ip () { for (my $ip = 2; $ip < 255; $ip++) { #0.1 is controller my $used = 0; for (my $s = 0; $s < @{$SYSTEMJOB->{systemlist}->[0]->{system} +}; $s++) { my $addr = $SYSTEMJOB->{systemlist}->[0]->{system}->[$s]-> +{ip}->[1]; my $alias = -1; if (defined $SYSTEMJOB->{systemlist}->[0]->{system}->[$s]- +>{alias}) { $alias = $SYSTEMJOB->{systemlist}->[0]->{system}->[$s] +->{alias}->[0]; } if ($addr =~ m/\d{1,3}\.\d{1,3}\.\d{1,3}\.(\d{1,3})/) { $addr = $1; } if ($alias =~ m/\d{1,3}\.\d{1,3}\.\d{1,3}\.(\d{1,3})/) { $alias = $1; } if ($ip == $addr or $ip == $alias) { $used = 1; last; } } if ($used == 0) { return "192.168.0.".$ip; } } return "OUT"; } sub leaf_copy ($$) { if (ref $_[0] eq 'HASH') { $_[1]||={}; for my $key (keys %{$_[0]}){ if (ref $_[0]->{$key}) { leaf_copy($_[0]->{$key}, $_[1]->{$key}); } else { $_[1]->{$key} = $_[0]->{$key}; } } } elsif (ref $_[0] eq 'ARRAY') { $_[1]||=[]; for my $i (0..$#{$_[0]}){ if (ref $_[0]->[$i]) { leaf_copy($_[0]->[$i], $_[1]->[$i]); } else { $_[1]->[$i] = $_[0]->[$i]; } } } } sub tcrash { debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]); my $tid = $_[0]; my $thr = threads->object($tid); my $error; if ($thr-error()) { $error = " due to error ". $thr->error(); } print "Thread ". (caller(1))[3] ." died at ". (caller(0))[2] ."$er +ror\n"; $running = 0; } sub quit($) { debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]); $running = 0; my $systemcount = @{$SYSTEMJOB->{systemlist}->[0]->{system}}; my $allfin = 0; while ($allfin == 0) { $allfin = 1; for (my $i = 0; $i < $systemcount; $i++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$i] +; if ($system->{state}->[0] ne "stopped" and $system->{state +}->[0] ne "terminated" and $system->{state}->[0] ne "complete") { $allfin = 0; if ($system->{state}->[0] ne "quiting") { $system->{state}->[0] = "quiting"; } } if ($system->{state}->[0] eq "terminated") { $system->{state}->[0] = "stopped"; cleanupconfig($system); #can only run one test } } $_[0]->update(); if ($allfin == 1) { sleep 5; } } $_[0]->destroy; #mainwindow } sub debugLogFunctionNameLineNum { #Print sub header and caller info #debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]); my ($callerline, $caller) = @_; unless ($caller) { $caller = "MAIN"; } if ($caller =~ m/eval/) { $caller = "Tk call"; $callerline = "Unknown"; } my $LineNumber = (caller(0))[2]; my $FunctionName = (caller(1))[3]; my $time = localtime time; unless ($FunctionName) { $FunctionName = "MAIN"; } print "$FunctionName, $LineNumber: Called from [$caller] at [$call +erline].\n"; } sub logLine { my ($text) =@_; chomp($text); my ($package, $filename, $line) = caller; my $FunctionName = (caller(1))[3]; my $time = localtime time; $writelog->down(); my $header = "$filename, $FunctionName, $line, $time"; print "$header: $text\n"; #only for testing #open (LOG, ">>log.txt"); #print LOG "$header: $text\n"; #close (LOG); $writelog->up(); } sub printLog { my ($text) =@_; chomp($text); my ($package, $filename, $line) = caller; my $FunctionName = (caller(1))[3]; my $time = localtime time; $writelog->down(); my $header = "$filename, $FunctionName, $line, $time"; print "$header: $text\n"; #open (LOG, ">>log.txt"); #print LOG "$header: $text\n"; #close (LOG); $writelog->up(); } #TESTS sub configure { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = int(rand(10))+1; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(); logLine("[$subroutine] [".$system->{ip}->[0]."]"); sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(); $test_done->enqueue($system); } sub domatrixnano { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = int(rand(10))+1; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(2); logLine("[$subroutine] [".$system->{ip}->[0]."]"); sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(2); $test_done->enqueue($system); } sub beyonddit { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = int(rand(3))+1; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(2); logLine("[$subroutine] [".$system->{ip}->[0]."]"); sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(2); $test_done->enqueue($system); } sub iometer { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = 20; $iometerpreference->down(); #only IOmeter holds this lock down whi +le waiting to get limitation lock $preformance->down($datavalidationlimit); #stop all other IO $iometerpreference->up(); #IO meter with no other IO. logLine("[$subroutine] [".$system->{ip}->[0]."]"); sleep $testtime; print "[$subroutine] complete\n"; $preformance->up($datavalidationlimit); $test_done->enqueue($system); } sub finalReportAnalysis { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = 20; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(); print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n"; sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(); $test_done->enqueue($system); } sub SetLicense { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = 40; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(); print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n"; sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(); $test_done->enqueue($system); } sub ConfigureForCustomer { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = 40; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(); print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n"; sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(); $test_done->enqueue($system); } sub EmailResults { my $subroutine = (caller(0))[3]; my $system = $_[0]; my $testtime = 40; $iometerpreference->down(); $iometerpreference->up(); $preformance->down(); print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n"; sleep $testtime; print "[$subroutine] complete\n"; $preformance->up(); $test_done->enqueue($system); }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1062444]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (2)
As of 2024-03-19 10:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found