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

3
4
5
#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
Christian Fibich's avatar
Christian Fibich committed
6
#
7
8
9
10
# The creation of this file has been supported by the publicly funded
# R&D project Josef Ressel Center for Verification of Embedded Computing
# Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG).
#
11
12
13
# Authors:
# Christian Fibich <fibich@technikum-wien.at>
# Stefan Tauner <tauner@technikum-wien.at>
Christian Fibich's avatar
Christian Fibich committed
14
#
15
16
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
Christian Fibich's avatar
Christian Fibich committed
17
#
18
19
20
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Christian Fibich's avatar
Christian Fibich committed
21
#
22
23
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
Christian Fibich's avatar
Christian Fibich committed
24

Christian Fibich's avatar
Christian Fibich committed
25
## @file
26
# @brief FIJI Execution Engine (GUI)
Christian Fibich's avatar
Christian Fibich committed
27
## @file
28
# A TK GUI application to execute predefined, manually entered, and random tests
Christian Fibich's avatar
Christian Fibich committed
29

Christian Fibich's avatar
Christian Fibich committed
30
31
32
use strict;
use warnings;

33
34
35
use FindBin;
use lib "$FindBin::Bin";

Christian Fibich's avatar
Christian Fibich committed
36
37
use Log::Log4perl qw(get_logger);
use Tk;
38
use Tk::widgets qw(LabFrame Label Entry Button DialogBox FBox Checkbutton);
Stefan Tauner's avatar
Stefan Tauner committed
39
use Tk::FIJIUtils;
40
use Tk::FIJIModalDialog;
Christian Fibich's avatar
Christian Fibich committed
41
use Clone qw(clone);
42
use Scalar::Util 'blessed';
Christian Fibich's avatar
Christian Fibich committed
43
use File::Spec;
Stefan Tauner's avatar
Stefan Tauner committed
44
use File::Basename qw(basename);
45
use FIJI::Utils;
Christian Fibich's avatar
Christian Fibich committed
46
use FIJI qw(UART TESTCONSTMAP);
Christian Fibich's avatar
Christian Fibich committed
47
48
49
use threads;
use threads::shared;
use Thread::Queue;
50
51
use Socket;
use IO::Handle;
52
use Getopt::Long qw(:config bundling);
53
use Pod::Usage;
Christian Fibich's avatar
Christian Fibich committed
54

55
56
57
58
## @var USE_MENU defines control style of fiji_settings:
# 0 => classic, no menu GUI
# 1 => toplevel menu
# undef => classic+menu GUI
59
use constant USE_MENU => undef;
60

61
use FIJI qw(:default :fiji_dir);
Christian Fibich's avatar
Christian Fibich committed
62
63
64
use FIJI::Tests;
use FIJI::Downloader;
use Tk::FIJITestsViewer;
65
use Tk::FIJIUtils;
Christian Fibich's avatar
Christian Fibich committed
66

Christian Fibich's avatar
Christian Fibich committed
67
use constant TESTS_FILE_TYPES_CFG => [
68
    ['FIJI Tests', ['.tst']],
Christian Fibich's avatar
Christian Fibich committed
69
70
    ['All files', '*'],
];
71

Christian Fibich's avatar
Christian Fibich committed
72
73
74
75
use constant SETTINGS_FILE_TYPES_CFG => [
    ['FIJI Settings', ['.cfg', '*.ini']],
    ['All files', '*'],
];
Christian Fibich's avatar
Christian Fibich committed
76

77
78
79
80
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', '*']];

81
use constant APPNAME => 'FIJI Execution Engine';
82

83
84
85
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
86
my $worker_tid;
Christian Fibich's avatar
Christian Fibich committed
87
my $downloader;
88
my $uart_complete;
89
my $unsaved_changes = 0;
Christian Fibich's avatar
Christian Fibich committed
90

91
92
my $current_dir = ".";

93
94
95
96
#** @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
97
98
99
# 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.
100
101
# 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
102
sub download_worker {
103
    my $logger = get_logger("");
104
    my $loglevel = shift;
105
    eval {
106
107
108
        my $cont = 1;
        $SIG{'STOP'} = sub { $cont = 0; };

109
        $queue_to_gui->enqueue({'state' => "starting"}) if (!$queue_to_gui->{'ENDED'});
110

111
112
113
114
        # 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...
115
        Tk::FIJITestsViewer::append_logger($log_queue, $loglevel);
116

117
118
119
120
121
122
123
124
125
126
        # 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(
127
                    \$cont,
128
129
130
131
132
133
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
134
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg}) if (!$queue_to_gui->{'ENDED'});
135
                        return $cont;
136
                    },
137
138
139
                );
            } elsif ($item->{'mode'} eq "random") {
                $worker_msg = $dl->download_random(
140
                    \$cont,
141
142
143
144
145
146
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
147
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg}) if (!$queue_to_gui->{'ENDED'});
148
                        return $cont;
149
                    },
150
151
                );
            } elsif ($item->{'mode'} eq "manual") {
152
                $worker_msg = $dl->download_test(
153
                    \$cont,
154
155
156
                    $item->{'test'},
                    $item->{'uart'},
                );
157
            } elsif ($item->{'mode'} eq "dryrun") {
158
                $worker_msg = $dl->get_fic_status(\$cont, $item->{'uart'});
159
160
161
            }

            # reply to GUI (last message of current work package)
162
            $queue_to_gui->enqueue({'state' => "finished", 'rmsg' => $worker_msg, 'testref' => $testref}) if (!$queue_to_gui->{'ENDED'});
Christian Fibich's avatar
Christian Fibich committed
163
        }
164
165
166
167
168
169
    };
    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'"
170
        $queue_to_gui->enqueue({'state' => "dying", 'rmsg' => (split /\n/, $@)[0]}) if (!$queue_to_gui->{'ENDED'});
171
    }
Christian Fibich's avatar
Christian Fibich committed
172
173
}

174

Christian Fibich's avatar
Christian Fibich committed
175

176
177
sub _indicate_changes {
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
178
    my $self   = shift;
179
    $unsaved_changes = shift;
180
    return if (!defined($self->{'change_label'}));
181

Christian Fibich's avatar
Christian Fibich committed
182
    if ($unsaved_changes == 1) {
Stefan Tauner's avatar
Stefan Tauner committed
183
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
Christian Fibich's avatar
Christian Fibich committed
184
        $self->{'mw'}->configure(-title => "*" . APPNAME);
185
    } else {
Stefan Tauner's avatar
Stefan Tauner committed
186
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
187
188
189
        $self->{'mw'}->configure(-title => APPNAME);
    }
}
190

191

Christian Fibich's avatar
Christian Fibich committed
192
sub main {
193
    my $logger = get_logger("");
Stefan Tauner's avatar
Stefan Tauner committed
194
195
    my $ret    = 0;
    my $verbosity_delta = 0;
196

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

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

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

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

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

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

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

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

223
224
225
226
227
228
229
    #
    # 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);
230
    $self->{'mw'} = $mw;
231
    $mw->appname(APPNAME);
232
    $mw->withdraw();
233
    Tk::FIJIUtils::set_icon($mw);
234
235
236

    ### Load settings

237
    my $tmp_settings;
238
    if (defined $settings_filename) {
239
        my $filename = FIJI::Utils::glob_path($settings_filename);
240
241
242
243
        $tmp_settings = $self->_load_settings($filename);
        if (!blessed($tmp_settings) || !$tmp_settings->isa("FIJI::Settings")) {
            $ret = 1;
            goto bailout;
244
        }
Christian Fibich's avatar
Christian Fibich committed
245
    } else {
246
247
        do {
            $tmp_settings = $self->_load_settings_prompt($mw);
248
249
250
251
252
253
            if (!defined($tmp_settings)) {
                Tk::FIJIUtils::show_error($mw, "A valid configuration file is required. Exiting.");
                $ret = 1;
                goto bailout;
            }
        } while (!blessed($tmp_settings) || !$tmp_settings->isa("FIJI::Settings"));
254
    }
255
    $self->{'settings'} = $tmp_settings;
256

257
    my $tmp_tests;
Christian Fibich's avatar
Christian Fibich committed
258
    unless (defined($tests_filename) && defined ($tmp_tests = $self->_read_tests_file($tests_filename))) {
259
260
261
        # Create one with defaults
        $logger->info("No test file given. Creating one with defaults.");
        my $warn;
262
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
263
264
265
266
267
268
        ($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;
269
    }
270
    $self->{'tests'} = $tmp_tests;
271

272
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
273
274
275
276
277
278
279

    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; });
280
281
282
    $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; });
283
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
284
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit(); });
285
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
286

287
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
288
289
        -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")},
Christian Fibich's avatar
Christian Fibich committed
290
291
292
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
293
294
295
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
296
        -loglevel          => $loglevel
297
298
      );

299
300
301
302
303
304
305
    # Needs to happen after instatiation of FIJITestsViewer due to uart_complete
    $self->{'ctrl'} = _ctrl_frame($self, $mw);

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

308
309
310
    $mw->deiconify();
    $mw->raise();
    $mw->update();
Christian Fibich's avatar
Christian Fibich committed
311

312
313
    # The download_helper will notify the GUI at startup of its status
    # by sending a message with 'state' set to either 'starting' or 'dying'
314
    # The event handler below will kill the main window in case something bad happens.
315
316
317
    $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
318
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
319
                                                   -wraplength => $self->{'mw'}->screenwidth,
320
                                                   -text      => $worker_msg->{'rmsg'},
321
                                                   -title     => 'Starting the download worker thread failed!',);
322
323
324
325
326
327
            $d->Show();
            $self->{'FIJITestsViewer'}->{'mw'}->destroy();
            $ret = 1;
        }
    });

328
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
329

Christian Fibich's avatar
Christian Fibich committed
330
  bailout:
331
332
    $self->_cleanup();

333
    $logger->info("=== Stopping execution ===");
334
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
335
336
}

337
338
339
340
341
sub _menu {
    my ($self, $mw) = @_;

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

342
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
343
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
344
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
345

346
347
    $self->{'export_menuentry'} = $export;

348
349
    $tests->separator;
    $tests->command(
350
        -label       => 'Open',
351
        -accelerator => 'Ctrl+o',
352
353
354
        -underline   => 0,
        -command     => [\&_open_tests_file, $self],
    );
355
356
    $tests->separator;
    $tests->command(
357
        -label       => 'Save',
358
        -accelerator => 'Ctrl+s',
359
360
361
        -underline   => 0,
        -command     => [\&_save, $self],
    );
362
    $tests->command(
363
        -label       => 'Save As ...',
364
        -accelerator => 'Ctrl+Shift+s',
365
366
367
368
        -underline   => 1,
        -command     => [\&_save_as, $self],
    );

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
    $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',
384
        -accelerator => 'Ctrl+g',
385
386
387
388
        -underline   => '0',
        -command     => [\&_export_gate_level_sim, $self],
    );

389
390
391
392
393
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
394
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
395
396
397
398
399
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
400
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
401
402
403
404
    );
    $mw->configure(-menu => $menubar);
}

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419

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
420
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
421
                                                       -text        => $rv,
422
                                                       -title       => "Error saving tests.",);
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
                $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
443
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
444
                                                       -text        => $rv,
445
                                                       -title       => "Error FIJI simulation model for gate-level simulation.",);
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
                $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
466
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
467
                                                       -text        => $rv,
468
                                                       -title       => "Error saving RTL simulation templates.",);
469
470
471
472
473
474
475
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

476
477
478
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
479
    return File::Spec->catpath($volume, $directories, "");
480
481
}

482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
sub _load_settings {
    my $logger = get_logger("");
    my ($self, $filename) = @_;
    my ($tmp_settings, $errors, $warnings) = FIJI::Settings->new('download', $filename);
    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();
        return $msg if !$tmp_settings;
    }
    $current_dir = _setdir($filename);
    ${$self->{'settings_ini_name'}} = $filename;
    return $tmp_settings;
}

508
509
510
511
# Returns
#  - undef if the user canceled the open dialog
#  - a FIJI::Settings reference in case of success
#  - an error message in case of intolerable errors
Christian Fibich's avatar
Christian Fibich committed
512
sub _load_settings_prompt {
513
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
514
    my ($self, $fr) = @_;
515
516
517
518

    my $tmp_settings;
    my $filename;

519
520
521
522
523
524
525
526
527
    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();
528

529
530
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
531
        return undef;
Christian Fibich's avatar
Christian Fibich committed
532
    }
533
    return $self->_load_settings($filename);
Christian Fibich's avatar
Christian Fibich committed
534
535
536
}

sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
537
    my ($self, $fr) = @_;
538
539
540
541
542
543
544
545
546
547
548
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

549
    ## FIJI Settings ##
550
551
552
553
554
    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
555
    )->grid(-row => 0, -column => 0, -sticky => "e");
556
557

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

562
563
564
565
566
567
568
569
    ## FIJI Tests ##
    my $cfg_lbl;
    my $chng_lbl;
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;

570
571
572
    $cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Tests file',
        -justify => 'left',
573
574
    )->grid(-row => 1, -column => 0, -sticky => "e");

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

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

582
583
584
585
    if (!defined USE_MENU || USE_MENU == 0) {
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
            -command => [\&_open_tests_file, $self],
586
        )->grid(-row => 1, -column => 2, -sticky => "ew");
587
588
589
590
591
592
593
594
595
596
597
        $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);
            # },
598
        )->grid(-row => 1, -column => 3, -sticky => "ew");
599
600
601
        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
            -command => [\&_save_as, $self],
602
        )->grid(-row => 1, -column => 4, -sticky => "ew");
603
    }
604
605

    $cfg_entry = $fr_ctrl->Entry(
606
        -textvariable       => $self->{'tests_ini_name'},
607
608
        -state              => 'disabled',
        -disabledforeground => 'black',
Christian Fibich's avatar
Christian Fibich committed
609
        -takefocus          => 0,                           # default for disabled
610
611
    )->grid(-row => 1, -column => 5, -sticky => "ew");
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
612

613
614
615
    ## UART ##
    my $uart_row = 2;
    
Christian Fibich's avatar
Christian Fibich committed
616
    my $uart_label = $fr_ctrl->Label(
617
618
619
620
621
622
623
624
        -text    => 'UART',
        -justify => 'left',
    )->grid(
        '-row'    => $uart_row,
        '-column' => 0,
        '-sticky' => "e");

    $uart_complete = $fr_ctrl->CompleteEntry();
Christian Fibich's avatar
Christian Fibich committed
625
    my $uart_button = $fr_ctrl->Button(
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
        -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
650
651
652
653
    for my $w ($uart_complete, $uart_button, $uart_label) {
        $balloon->attach($w, -balloonposition => 'mouse', -msg => TESTCONSTMAP->{'UART'}->{'help'});
    }

654
    return $fr_ctrl;
Christian Fibich's avatar
Christian Fibich committed
655
656
}

657
658
659
660
661
662
663
664
## @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) = @_;
665
    $filename = FIJI::Utils::glob_path($filename);
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    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'}),
685
                                                   -wraplength => $self->{'mw'}->screenwidth,,
686
687
688
689
690
                                                   -text      => $msg,
                                                   -title     => 'Open FIJI Tests failed!',);
            $d->Show();
            return undef;
        }
Christian Fibich's avatar
Christian Fibich committed
691
692
    } else {
        
693
694
695
696
697
698
    }
    ${$self->{'tests_ini_name'}} = $filename;
    $current_dir = _setdir($filename);
    return $tmp_tests;
}

699
sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
700
701
    my $logger = get_logger("");
    my $self   = shift;
702

Stefan Tauner's avatar
Stefan Tauner committed
703
    my $fb = $self->{'mw'}->FBox(
704
705
706
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
707
        -initialdir  => $current_dir,
708
        -initialfile => 'fiji.tst'
Stefan Tauner's avatar
Stefan Tauner committed
709
710
711
712
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

713
714
715
716
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
717
    $current_dir = _setdir($filename);
718
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
719
    $tmp_tests = $self->_read_tests_file($filename);
720
721
722
    if (!ref($tmp_tests)) {
        return;
    }
723

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

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

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

776
777
    $self->{'FIJITestsViewer'}->set_state_as_original();

778
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
779
780
781
}

sub _save {
782
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
783
    if (!defined(${$self->{'tests_ini_name'}})) {
784
785
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
786
        return $self->_save_file(${$self->{'tests_ini_name'}});
787
    }
Christian Fibich's avatar
Christian Fibich committed
788
789
790
}

sub _save_as {
791
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
792
    my $fb = $self->{'mw'}->FBox(
793
        -type             => 'save',
794
        -title            => 'Save FIJI Tests file as...',
795
        -defaultextension => 'tst',
796
        -filetypes        => TESTS_FILE_TYPES_CFG,
797
        -initialdir       => $current_dir,
798
799
800
801
        -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
802
803
804
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
805

Christian Fibich's avatar
Christian Fibich committed
806
    if (!defined($filename)) {
807
808
        return;
    }
809
    $current_dir = _setdir($filename);
810
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
811
812
}

813
sub _onexit {
814
    my $logger = get_logger("");
815
816
    my ($self) = @_;

817
818
819
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

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

831
832
833
834
        # 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
835
            goto finish;
836
837
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
838
        goto finish;
839
    }
Christian Fibich's avatar
Christian Fibich committed
840
841
842
    return;

finish:
843
844
845
846
847
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
848
    my $logger = get_logger("");
849
    my $self = shift;
850
    $self->{'mw'}->destroy() if Exists($self->{'mw'});
851

852
853
854
    # 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
855
856
    $queue_to_worker->end();
    $queue_to_gui->end();
857
    $logger->remove_appender("queueAppender", 0, 1);
858
    $log_queue->end();
859
    $worker_tid->join();
860
861
}

862
863
FIJI::Utils::log_start(1, 0, @ARGV);
exit main();
864
865
866
867
868
869
870
871
872
873
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

__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