fiji_ee_gui.pl 31 KB
Newer Older
1
2
#!/usr/bin/env perl

Christian Fibich's avatar
Christian Fibich committed
3
4
5
6
7
8
9
10
11
12
13
14
#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  Description:
#
15
#  FIJI Execution Engine GUI
Christian Fibich's avatar
Christian Fibich committed
16
17
18
#
#-------------------------------------------------------------------------------

Christian Fibich's avatar
Christian Fibich committed
19
## @file
20
# @brief FIJI Execution Engine (GUI)
Christian Fibich's avatar
Christian Fibich committed
21
## @file
22
# A TK GUI application to execute predefined, manually entered, and random tests
Christian Fibich's avatar
Christian Fibich committed
23

Christian Fibich's avatar
Christian Fibich committed
24
25
26
use strict;
use warnings;

27
28
29
use FindBin;
use lib "$FindBin::Bin";

Christian Fibich's avatar
Christian Fibich committed
30
31
use Log::Log4perl qw(get_logger);
use Tk;
32
use Tk::widgets qw(LabFrame Label Entry Button DialogBox FBox Checkbutton);
Stefan Tauner's avatar
Stefan Tauner committed
33
use Tk::FIJIUtils;
34
use Tk::FIJIModalDialog;
Christian Fibich's avatar
Christian Fibich committed
35
36
use Clone qw(clone);
use File::Spec;
Stefan Tauner's avatar
Stefan Tauner committed
37
use File::Basename qw(basename);
38
use FIJI::Utils;
Christian Fibich's avatar
Christian Fibich committed
39
use FIJI qw(UART TESTCONSTMAP);
Christian Fibich's avatar
Christian Fibich committed
40
41
42
use threads;
use threads::shared;
use Thread::Queue;
43
44
use Socket;
use IO::Handle;
45
use Getopt::Long qw(:config bundling);
46
use Pod::Usage;
Christian Fibich's avatar
Christian Fibich committed
47

48
49
50
51
## @var USE_MENU defines control style of fiji_settings:
# 0 => classic, no menu GUI
# 1 => toplevel menu
# undef => classic+menu GUI
52
use constant USE_MENU => undef;
53

Stefan Tauner's avatar
Stefan Tauner committed
54
use FIJI qw(:default :fiji_dir);
Christian Fibich's avatar
Christian Fibich committed
55
56
57
use FIJI::Tests;
use FIJI::Downloader;
use Tk::FIJITestsViewer;
58
use Tk::FIJIUtils;
Christian Fibich's avatar
Christian Fibich committed
59

Christian Fibich's avatar
Christian Fibich committed
60
use constant TESTS_FILE_TYPES_CFG => [
61
    ['FIJI Tests', ['.tst']],
Christian Fibich's avatar
Christian Fibich committed
62
63
    ['All files', '*'],
];
64

Christian Fibich's avatar
Christian Fibich committed
65
66
67
68
use constant SETTINGS_FILE_TYPES_CFG => [
    ['FIJI Settings', ['.cfg', '*.ini']],
    ['All files', '*'],
];
Christian Fibich's avatar
Christian Fibich committed
69

70
71
72
73
use constant FILE_TYPES_CFG => [['FIJI Tests', ['.cfg', '*.ini']], ['All files', '*'],];
use constant FILE_TYPES_TB  => [['All files', '*'],];
use constant FILE_TYPES_GL  => [['VHDL Files', ['.vhd']],['All files', '*']];

74
use constant APPNAME => 'FIJI Execution Engine';
75

76
77
78
my $queue_to_worker = Thread::Queue->new();    # Queue from the GUI to the worker thread (transmitting workload)
my $queue_to_gui = Thread::Queue->new();    # Queue from worker to GUI (transmitting state, status message from the HW, and test patterns to re-enact the test run)
my $log_queue = Thread::Queue->new();    # Queue for communicating log messages to the GUI thread
Christian Fibich's avatar
Christian Fibich committed
79
my $worker_tid;
Christian Fibich's avatar
Christian Fibich committed
80
my $downloader;
81
my $uart_complete;
82
my $unsaved_changes = 0;
Christian Fibich's avatar
Christian Fibich committed
83

84
85
my $current_dir = ".";

86
87
88
89
#** @function download_worker ()
# @brief Downloader worker thread for fiji_download_gui
#
# As Perl::Tk is not thread-safe, parallel GUI ops and Downloading tests is
90
91
92
# done via a master/worker pattern.
# The worker thread gets its work packages from a queue and answers via another.
# It implements a "Signal Handler" for SIGSTOP to abort a fault injection operation.
93
94
# Logging is done via a Queue so the Tk Part can display log messages in a
# Tk widget.
Christian Fibich's avatar
Christian Fibich committed
95
sub download_worker {
96
    my $logger = get_logger("");
97
    my $loglevel = shift;
98
    eval {
99
100
101
        my $cont = 1;
        $SIG{'STOP'} = sub { $cont = 0; };

102
        $queue_to_gui->enqueue({'state' => "starting"});
103

104
105
106
107
        # We need to re-append the log queue to the logger here because
        # the GUI does it after this thread is created and hence the
        # logger object of this thread does not get updated.
        # Perl threads don't share variables...
108
        Tk::FIJITestsViewer::append_logger($log_queue, $loglevel);
109

110
111
112
113
114
115
116
117
118
119
        # forever, get new workload
        while (defined(my $item = $queue_to_worker->dequeue())) {
            my $dl      = $item->{'downloader'};
            my $testref = {};
            $cont = 1;
            my $worker_msg;

            # download tests according to mode
            if ($item->{'mode'} eq "auto") {
                $worker_msg = $dl->download_auto(
120
                    \$cont,
121
122
123
124
125
126
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
127
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg});
128
                        return $cont;
129
                    },
130
131
132
                );
            } elsif ($item->{'mode'} eq "random") {
                $worker_msg = $dl->download_random(
133
                    \$cont,
134
135
136
137
138
139
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
140
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg});
141
                        return $cont;
142
                    },
143
144
                );
            } elsif ($item->{'mode'} eq "manual") {
145
                $worker_msg = $dl->download_test(
146
                    \$cont,
147
148
149
                    $item->{'test'},
                    $item->{'uart'},
                );
150
            } elsif ($item->{'mode'} eq "dryrun") {
151
                $worker_msg = $dl->get_fic_status(\$cont, $item->{'uart'});
152
153
154
            }

            # reply to GUI (last message of current work package)
155
            $queue_to_gui->enqueue({'state' => "finished", 'rmsg' => $worker_msg, 'testref' => $testref});
Christian Fibich's avatar
Christian Fibich committed
156
        }
157
158
159
160
161
162
    };
    if ($@ ne "") {
        $logger->error("Download worker exited unexpectedly: $@");
        # Return only first line of what eval returns to the GUI.
        # Usually this is something like:
        # "ERROR: can't load appenderclass 'Log::Dispatch::QueueAppender'"
163
        $queue_to_gui->enqueue({'state' => "dying", 'rmsg' => (split /\n/, $@)[0]});
164
    }
Christian Fibich's avatar
Christian Fibich committed
165
166
}

167

Christian Fibich's avatar
Christian Fibich committed
168

169
170
sub _indicate_changes {
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
171
    my $self   = shift;
172
    $unsaved_changes = shift;
173
    return if (!defined($self->{'change_label'}));
174

Christian Fibich's avatar
Christian Fibich committed
175
    if ($unsaved_changes == 1) {
Stefan Tauner's avatar
Stefan Tauner committed
176
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
Christian Fibich's avatar
Christian Fibich committed
177
        $self->{'mw'}->configure(-title => "*" . APPNAME);
178
    } else {
Stefan Tauner's avatar
Stefan Tauner committed
179
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
180
181
182
        $self->{'mw'}->configure(-title => APPNAME);
    }
}
183

184
185


Christian Fibich's avatar
Christian Fibich committed
186
sub main {
187
    my $logger = get_logger("");
188
189
    my $name   = $0;
    my @ARGV   = @_;
Stefan Tauner's avatar
Stefan Tauner committed
190
191
    my $ret    = 0;
    my $verbosity_delta = 0;
192
193
    $name =~ s/\.p[lm]//;
    $logger->debug("=== Starting new execution of $name ===");
Christian Fibich's avatar
Christian Fibich committed
194
    $logger->debug(sprintf("%d argument(s)%s", scalar(@_), scalar(@_) > 0 ? ": @_" : ""));
195

196
197
    my ($settings_filename, $tests_filename, $help);

Stefan Tauner's avatar
Stefan Tauner committed
198
199
    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "t|tests=s"    => \$tests_filename,
Stefan Tauner's avatar
Stefan Tauner committed
200
                           "v|verbose+"   => \$verbosity_delta,
Stefan Tauner's avatar
Stefan Tauner committed
201
                           "h|help"       => \$help);
202

Stefan Tauner's avatar
Stefan Tauner committed
203
    my $loglevel = FIJI::Utils::increase_verbosity($verbosity_delta);
204

205
206
    pod2usage(-exitval => 1, -verbose => 1) if (!$parse);
    pod2usage(0) if (defined $help);
207

208
    # Create heavy thread as soon as possible
209
    $worker_tid = threads->create('download_worker',$loglevel);
210

211
    my %hash;
Christian Fibich's avatar
Christian Fibich committed
212
    my $self = bless(\%hash);
213

Stefan Tauner's avatar
Stefan Tauner committed
214
    my $libdir = File::Spec->catdir(FIJI_DIR, "media");
215
    my $ugdir = File::Spec->catdir(FIJI_DIR, "docs", "userguide");
216

217
218
    my $tests_ini_name;
    $self->{'tests_ini_name'} = \$tests_ini_name;
219
    my $settings_ini_name;
220
    $self->{'settings_ini_name'} = \$settings_ini_name;
221

222
223
224
225
226
227
228
    #
    # Build GUI
    #
    # Assigning $0 sets a "prettier" program title in Gnome's taskbar
    # Must not contain spaces (duh)
    $0 = (APPNAME =~ s/\s+/\-/rg);
    my $mw = MainWindow->new(-title => APPNAME);
229
    $self->{'mw'} = $mw;
230
    $mw->appname(APPNAME);
231
    $mw->withdraw();
232
    Tk::FIJIUtils::set_icon($mw);
233
234
235

    ### Load settings

236
    if (defined $settings_filename) {
237
        my $filename = FIJI::Utils::glob_path($settings_filename);
238
239
240
        my ($tmp_settings, $errors, $warnings) = FIJI::Settings->new('download', $filename); # fixme
        if (!defined($tmp_settings)) {
            my $msg = "Settings file $filename could not be loaded correctly.\n$errors";
241
            $logger->error($msg) if !$tmp_settings;
Stefan Tauner's avatar
Stefan Tauner committed
242
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
243
                                                   -wraplength => $self->{'mw'}->screenwidth,
244
                                                   -text      => $msg,
245
                                                   -title     => 'Open FIJI Settings failed!',
246
                                                  );
247
            $d->Show();
248
249
250
251
            if (!defined($tmp_settings)) {
                $ret = 1;
                goto bailout;
            }
252
        }
253
        $self->{'settings'} = $tmp_settings;
Christian Fibich's avatar
Christian Fibich committed
254
        ${$self->{'settings_ini_name'}} = $filename;
255
        $current_dir = _setdir($filename);
Christian Fibich's avatar
Christian Fibich committed
256
    } else {
257
258
259
260
261
262
        my $tmp_settings;
        do {
            $tmp_settings = $self->_load_settings_prompt($mw);
        } while (!defined($tmp_settings));

        $self->{'settings'} = $tmp_settings;
263
264
    }

Christian Fibich's avatar
Christian Fibich committed
265
    if (!defined ${$self->{'settings_ini_name'}}) {
266
        $logger->error("No settings file chosen");
267
268
        $ret = 1;
        goto bailout;
Christian Fibich's avatar
Christian Fibich committed
269
    }
270

271
    my $tmp_tests;
Christian Fibich's avatar
Christian Fibich committed
272
    unless (defined($tests_filename) && defined ($tmp_tests = $self->_read_tests_file($tests_filename))) {
273
274
275
        # Create one with defaults
        $logger->info("No test file given. Creating one with defaults.");
        my $warn;
276
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
277
278
279
280
281
282
        ($tmp_tests, $warn) = FIJI::Tests->new('GUI', $self->{'settings'}, undef, undef, 1);
        $logger->error($warn) if (defined($warn));
    }
    if (!ref($tmp_tests)) {
        $ret = 1;
        goto bailout;
283
    }
284
    $self->{'tests'} = $tmp_tests;
285

286
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
287
288
289
290
291
292
293

    if (!defined USE_MENU || USE_MENU == 1) {
        $self->{'menu'} = $self->_menu($mw);
    }

    $mw->toplevel()->bind('<Control-o>'       => sub { $self->_open_tests_file; });
    $mw->toplevel()->bind("<Control-s>"       => sub { $self->_save; });
294
295
296
    $mw->toplevel()->bind("<Control-t>"       => sub { $self->_export_test; });
    $mw->toplevel()->bind("<Control-r>"       => sub { $self->_export_rtl_sim; });
    $mw->toplevel()->bind("<Control-g>"       => sub { $self->_export_gate_level_sim; });
297
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
298
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit(); });
299
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
300

301
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
302
303
        -changes_callback => sub { my $value = shift; _indicate_changes($self, $value) },
        -test_callback    => sub { my $value = shift; $self->{'export_menuentry'}->configure(-state => ($value > 0) ? "normal" : "disabled")},
304
        -mw               => $self->{'mw'},
Christian Fibich's avatar
Christian Fibich committed
305
306
307
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
308
309
310
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
311
        -loglevel          => $loglevel
312
313
      );

314
315
316
317
318
319
320
    # Needs to happen after instatiation of FIJITestsViewer due to uart_complete
    $self->{'ctrl'} = _ctrl_frame($self, $mw);

    $self->{'FIJITestsViewer'}->pack(
        '-fill'   => 'both',
        '-expand' => 1
    );
321
    $mw->protocol('WM_DELETE_WINDOW' => [\&_onexit, $self]);
322

323
324
325
    $mw->deiconify();
    $mw->raise();
    $mw->update();
Christian Fibich's avatar
Christian Fibich committed
326

327
328
329
330
331
332
    # The download_helper will notify the GUI at startup of its status
    # by sending a message with 'state' set to either 'starting' or 'dying'
    # The event handler below will kill the main window in case something bad happend.
    $mw->afterIdle(sub {
        my $worker_msg = $self->{'FIJITestsViewer'}->{'queue_from_worker'}->dequeue();
        if ($worker_msg->{'state'} eq "dying") {
Stefan Tauner's avatar
Stefan Tauner committed
333
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
334
                                                   -wraplength => $self->{'mw'}->screenwidth,
335
                                                   -text      => $worker_msg->{'rmsg'},
336
                                                   -title     => 'Starting the download worker thread failed!',);
337
338
339
340
341
342
            $d->Show();
            $self->{'FIJITestsViewer'}->{'mw'}->destroy();
            $ret = 1;
        }
    });

343
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
344

Christian Fibich's avatar
Christian Fibich committed
345
  bailout:
346
347
    $self->_cleanup();

348
    $logger->trace("=== Stopping execution ===");
349
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
350
351
}

352
353
354
355
356
sub _menu {
    my ($self, $mw) = @_;

    my $menubar = $self->{'menu'} = $mw->Menu(-relief => "groove");

357
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
358
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
359
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
360

361
362
    $self->{'export_menuentry'} = $export;

363
364
    $tests->separator;
    $tests->command(
365
        -label       => 'Open',
366
        -accelerator => 'Ctrl+o',
367
368
369
        -underline   => 0,
        -command     => [\&_open_tests_file, $self],
    );
370
371
    $tests->separator;
    $tests->command(
372
        -label       => 'Save',
373
        -accelerator => 'Ctrl+s',
374
375
376
        -underline   => 0,
        -command     => [\&_save, $self],
    );
377
    $tests->command(
378
        -label       => 'Save As ...',
379
        -accelerator => 'Ctrl+Shift+s',
380
381
382
383
        -underline   => 1,
        -command     => [\&_save_as, $self],
    );

384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
    $export->separator;
    $export->command(
        -label       => 'As Test Configuration',
        -accelerator => 'Ctrl+t',
        -underline   => '0',
        -command     => [\&_export_test, $self],
    );
    $export->command(
        -label       => 'As RTL simulation template',
        -accelerator => 'Ctrl+r',
        -underline   => '0',
        -command     => [\&_export_rtl_sim, $self],
    );
    $export->command(
        -label       => 'As VHDL architecture for gate-level simulation',
399
        -accelerator => 'Ctrl+g',
400
401
402
403
        -underline   => '0',
        -command     => [\&_export_gate_level_sim, $self],
    );

404
405
406
407
408
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
409
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
410
411
412
413
414
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
415
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
416
417
418
419
    );
    $mw->configure(-menu => $menubar);
}

420
421
422
423
424
425
426
427
428
429
430
431
432
433
434

sub _export_test {
    my $logger = get_logger("");
    my $self = shift;
    my $last_test_ref = $self->{'FIJITestsViewer'}->get_last_test();
    return if (!defined $last_test_ref);
    my $name;
    my $rv;
    do {
        $name = $self->{'mw'}->FBox(-title=> "Export last test run as test configuration...", -type => "save", -filetypes => TESTS_FILE_TYPES_CFG)->Show;
        if (defined $name) {
            $rv = $last_test_ref->save($name) if defined $name;
            if(defined $rv) {
                $logger->error($rv);

Stefan Tauner's avatar
Stefan Tauner committed
435
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
436
                                                       -text        => $rv,
437
                                                       -title       => "Error saving tests.",);
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

sub _export_gate_level_sim {
    my $logger = get_logger("");
    my $self = shift;
    my $last_test_ref = $self->{'FIJITestsViewer'}->get_last_test();
    return if (!defined $last_test_ref);
    my $name;
    my $rv;
    do {
        $name = $self->{'mw'}->FBox(-title=> "Export FIJI simulation model for gate-level simulation...", -type => "save", -filetypes => FILE_TYPES_GL)->Show;
        if (defined $name) {
            $rv = $last_test_ref->export_gate_level($name,$self->{'FIJITestsViewer'}->{'settings'});
            if(defined $rv) {
                $logger->error($rv);
Stefan Tauner's avatar
Stefan Tauner committed
458
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
459
                                                       -text        => $rv,
460
                                                       -title       => "Error FIJI simulation model for gate-level simulation.",);
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

sub _export_rtl_sim {
    my $logger = get_logger("");
    my $self = shift;
    my $last_test_ref = $self->{'FIJITestsViewer'}->get_last_test();;
    return if (!defined $last_test_ref);
    my $name;
    my $rv;
    do {
        $name = $self->{'mw'}->FBox(-title=> "Export RTL simulation templates... (basename)", -type => "save", -filetypes => FILE_TYPES_TB)->Show;
        if (defined $name) {
            $rv = $last_test_ref->export_tb($name,$self->{'FIJITestsViewer'}->{'settings'});
            if(defined $rv) {
                $logger->error($rv);
Stefan Tauner's avatar
Stefan Tauner committed
481
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
482
                                                       -text        => $rv,
483
                                                       -title       => "Error saving RTL simulation templates.",);
484
485
486
487
488
489
490
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

491
492
493
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
494
    return File::Spec->catpath($volume, $directories, "");
495
496
}

Christian Fibich's avatar
Christian Fibich committed
497
sub _load_settings_prompt {
498
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
499
    my ($self, $fr) = @_;
500
501
502
503

    my $tmp_settings;
    my $filename;

504
505
506
507
508
509
510
511
512
    my $fb = $fr->FBox(
        -type        => 'open',
        -title       => 'Open FIJI Configuration file',
        -filetypes   => SETTINGS_FILE_TYPES_CFG,
        -initialdir  => $current_dir,
        -initialfile => 'fiji.cfg'
    );
    Tk::FIJIUtils::set_icon($fb);
    $filename = $fb->Show();
513

514
515
516
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
Christian Fibich's avatar
Christian Fibich committed
517
    }
518
    $current_dir = _setdir($filename);
Christian Fibich's avatar
Christian Fibich committed
519

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
    $tmp_settings = (defined $self->{'settings'}) ? \%{Clone::clone($self->{'settings'})} : undef;
    my ($errors, $warnings);
    ($tmp_settings, $errors, $warnings) = FIJI::Settings->new('download', $filename, $tmp_settings);
    if (defined($errors) || defined($warnings)) {
        my $msg = "";
        $msg .= "Following errors prevented the settings to be loaded correctly:\n$errors\n" if $errors;
        $msg .= "Potential (future) problems:\n$warnings\n" if defined($warnings);
        chomp($msg);
        chomp($msg);
        $logger->error($msg) if !$tmp_settings;
        my $d = $self->{'mw'}->FIJIModalDialog(-image      => (!defined($tmp_settings) ?
                                                                Tk::FIJIUtils::error_image($self->{'mw'}) :
                                                                Tk::FIJIUtils::alert_image($self->{'mw'})
                                                              ),
                                               -wraplength => $self->{'mw'}->screenwidth,
                                               -text       => $msg,
                                               -title      => "Problems while loading settings file $filename!",);
        $d->Show();
    }
    ${$self->{'settings_ini_name'}} = $filename;
    return $tmp_settings;
Christian Fibich's avatar
Christian Fibich committed
541
542
543
}

sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
544
    my ($self, $fr) = @_;
545
546
547
548
549
550
551
552
553
554
555
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

556
    ## FIJI Settings ##
557
558
559
560
561
    my $fiji_cfg_lbl;
    my $fiji_cfg_entry;
    $fiji_cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Configuration file',
        -justify => 'left',
Christian Fibich's avatar
Christian Fibich committed
562
    )->grid(-row => 0, -column => 0, -sticky => "e");
563
564

    $fiji_cfg_entry = $fr_ctrl->Entry(
Christian Fibich's avatar
Christian Fibich committed
565
        -text  => ${$self->{'settings_ini_name'}},
566
        -state => 'readonly',
567
    )->grid(-row => 0, -column => 2, -columnspan => 4, -sticky => "ew");
568

569
570
571
572
573
574
575
576
    ## FIJI Tests ##
    my $cfg_lbl;
    my $chng_lbl;
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;

577
578
579
    $cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Tests file',
        -justify => 'left',
580
581
    )->grid(-row => 1, -column => 0, -sticky => "e");

582
    $self->{'change_label'} = $chng_lbl = $fr_ctrl->Label(
Stefan Tauner's avatar
Stefan Tauner committed
583
        -image => Tk::FIJIUtils::dummy_image($self->{'mw'}),
584
    )->grid(-row => 1, -column => 1, -sticky => "we");
585

586
587
    my $balloon = $fr_ctrl->Balloon();
    $balloon->attach($chng_lbl, -postcommand => sub { return $unsaved_changes == 1 }, -msg => "Unsaved changes");
588

589
590
591
592
    if (!defined USE_MENU || USE_MENU == 0) {
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
            -command => [\&_open_tests_file, $self],
593
        )->grid(-row => 1, -column => 2, -sticky => "ew");
594
595
596
597
598
599
600
601
602
603
604
        $cfg_btn_open->focus();

        $cfg_btn_save = $fr_ctrl->Button(
            -text    => 'Save',
            -command => [\&_save, $self],

            # sub {
            # my $state = defined($filename) ? 'normal' : 'disabled';
            # $cfg_btn_open->configure(-state => $state);
            # $cfg_btn_save->configure(-state => $state);
            # },
605
        )->grid(-row => 1, -column => 3, -sticky => "ew");
606
607
608
        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
            -command => [\&_save_as, $self],
609
        )->grid(-row => 1, -column => 4, -sticky => "ew");
610
    }
611
612

    $cfg_entry = $fr_ctrl->Entry(
613
        -textvariable       => $self->{'tests_ini_name'},
614
615
        -state              => 'disabled',
        -disabledforeground => 'black',
Christian Fibich's avatar
Christian Fibich committed
616
        -takefocus          => 0,                           # default for disabled
617
618
    )->grid(-row => 1, -column => 5, -sticky => "ew");
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
619

620
621
622
    ## UART ##
    my $uart_row = 2;
    
Christian Fibich's avatar
Christian Fibich committed
623
    my $uart_label = $fr_ctrl->Label(
624
625
626
627
628
629
630
631
        -text    => 'UART',
        -justify => 'left',
    )->grid(
        '-row'    => $uart_row,
        '-column' => 0,
        '-sticky' => "e");

    $uart_complete = $fr_ctrl->CompleteEntry();
Christian Fibich's avatar
Christian Fibich committed
632
    my $uart_button = $fr_ctrl->Button(
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
        -text    => 'Update Choices',
        -command => sub {
            $uart_complete->configure(
                '-choices' => FIJI::Utils::get_uart_devs(),
            );
        },
    )->grid(
        '-row'    => $uart_row,
        '-column' => 2,
        '-sticky' => "w",
    );

    $uart_complete->grid(
        '-row'        => $uart_row,
        '-column'     => 3,
        '-sticky'     => "ew",
        '-columnspan' => 5,
    );

    $uart_complete->configure(
        '-choices' => FIJI::Utils::get_uart_devs(),
        '-textvariable' => \$self->{'tests'}->{'design'}->{'UART'},
    );

Christian Fibich's avatar
Christian Fibich committed
657
658
659
660
    for my $w ($uart_complete, $uart_button, $uart_label) {
        $balloon->attach($w, -balloonposition => 'mouse', -msg => TESTCONSTMAP->{'UART'}->{'help'});
    }

661
    return $fr_ctrl;
Christian Fibich's avatar
Christian Fibich committed
662
663
}

664
665
666
667
668
669
670
671
## @method private _read_tests_file ($self, $filename)
#
# @brief Creates a new FIJI::Tests object by reading the given file
#
# @returns the newly created FIJI::Tests object
sub _read_tests_file {
    my $logger = get_logger("");
    my ($self, $filename) = @_;
672
    $filename = FIJI::Utils::glob_path($filename);
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
    my $tmp_tests;
    if (-e $filename) {
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
        my $msg_ref;
        ($tmp_tests, $msg_ref) = FIJI::Tests->new('GUI', $self->{'settings'}, $filename,);
        if (defined($msg_ref)) {
            my $msg;
            if (!defined($tmp_tests)) {
                $msg = "Tests file $filename could not be loaded correctly:\n";
            } else {
                $msg = "Tests file $filename contained errors:\n";
            }
            if (ref($msg_ref) eq "ARRAY") {
                $msg .= join("\n", @$msg_ref);
            } else {
                $msg .= $msg_ref;
            }
            $logger->error($msg);
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
692
                                                   -wraplength => $self->{'mw'}->screenwidth,,
693
694
695
696
697
                                                   -text      => $msg,
                                                   -title     => 'Open FIJI Tests failed!',);
            $d->Show();
            return undef;
        }
Christian Fibich's avatar
Christian Fibich committed
698
699
    } else {
        
700
701
702
703
704
705
    }
    ${$self->{'tests_ini_name'}} = $filename;
    $current_dir = _setdir($filename);
    return $tmp_tests;
}

706
sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
707
708
    my $logger = get_logger("");
    my $self   = shift;
709

Stefan Tauner's avatar
Stefan Tauner committed
710
    my $fb = $self->{'mw'}->FBox(
711
712
713
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
714
        -initialdir  => $current_dir,
715
        -initialfile => 'fiji.tst'
Stefan Tauner's avatar
Stefan Tauner committed
716
717
718
719
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

720
721
722
723
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
724
    $current_dir = _setdir($filename);
725
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
726
    $tmp_tests = $self->_read_tests_file($filename);
727
728
729
    if (!ref($tmp_tests)) {
        return;
    }
730

731
732
733
    if (!defined($self->{'FIJITestsViewer'}->configure(-tests => $tmp_tests))) {
        my $msg = "Could not update GUI correctly with new tests.";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
734
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
735
                                               -wraplength => $self->{'mw'}->screenwidth,,
736
                                               -text      => $msg,
737
                                               -title     => 'Open FIJI Tests failed!',);
738
        $d->Show();
739
740
741
742
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
743
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
744
745
746
747
748
    # Re-attach UART selector to new hash
    $uart_complete->configure(
        '-choices' => FIJI::Utils::get_uart_devs(),
        '-textvariable' => \$self->{'tests'}->{'design'}->{'UART'},
    );
749
750
}

Christian Fibich's avatar
Christian Fibich committed
751
sub _overwrite_existing_file ($) {
Christian Fibich's avatar
Christian Fibich committed
752
    my ($self, $filename) = @_;
753
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
754
    if (!-e $filename) {
755
756
        return 1;
    }
757
    my $d = $self->{'mw'}->FIJIModalDialog(-title     => 'Really overwrite?',
Stefan Tauner's avatar
Stefan Tauner committed
758
                                           -image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
759
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
760
                                           -buttons   => ["~Yes", "~No"]);
761
    my $reply = $d->Show();
762
    return (defined $reply && lc($reply) eq 'yes');
Christian Fibich's avatar
Christian Fibich committed
763
764
765
}

sub _save_file {
Christian Fibich's avatar
Christian Fibich committed
766
    my ($self, $filename) = @_;
767
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
768
    if (!$self->_overwrite_existing_file($filename)) {
769
770
771
        return;
    }
    my $err = $self->{'tests'}->save($filename);
Christian Fibich's avatar
Christian Fibich committed
772
    if (defined($err)) {
773
774
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
775
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
776
                                               -text        => $msg,
777
                                               -title       => 'Save failed!',);
778
        $d->Show();
779
780
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
781
    ${$self->{'tests_ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
782

783
784
    $self->{'FIJITestsViewer'}->set_state_as_original();

785
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
786
787
788
}

sub _save {
789
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
790
    if (!defined(${$self->{'tests_ini_name'}})) {
791
792
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
793
        return $self->_save_file(${$self->{'tests_ini_name'}});
794
    }
Christian Fibich's avatar
Christian Fibich committed
795
796
797
}

sub _save_as {
798
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
799
    my $fb = $self->{'mw'}->FBox(
800
        -type             => 'save',
801
        -title            => 'Save FIJI Tests file as...',
802
        -defaultextension => 'tst',
803
        -filetypes        => TESTS_FILE_TYPES_CFG,
804
        -initialdir       => $current_dir,
805
806
807
808
        -initialfile      => 'fiji.tst',
        -force            => 1, # prevent FBox's "overwrite?" dialog
                                #    because we have our own check and a nicer dialog
                                #    AND we want to prevent showing the dialog twice
Stefan Tauner's avatar
Stefan Tauner committed
809
810
811
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
812

Christian Fibich's avatar
Christian Fibich committed
813
    if (!defined($filename)) {
814
815
        return;
    }
816
    $current_dir = _setdir($filename);
817
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
818
819
}

820
sub _onexit {
821
    my $logger = get_logger("");
822
823
    my ($self) = @_;

824
825
826
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

827
    my $response;
828
    if ($unsaved_changes == 1) {
829
        $logger->debug("Settings changed. Asking to save.");
Stefan Tauner's avatar
Stefan Tauner committed
830
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
831
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
832
                                               -wraplength  => $self->{'mw'}->screenwidth,,
833
                                               -title       => 'Really quit?',
834
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
835
836
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
Christian Fibich's avatar
Christian Fibich committed
837

838
839
840
841
        # use _save_as to give the user the chance to save under a different name
        $self->_save_as if (defined $response && $response eq "Save");

        if (!defined $response || $response ne "Cancel") {
Christian Fibich's avatar
Christian Fibich committed
842
            goto finish;
843
844
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
845
        goto finish;
846
    }
Christian Fibich's avatar
Christian Fibich committed
847
848
849
    return;

finish:
850
851
852
853
854
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
855
    my $logger = get_logger("");
856
    my $self = shift;
857
    $self->{'mw'}->destroy() if Exists($self->{'mw'});
858

859
860
861
    # End the queue(s) to signal other threads to stop
    # There is a bug in 804.031 (and below?) that sometimes provokes
    # segfaults with this procedure, cf. https://rt.cpan.org/Public/Bug/Display.html?id=89621
862
863
    $queue_to_worker->end();
    $queue_to_gui->end();
864
    $logger->remove_appender("queueAppender");
865
    $log_queue->end();
866
    $worker_tid->join();
867
868
}

869
870
my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
871
872
# We can get the buffered output from the log window
Log::Log4perl->eradicate_appender("string");
Christian Fibich's avatar
Christian Fibich committed
873
exit main(@ARGV);
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910

__END__

=head1 NAME

    fiji_ee_gui.pl

=head1 SYNOPSIS

    fiji_ee_gui.pl [options]
    
    fiji_ee_gui.pl is the graphical FIJI Tests Editor and Execution Engine

=head1 OPTIONS

=head2 OPTIONAL PARAMETERS

=over

=item B<-s, --settings FILENAME>

FIJI Settings file

=item B<-t, --tests FILENAME>

FIJI Tests file

=item B<-v, --verbose>

Increase verbosity of output. Can be given multiple times to increase
the verbosity level once per occurrence.

=item B<-h, --help>

Display this help and exit

=back