fiji_ee_gui.pl 30.5 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);
Christian Fibich's avatar
Christian Fibich committed
46

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

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

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

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

69
70
71
72
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', '*']];

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

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

83
84
my $current_dir = ".";

Stefan Tauner's avatar
Stefan Tauner committed
85
86
87
88
89
90
91
92
93
sub usage {
    my ($err) = @_;
    $err = 0 if !defined($err);
    my $scr = basename($0);
    my $msg = <<USAGE;

$scr is the graphical FIJI Tests Editor and Execution Engine

Usage: $scr [PARAMETERS]
94
95

Optional command-line arguments:
Stefan Tauner's avatar
Stefan Tauner committed
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

    -s, --settings=<filename> FIJI Settings file

    -t, --tests=<filename>    FIJI Tests file

    -v, --verbose             Increase verbosity of output
                              (can be given multiple times to increase
                               the verbosity level once per occurrence).

    -h, --help                Display this help and exit
USAGE
    if ($err == 0) {
        print STDOUT $msg;
    } else {
        print STDERR $msg;
    }
    return $err;
}

115

116
117
118
119
#** @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
120
121
122
# 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.
123
124
# 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
125
sub download_worker {
126
    my $logger = get_logger("");
127
    my $loglevel = shift;
128
    eval {
129
130
131
        my $cont = 1;
        $SIG{'STOP'} = sub { $cont = 0; };

132
        $queue_to_gui->enqueue({'state' => "starting"});
133

134
135
136
137
        # 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...
138
        Tk::FIJITestsViewer::append_logger($log_queue, $loglevel);
139

140
141
142
143
144
145
146
147
148
149
        # 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(
150
                    \$cont,
151
152
153
154
155
156
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
157
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg});
158
                        return $cont;
159
                    },
160
161
162
                );
            } elsif ($item->{'mode'} eq "random") {
                $worker_msg = $dl->download_random(
163
                    \$cont,
164
165
166
167
168
169
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
170
                        $queue_to_gui->enqueue({'state' => "ongoing", 'rmsg' => $worker_msg});
171
                        return $cont;
172
                    },
173
174
                );
            } elsif ($item->{'mode'} eq "manual") {
175
                $worker_msg = $dl->download_test(
176
                    \$cont,
177
178
179
                    $item->{'test'},
                    $item->{'uart'},
                );
180
            } elsif ($item->{'mode'} eq "dryrun") {
181
                $worker_msg = $dl->get_fic_status(\$cont, $item->{'uart'});
182
183
184
            }

            # reply to GUI (last message of current work package)
185
            $queue_to_gui->enqueue({'state' => "finished", 'rmsg' => $worker_msg, 'testref' => $testref});
Christian Fibich's avatar
Christian Fibich committed
186
        }
187
188
189
190
191
192
    };
    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'"
193
        $queue_to_gui->enqueue({'state' => "dying", 'rmsg' => (split /\n/, $@)[0]});
194
    }
Christian Fibich's avatar
Christian Fibich committed
195
196
}

197

Christian Fibich's avatar
Christian Fibich committed
198

199
200
sub _indicate_changes {
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
201
    my $self   = shift;
202
    $unsaved_changes = shift;
203
    return if (!defined($self->{'change_label'}));
204

Christian Fibich's avatar
Christian Fibich committed
205
    if ($unsaved_changes == 1) {
Stefan Tauner's avatar
Stefan Tauner committed
206
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
Christian Fibich's avatar
Christian Fibich committed
207
        $self->{'mw'}->configure(-title => "*" . APPNAME);
208
    } else {
Stefan Tauner's avatar
Stefan Tauner committed
209
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
210
211
212
        $self->{'mw'}->configure(-title => APPNAME);
    }
}
213

214
215


Christian Fibich's avatar
Christian Fibich committed
216
sub main {
217
    my $logger = get_logger("");
218
219
    my $name   = $0;
    my @ARGV   = @_;
Stefan Tauner's avatar
Stefan Tauner committed
220
221
    my $ret    = 0;
    my $verbosity_delta = 0;
222
223
    $name =~ s/\.p[lm]//;
    $logger->debug("=== Starting new execution of $name ===");
Christian Fibich's avatar
Christian Fibich committed
224
    $logger->debug(sprintf("%d argument(s)%s", scalar(@_), scalar(@_) > 0 ? ": @_" : ""));
225

226
227
    my ($settings_filename, $tests_filename, $help);

Stefan Tauner's avatar
Stefan Tauner committed
228
229
    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "t|tests=s"    => \$tests_filename,
Stefan Tauner's avatar
Stefan Tauner committed
230
                           "v|verbose+"   => \$verbosity_delta,
Stefan Tauner's avatar
Stefan Tauner committed
231
                           "h|help"       => \$help);
232

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

Stefan Tauner's avatar
Stefan Tauner committed
235
236
    return usage(1) if (!$parse);
    return usage() if (defined $help);
237

238
    # Create heavy thread as soon as possible
239
    $worker_tid = threads->create('download_worker',$loglevel);
240

241
    my %hash;
Christian Fibich's avatar
Christian Fibich committed
242
    my $self = bless(\%hash);
243

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

247
248
    my $tests_ini_name;
    $self->{'tests_ini_name'} = \$tests_ini_name;
249
    my $settings_ini_name;
250
    $self->{'settings_ini_name'} = \$settings_ini_name;
251

252
253
254
255
256
257
258
    #
    # 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);
259
    $self->{'mw'} = $mw;
260
    $mw->appname(APPNAME);
261
    $mw->withdraw();
262
    Tk::FIJIUtils::set_icon($mw);
263
264
265

    ### Load settings

266
    if (defined $settings_filename) {
267
        my $filename = $settings_filename;
268
        my ($tmp_settings, $warn) = FIJI::Settings->new('download', $filename);
269
        if (defined($warn)) {
270
271
            my $msg = "Settings file $filename could not be loaded correctly.\n$warn";
            $logger->error($msg) if !$tmp_settings;
Stefan Tauner's avatar
Stefan Tauner committed
272
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
273
                                                   -wraplength => "200",
274
                                                   -text      => $msg,
275
                                                   -title     => 'Open FIJI Settings failed!',
276
                                                  );
277
            $d->Show();
278
279
280
281
            if (!defined($tmp_settings)) {
                $ret = 1;
                goto bailout;
            }
282
        }
283
        $self->{'settings'} = $tmp_settings;
Christian Fibich's avatar
Christian Fibich committed
284
        ${$self->{'settings_ini_name'}} = $filename;
285
        $current_dir = _setdir($filename);
Christian Fibich's avatar
Christian Fibich committed
286
    } else {
Christian Fibich's avatar
Christian Fibich committed
287
        ${$self->{'settings_ini_name'}} = $self->_load_settings_prompt($mw);
288
289
    }

Christian Fibich's avatar
Christian Fibich committed
290
    if (!defined ${$self->{'settings_ini_name'}}) {
291
        $logger->error("No settings file chosen");
292
293
        $ret = 1;
        goto bailout;
Christian Fibich's avatar
Christian Fibich committed
294
    }
295

296
    my $tmp_tests;
Christian Fibich's avatar
Christian Fibich committed
297
    unless (defined($tests_filename) && defined ($tmp_tests = $self->_read_tests_file($tests_filename))) {
298
299
300
        # Create one with defaults
        $logger->info("No test file given. Creating one with defaults.");
        my $warn;
301
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
302
303
304
305
306
307
        ($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;
308
    }
309
    $self->{'tests'} = $tmp_tests;
310

311
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
312
313
314
315
316
317
318

    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; });
319
320
321
    $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; });
322
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
323
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit(); });
324
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
325

326
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
327
328
        -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")},
329
        -mw               => $self->{'mw'},
Christian Fibich's avatar
Christian Fibich committed
330
331
332
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
333
334
335
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
336
        -loglevel          => $loglevel
337
338
      );

339
340
341
342
343
344
345
    # Needs to happen after instatiation of FIJITestsViewer due to uart_complete
    $self->{'ctrl'} = _ctrl_frame($self, $mw);

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

348
349
350
    $mw->deiconify();
    $mw->raise();
    $mw->update();
Christian Fibich's avatar
Christian Fibich committed
351

352
353
354
355
356
357
    # 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
358
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
359
360
                                                   -wraplength => "400",
                                                   -text      => $worker_msg->{'rmsg'},
361
                                                   -title     => 'Starting the download worker thread failed!',);
362
363
364
365
366
367
            $d->Show();
            $self->{'FIJITestsViewer'}->{'mw'}->destroy();
            $ret = 1;
        }
    });

368
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
369

Christian Fibich's avatar
Christian Fibich committed
370
  bailout:
371
372
    $self->_cleanup();

373
    $logger->trace("=== Stopping execution ===");
374
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
375
376
}

377
378
379
380
381
sub _menu {
    my ($self, $mw) = @_;

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

382
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
383
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
384
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
385

386
387
    $self->{'export_menuentry'} = $export;

388
389
    $tests->separator;
    $tests->command(
390
        -label       => 'Open',
391
        -accelerator => 'Ctrl+o',
392
393
394
        -underline   => 0,
        -command     => [\&_open_tests_file, $self],
    );
395
396
    $tests->separator;
    $tests->command(
397
        -label       => 'Save',
398
        -accelerator => 'Ctrl+s',
399
400
401
        -underline   => 0,
        -command     => [\&_save, $self],
    );
402
    $tests->command(
403
        -label       => 'Save As ...',
404
        -accelerator => 'Ctrl+Shift+s',
405
406
407
408
        -underline   => 1,
        -command     => [\&_save_as, $self],
    );

409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
    $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',
424
        -accelerator => 'Ctrl+g',
425
426
427
428
        -underline   => '0',
        -command     => [\&_export_gate_level_sim, $self],
    );

429
430
431
432
433
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
434
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
435
436
437
438
439
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
440
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
441
442
443
444
    );
    $mw->configure(-menu => $menubar);
}

445
446
447
448
449
450
451
452
453
454
455
456
457
458
459

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
460
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
461
                                                       -text        => $rv,
462
                                                       -title       => "Error saving tests.",);
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
                $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
483
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
484
                                                       -text        => $rv,
485
                                                       -title       => "Error FIJI simulation model for gate-level simulation.",);
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
                $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
506
                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
507
                                                       -text        => $rv,
508
                                                       -title       => "Error saving RTL simulation templates.",);
509
510
511
512
513
514
515
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

516
517
518
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
519
    return File::Spec->catpath($volume, $directories, "");
520
521
}

Christian Fibich's avatar
Christian Fibich committed
522
sub _load_settings_prompt {
523
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
524
    my ($self, $fr) = @_;
525
526
527
528
529
530
531
532

    my $gcfg_lbl;
    my $gcfg_btn_open;
    my $gcfg_entry;

    my $tmp_settings;
    my $filename;

Christian Fibich's avatar
Christian Fibich committed
533
    while (!ref($tmp_settings)) {
Stefan Tauner's avatar
Stefan Tauner committed
534
        my $fb = $fr->FBox(
535
536
            -type        => 'open',
            -title       => 'Open FIJI Configuration file',
537
            -filetypes   => SETTINGS_FILE_TYPES_CFG,
538
            -initialdir  => $current_dir,
539
            -initialfile => 'fiji.cfg'
Stefan Tauner's avatar
Stefan Tauner committed
540
541
542
        );
        Tk::FIJIUtils::set_icon($fb);
        $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
543

Christian Fibich's avatar
Christian Fibich committed
544
        if (!defined($filename)) {
545
546
547
            $logger->debug("User aborted open configuration action");
            return;
        }
548
549
        $current_dir = _setdir($filename);

Christian Fibich's avatar
Christian Fibich committed
550
        $tmp_settings = (defined $self->{'settings'}) ? \%{Clone::clone($self->{'settings'})} : undef;
551
552
553
        my $warn;
        ($tmp_settings, $warn) = FIJI::Settings->new('download', $filename, $tmp_settings);
        if (defined($warn)) {
554
            my $msg = "settings file $filename could not be loaded correctly: $warn";
555
            $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
556
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
557
                                                   -wraplength => "200",
558
                                                   -text      => $warn,
559
                                                   -title     => 'Open FIJI Settings failed!',);
560
            $d->Show();
561
        }
Christian Fibich's avatar
Christian Fibich committed
562
563
    }

564
565
    $self->{'settings'} = $tmp_settings;
    return $filename;
Christian Fibich's avatar
Christian Fibich committed
566
567
568
}

sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
569
    my ($self, $fr) = @_;
570
571
572
573
574
575
576
577
578
579
580
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

581
    ## FIJI Settings ##
582
583
584
585
586
    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
587
    )->grid(-row => 0, -column => 0, -sticky => "e");
588
589

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

594
595
596
597
598
599
600
601
    ## FIJI Tests ##
    my $cfg_lbl;
    my $chng_lbl;
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;

602
603
604
    $cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Tests file',
        -justify => 'left',
605
606
    )->grid(-row => 1, -column => 0, -sticky => "e");

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

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

614
615
616
617
    if (!defined USE_MENU || USE_MENU == 0) {
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
            -command => [\&_open_tests_file, $self],
618
        )->grid(-row => 1, -column => 2, -sticky => "ew");
619
620
621
622
623
624
625
626
627
628
629
        $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);
            # },
630
        )->grid(-row => 1, -column => 3, -sticky => "ew");
631
632
633
        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
            -command => [\&_save_as, $self],
634
        )->grid(-row => 1, -column => 4, -sticky => "ew");
635
    }
636
637

    $cfg_entry = $fr_ctrl->Entry(
638
        -textvariable       => $self->{'tests_ini_name'},
639
640
        -state              => 'disabled',
        -disabledforeground => 'black',
Christian Fibich's avatar
Christian Fibich committed
641
        -takefocus          => 0,                           # default for disabled
642
643
    )->grid(-row => 1, -column => 5, -sticky => "ew");
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
644

645
646
647
    ## UART ##
    my $uart_row = 2;
    
Christian Fibich's avatar
Christian Fibich committed
648
    my $uart_label = $fr_ctrl->Label(
649
650
651
652
653
654
655
656
        -text    => 'UART',
        -justify => 'left',
    )->grid(
        '-row'    => $uart_row,
        '-column' => 0,
        '-sticky' => "e");

    $uart_complete = $fr_ctrl->CompleteEntry();
Christian Fibich's avatar
Christian Fibich committed
657
    my $uart_button = $fr_ctrl->Button(
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
        -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
682
683
684
685
    for my $w ($uart_complete, $uart_button, $uart_label) {
        $balloon->attach($w, -balloonposition => 'mouse', -msg => TESTCONSTMAP->{'UART'}->{'help'});
    }

686
    return $fr_ctrl;
Christian Fibich's avatar
Christian Fibich committed
687
688
}

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
## @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) = @_;
    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'}),
                                                   -wraplength => "500",
                                                   -text      => $msg,
                                                   -title     => 'Open FIJI Tests failed!',);
            $d->Show();
            return undef;
        }
Christian Fibich's avatar
Christian Fibich committed
722
723
    } else {
        
724
725
726
727
728
729
    }
    ${$self->{'tests_ini_name'}} = $filename;
    $current_dir = _setdir($filename);
    return $tmp_tests;
}

730
sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
731
732
    my $logger = get_logger("");
    my $self   = shift;
733

Stefan Tauner's avatar
Stefan Tauner committed
734
    my $fb = $self->{'mw'}->FBox(
735
736
737
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
738
        -initialdir  => $current_dir,
739
        -initialfile => 'fiji.tst'
Stefan Tauner's avatar
Stefan Tauner committed
740
741
742
743
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

744
745
746
747
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
748
    $current_dir = _setdir($filename);
749
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
750
    $tmp_tests = $self->_read_tests_file($filename);
751
752
753
    if (!ref($tmp_tests)) {
        return;
    }
754

755
756
757
    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
758
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
759
760
                                               -wraplength => "200",
                                               -text      => $msg,
761
                                               -title     => 'Open FIJI Tests failed!',);
762
        $d->Show();
763
764
765
766
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
767
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
768
769
770
771
772
    # Re-attach UART selector to new hash
    $uart_complete->configure(
        '-choices' => FIJI::Utils::get_uart_devs(),
        '-textvariable' => \$self->{'tests'}->{'design'}->{'UART'},
    );
773
774
}

Christian Fibich's avatar
Christian Fibich committed
775
sub _overwrite_existing_file ($) {
Christian Fibich's avatar
Christian Fibich committed
776
    my ($self, $filename) = @_;
777
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
778
    if (!-e $filename) {
779
780
        return 1;
    }
781
    my $d = $self->{'mw'}->FIJIModalDialog(-title     => 'Really overwrite?',
Stefan Tauner's avatar
Stefan Tauner committed
782
                                           -image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
783
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
784
                                           -buttons   => ["~Yes", "~No"]);
785
    my $reply = $d->Show();
786
    return (defined $reply && lc($reply) eq 'yes');
Christian Fibich's avatar
Christian Fibich committed
787
788
789
}

sub _save_file {
Christian Fibich's avatar
Christian Fibich committed
790
    my ($self, $filename) = @_;
791
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
792
    if (!$self->_overwrite_existing_file($filename)) {
793
794
795
        return;
    }
    my $err = $self->{'tests'}->save($filename);
Christian Fibich's avatar
Christian Fibich committed
796
    if (defined($err)) {
797
798
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
799
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
800
                                               -text        => $msg,
801
                                               -title       => 'Save failed!',);
802
        $d->Show();
803
804
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
805
    ${$self->{'tests_ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
806

807
808
    $self->{'FIJITestsViewer'}->set_state_as_original();

809
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
810
811
812
}

sub _save {
813
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
814
    if (!defined(${$self->{'tests_ini_name'}})) {
815
816
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
817
        return $self->_save_file(${$self->{'tests_ini_name'}});
818
    }
Christian Fibich's avatar
Christian Fibich committed
819
820
821
}

sub _save_as {
822
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
823
    my $fb = $self->{'mw'}->FBox(
824
        -type             => 'save',
825
        -title            => 'Save FIJI Tests file as...',
826
        -defaultextension => 'tst',
827
        -filetypes        => TESTS_FILE_TYPES_CFG,
828
        -initialdir       => $current_dir,
829
830
831
832
        -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
833
834
835
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
836

Christian Fibich's avatar
Christian Fibich committed
837
    if (!defined($filename)) {
838
839
        return;
    }
840
    $current_dir = _setdir($filename);
841
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
842
843
}

844
sub _onexit {
845
    my $logger = get_logger("");
846
847
    my ($self) = @_;

848
849
850
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

851
    my $response;
852
    if ($unsaved_changes == 1) {
853
        $logger->debug("Settings changed. Asking to save.");
Stefan Tauner's avatar
Stefan Tauner committed
854
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
855
856
857
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
                                               -wraplength  => 350,
                                               -title       => 'Really quit?',
858
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
859
860
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
Christian Fibich's avatar
Christian Fibich committed
861

862
863
864
865
        # 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
866
            goto finish;
867
868
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
869
        goto finish;
870
    }
Christian Fibich's avatar
Christian Fibich committed
871
872
873
    return;

finish:
874
875
876
877
878
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
879
    my $logger = get_logger("");
880
    my $self = shift;
881
    $self->{'mw'}->destroy() if Exists($self->{'mw'});
882

883
884
885
    # 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
886
887
    $queue_to_worker->end();
    $queue_to_gui->end();
888
    $logger->remove_appender("queueAppender");
889
    $log_queue->end();
890
    $worker_tid->join();
891
892
}

893
894
my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
895
896
# We can get the buffered output from the log window
Log::Log4perl->eradicate_appender("string");
Christian Fibich's avatar
Christian Fibich committed
897
exit main(@ARGV);