fiji_ee_gui.pl 30.4 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
# Copyright (C) 2017 Christian Fibich <fibich@technikum-wien.at>
# Copyright (C) 2017 Stefan Tauner <tauner@technikum-wien.at>
Christian Fibich's avatar
Christian Fibich committed
9
#
10
11
# 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
12
#
13
14
15
# 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
16
#
17
18
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
Christian Fibich's avatar
Christian Fibich committed
19

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

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

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

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

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

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

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

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

72
73
74
75
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', '*']];

76
use constant APPNAME => 'FIJI Execution Engine';
77

78
79
80
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
81
my $worker_tid;
Christian Fibich's avatar
Christian Fibich committed
82
my $downloader;
83
my $uart_complete;
84
my $unsaved_changes = 0;
Christian Fibich's avatar
Christian Fibich committed
85

86
87
my $current_dir = ".";

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

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

106
107
108
109
        # 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...
110
        Tk::FIJITestsViewer::append_logger($log_queue, $loglevel);
111

112
113
114
115
116
117
118
119
120
121
        # 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(
122
                    \$cont,
123
124
125
126
127
128
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

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

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

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

169

Christian Fibich's avatar
Christian Fibich committed
170

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

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

186

Christian Fibich's avatar
Christian Fibich committed
187
sub main {
188
    my $logger = get_logger("");
Stefan Tauner's avatar
Stefan Tauner committed
189
190
    my $ret    = 0;
    my $verbosity_delta = 0;
191

192
193
    my ($settings_filename, $tests_filename, $help);

Stefan Tauner's avatar
Stefan Tauner committed
194
195
    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "t|tests=s"    => \$tests_filename,
Stefan Tauner's avatar
Stefan Tauner committed
196
                           "v|verbose+"   => \$verbosity_delta,
Stefan Tauner's avatar
Stefan Tauner committed
197
                           "h|help"       => \$help);
198

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

201
202
    pod2usage(-exitval => 1, -verbose => 1) if (!$parse);
    pod2usage(0) if (defined $help);
203

204
    # Create heavy thread as soon as possible
205
    $worker_tid = threads->create('download_worker',$loglevel);
206

207
    my %hash;
Christian Fibich's avatar
Christian Fibich committed
208
    my $self = bless(\%hash);
209

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

213
214
    my $tests_ini_name;
    $self->{'tests_ini_name'} = \$tests_ini_name;
215
    my $settings_ini_name;
216
    $self->{'settings_ini_name'} = \$settings_ini_name;
217

218
219
220
221
222
223
224
    #
    # 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);
225
    $self->{'mw'} = $mw;
226
    $mw->appname(APPNAME);
227
    $mw->withdraw();
228
    Tk::FIJIUtils::set_icon($mw);
229
230
231

    ### Load settings

232
    my $tmp_settings;
233
    if (defined $settings_filename) {
234
        my $filename = FIJI::Utils::glob_path($settings_filename);
235
236
237
238
        $tmp_settings = $self->_load_settings($filename);
        if (!blessed($tmp_settings) || !$tmp_settings->isa("FIJI::Settings")) {
            $ret = 1;
            goto bailout;
239
        }
Christian Fibich's avatar
Christian Fibich committed
240
    } else {
241
242
        do {
            $tmp_settings = $self->_load_settings_prompt($mw);
243
244
245
246
247
248
            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"));
249
    }
250
    $self->{'settings'} = $tmp_settings;
251

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

267
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
268
269
270
271
272
273
274

    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; });
275
276
277
    $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; });
278
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
279
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit(); });
280
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
281

282
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
283
284
        -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
285
286
287
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
288
289
290
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
291
        -loglevel          => $loglevel
292
293
      );

294
295
296
297
298
299
300
    # Needs to happen after instatiation of FIJITestsViewer due to uart_complete
    $self->{'ctrl'} = _ctrl_frame($self, $mw);

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

303
304
305
    $mw->deiconify();
    $mw->raise();
    $mw->update();
Christian Fibich's avatar
Christian Fibich committed
306

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

323
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
324

Christian Fibich's avatar
Christian Fibich committed
325
  bailout:
326
327
    $self->_cleanup();

328
    $logger->info("=== Stopping execution ===");
329
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
330
331
}

332
333
334
335
336
sub _menu {
    my ($self, $mw) = @_;

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

337
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
338
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
339
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
340

341
342
    $self->{'export_menuentry'} = $export;

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

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

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

400
401
402
403
404
405
406
407
408
409
410
411
412
413
414

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

471
472
473
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
474
    return File::Spec->catpath($volume, $directories, "");
475
476
}

477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
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;
}

503
504
505
506
# 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
507
sub _load_settings_prompt {
508
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
509
    my ($self, $fr) = @_;
510
511
512
513

    my $tmp_settings;
    my $filename;

514
515
516
517
518
519
520
521
522
    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();
523

524
525
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
526
        return undef;
Christian Fibich's avatar
Christian Fibich committed
527
    }
528
    return $self->_load_settings($filename);
Christian Fibich's avatar
Christian Fibich committed
529
530
531
}

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

        # -expand => 1
      );

544
    ## FIJI Settings ##
545
546
547
548
549
    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
550
    )->grid(-row => 0, -column => 0, -sticky => "e");
551
552

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

557
558
559
560
561
562
563
564
    ## FIJI Tests ##
    my $cfg_lbl;
    my $chng_lbl;
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;

565
566
567
    $cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Tests file',
        -justify => 'left',
568
569
    )->grid(-row => 1, -column => 0, -sticky => "e");

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

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

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

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

608
609
610
    ## UART ##
    my $uart_row = 2;
    
Christian Fibich's avatar
Christian Fibich committed
611
    my $uart_label = $fr_ctrl->Label(
612
613
614
615
616
617
618
619
        -text    => 'UART',
        -justify => 'left',
    )->grid(
        '-row'    => $uart_row,
        '-column' => 0,
        '-sticky' => "e");

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

649
    return $fr_ctrl;
Christian Fibich's avatar
Christian Fibich committed
650
651
}

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

694
sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
695
696
    my $logger = get_logger("");
    my $self   = shift;
697

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

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

719
720
721
    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
722
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
723
                                               -wraplength => $self->{'mw'}->screenwidth,,
724
                                               -text      => $msg,
725
                                               -title     => 'Open FIJI Tests failed!',);
726
        $d->Show();
727
728
729
730
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
731
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
732
733
734
735
736
    # Re-attach UART selector to new hash
    $uart_complete->configure(
        '-choices' => FIJI::Utils::get_uart_devs(),
        '-textvariable' => \$self->{'tests'}->{'design'}->{'UART'},
    );
737
738
}

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

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

771
772
    $self->{'FIJITestsViewer'}->set_state_as_original();

773
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
774
775
776
}

sub _save {
777
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
778
    if (!defined(${$self->{'tests_ini_name'}})) {
779
780
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
781
        return $self->_save_file(${$self->{'tests_ini_name'}});
782
    }
Christian Fibich's avatar
Christian Fibich committed
783
784
785
}

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

Christian Fibich's avatar
Christian Fibich committed
801
    if (!defined($filename)) {
802
803
        return;
    }
804
    $current_dir = _setdir($filename);
805
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
806
807
}

808
sub _onexit {
809
    my $logger = get_logger("");
810
811
    my ($self) = @_;

812
813
814
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

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

826
827
828
829
        # 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
830
            goto finish;
831
832
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
833
        goto finish;
834
    }
Christian Fibich's avatar
Christian Fibich committed
835
836
837
    return;

finish:
838
839
840
841
842
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
843
    my $logger = get_logger("");
844
    my $self = shift;
845
    $self->{'mw'}->destroy() if Exists($self->{'mw'});
846

847
848
849
    # 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
850
851
    $queue_to_worker->end();
    $queue_to_gui->end();
852
    $logger->remove_appender("queueAppender", 0, 1);
853
    $log_queue->end();
854
    $worker_tid->join();
855
856
}

857
858
FIJI::Utils::log_start(1, 0, @ARGV);
exit main();
859
860
861
862
863
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

__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