fiji_ee_gui.pl 29.4 KB
Newer Older
Christian Fibich's avatar
Christian Fibich committed
1
2
3
4
5
6
7
8
9
10
11
12
#-------------------------------------------------------------------------------
#  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:
#
13
#  FIJI Execution Engine GUI
Christian Fibich's avatar
Christian Fibich committed
14
15
16
#
#-------------------------------------------------------------------------------

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

Christian Fibich's avatar
Christian Fibich committed
22
23
24
use strict;
use warnings;

25
26
27
use FindBin;
use lib "$FindBin::Bin";

Christian Fibich's avatar
Christian Fibich committed
28
29
use Log::Log4perl qw(get_logger);
use Tk;
30
use Tk::widgets qw(LabFrame Label Entry Button DialogBox FBox Checkbutton);
Stefan Tauner's avatar
Stefan Tauner committed
31
use Tk::FIJIUtils;
32
use Tk::FIJIModalDialog;
Christian Fibich's avatar
Christian Fibich committed
33
34
use Clone qw(clone);
use File::Spec;
35
use FIJI::Utils;
Christian Fibich's avatar
Christian Fibich committed
36
37
38
39
use threads;
use threads::shared;
use Thread::Queue;
use Data::Dumper;
40
41
use Socket;
use IO::Handle;
42
use Getopt::Long;
Christian Fibich's avatar
Christian Fibich committed
43

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

50
use FIJI qw(:default :fiji_dir :fiji_documentation_path);
Christian Fibich's avatar
Christian Fibich committed
51
52
53
use FIJI::Tests;
use FIJI::Downloader;
use Tk::FIJITestsViewer;
54
use Tk::FIJIUtils;
Christian Fibich's avatar
Christian Fibich committed
55

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

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

66
67
68
69
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', '*']];

70
use constant APPNAME => 'FIJI Execution Engine';
71

72
73
74
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
75
my $worker_tid;
Christian Fibich's avatar
Christian Fibich committed
76
my $downloader;
77
my $unsaved_changes = 0;
Christian Fibich's avatar
Christian Fibich committed
78

79
80
my $current_dir = ".";

81
82
83
84
85
86
87
88
89
90
my $usage=<<"END_USAGE";
Usage: $0 [OPTION]
The graphical FIJI Tests Editor and Download Tool

Optional command-line arguments:
   -s, --settings-file=FILE    load the given settings file at startup
   -t, --tests-file=FILE       load the given test pattern file at startup
   -h, --help                  display this help and exit
END_USAGE

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

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
        my $file_appender   = $Log::Log4perl::Logger::APPENDER_BY_NAME{'screen'};
        my $custom_appender = Log::Log4perl::Appender->new(
            "Log::Dispatch::QueueAppender",
            name      => "queueAppender",
            threshold => "info",
            queue     => $log_queue,
        );
        my $layout = $file_appender->{'layout'};
        $custom_appender->layout(clone($layout));
        $logger->add_appender($custom_appender);

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

        # 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(
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
                        $queue_to_gui->enqueue({state => "ongoing", rmsg => $worker_msg});
                        return $cont;
                    }
                );
            } elsif ($item->{'mode'} eq "random") {
                $worker_msg = $dl->download_random(
                    \$testref,
                    $item->{'uart'},
                    sub {
                        my $worker_msg = shift;

                        # reply to GUI (intermediate)
                        $queue_to_gui->enqueue({state => "ongoing", rmsg => $worker_msg});
                        return $cont;
                    }
                );
            } elsif ($item->{'mode'} eq "manual") {
                $worker_msg = $dl->download_test($item->{'test'}, $item->{'uart'});
            } elsif ($item->{'mode'} eq "dryrun") {
                $worker_msg = $dl->get_fic_status($item->{'uart'});
            }

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

171

Christian Fibich's avatar
Christian Fibich committed
172

173
174
sub _indicate_changes {
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
175
176
    my $self   = shift;
    my $set    = shift;
177
178
    $unsaved_changes = $set;

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

188
189


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

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
    my ($settings_filename, $tests_filename, $help);

    my $parse = GetOptions("settings-file=s" => \$settings_filename,
                           "tests-file=s"    => \$tests_filename,
                           "help"            => \$help);

    if (!$parse) {
        print STDERR $usage;
        return -1;
    }
    if (defined $help) {
        print STDOUT $usage;
        return 0;
    }

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

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

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

Christian Fibich's avatar
Christian Fibich committed
225
    $worker_tid = threads->create('download_worker');
226

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

    ### Load settings

241
242
    if (defined $settings_filename && (-e $settings_filename)) {
        my $filename = $settings_filename;
243
244
        my ($tmp_settings, $warn) = FIJI::Settings->new('setup', $filename);
        if (defined($warn)) {
245
246
            my $msg = "settings file $filename could not be loaded correctly: $tmp_settings";
            $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
247
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
248
                                                   -wraplength => "200",
249
                                                   -text      => $warn,
250
251
                                                   -title     => 'Open FIJI Settings failed!',
                                                   -buttons   => ["OK"]);
252
            $d->Show();
253
254
255
256
            if (!defined($tmp_settings)) {
                $ret = 1;
                goto bailout;
            }
257
        }
258
        $self->{'settings'} = $tmp_settings;
Christian Fibich's avatar
Christian Fibich committed
259
        ${$self->{'settings_ini_name'}} = $filename;
260
        $current_dir = _setdir($filename);
Christian Fibich's avatar
Christian Fibich committed
261
    } else {
Christian Fibich's avatar
Christian Fibich committed
262
        ${$self->{'settings_ini_name'}} = $self->_load_settings_prompt($mw);
263
264
    }

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

271
272
    if (defined $tests_filename) {
        my $filename = $tests_filename;
273
        my $fr       = $mw;
Christian Fibich's avatar
Christian Fibich committed
274
        if (-e $filename) {
275
276
            # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
            my $tmp_tests = FIJI::Tests->new('GUI', $self->{'settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'settings'}->{'design'}->{'FIU_NUM'}, $filename,);
Christian Fibich's avatar
Christian Fibich committed
277
            if (!ref($tmp_tests)) {
278
279
                my $msg = "Tests file $filename could not be loaded correctly: $tmp_tests";
                $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
280
                my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
281
282
283
284
                                                       -wraplength => "200",
                                                       -text      => $msg,
                                                       -title     => 'Open FIJI Tests failed!',
                                                       -buttons   => ["OK"]);
285
                $d->Show();
286
287
                $ret = 1;
                goto bailout;
288
289
290
            }
            $self->{'tests'} = $tmp_tests;
        } else {
291
292
            # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
            $self->{'tests'} = FIJI::Tests->new('GUI', $self->{'settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'settings'}->{'design'}->{'FIU_NUM'}, undef, undef, 1);
293
294
            $self->{'tests'}->save($filename);
        }
Christian Fibich's avatar
Christian Fibich committed
295
        ${$self->{'tests_ini_name'}} = $filename;
296
        $current_dir = _setdir($filename);
297
    } else {
298
299
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
        $self->{'tests'} = FIJI::Tests->new('GUI', $self->{'settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'settings'}->{'design'}->{'FIU_NUM'}, undef, undef, 1);
Christian Fibich's avatar
Christian Fibich committed
300
        ${$self->{'tests_ini_name'}} = undef;
301
302
    }

303
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
Christian Fibich's avatar
Christian Fibich committed
304
    $self->{'ctrl'} = _ctrl_frame($self, $mw);
305
306
307
308
309
310
311

    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; });
312
313
314
    $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; });
315
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
316
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit(); });
317
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
318

319
    $self->{'documentation_path'} = File::Spec->catfile($ugdir, 'fiji_user_guide.pdf');
320
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
321
322
        -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")},
323
        -mw               => $self->{'mw'},
Christian Fibich's avatar
Christian Fibich committed
324
325
326
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
327
328
329
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
330
331
332
333
334
      )->pack(
        '-fill'   => 'both',
        '-expand' => 1
      );

335
    $mw->protocol('WM_DELETE_WINDOW' => [\&_onexit, $self]);
336

337
338
339
    $mw->deiconify();
    $mw->raise();
    $mw->update();
Christian Fibich's avatar
Christian Fibich committed
340

341
342
343
344
345
346
    # 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
347
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
348
349
350
351
352
353
354
355
356
357
                                                   -wraplength => "400",
                                                   -text      => $worker_msg->{'rmsg'},
                                                   -title     => 'Starting the download worker thread failed!',
                                                   -buttons   => ["OK"]);
            $d->Show();
            $self->{'FIJITestsViewer'}->{'mw'}->destroy();
            $ret = 1;
        }
    });

358
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
359

Christian Fibich's avatar
Christian Fibich committed
360
  bailout:
361
362
    $self->_cleanup();

363
    $logger->trace("=== Stopping execution ===");
364
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
365
366
}

367
368
369
370
371
sub _menu {
    my ($self, $mw) = @_;

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

372
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
373
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
374
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
375

376
377
    $self->{'export_menuentry'} = $export;

378
379
    $tests->separator;
    $tests->command(
380
381
382
383
384
        -label       => 'Open',
        -accelerator => 'Ctrl-o',
        -underline   => 0,
        -command     => [\&_open_tests_file, $self],
    );
385
386
    $tests->separator;
    $tests->command(
387
388
389
390
391
        -label       => 'Save',
        -accelerator => 'Ctrl-s',
        -underline   => 0,
        -command     => [\&_save, $self],
    );
392
    $tests->command(
393
394
395
396
397
398
        -label       => 'Save As ...',
        -accelerator => 'Ctrl-Shift-s',
        -underline   => 1,
        -command     => [\&_save_as, $self],
    );

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
    $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',
        -accelerator => 'Ctrl+r',
        -underline   => '0',
        -command     => [\&_export_gate_level_sim, $self],
    );

419
420
421
422
423
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
424
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
425
426
427
428
429
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
430
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
431
432
433
434
    );
    $mw->configure(-menu => $menubar);
}

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449

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

509
510
511
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
512
    return File::Spec->catpath($volume, $directories, "");
513
514
}

Christian Fibich's avatar
Christian Fibich committed
515
sub _load_settings_prompt {
516
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
517
    my ($self, $fr) = @_;
518
519
520
521
522
523
524
525

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

    my $tmp_settings;
    my $filename;

Christian Fibich's avatar
Christian Fibich committed
526
    while (!ref($tmp_settings)) {
Stefan Tauner's avatar
Stefan Tauner committed
527
        my $fb = $fr->FBox(
528
529
            -type        => 'open',
            -title       => 'Open FIJI Configuration file',
530
            -filetypes   => SETTINGS_FILE_TYPES_CFG,
531
            -initialdir  => $current_dir,
532
            -initialfile => 'fiji.cfg'
Stefan Tauner's avatar
Stefan Tauner committed
533
534
535
        );
        Tk::FIJIUtils::set_icon($fb);
        $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
536

Christian Fibich's avatar
Christian Fibich committed
537
        if (!defined($filename)) {
538
539
540
            $logger->debug("User aborted open configuration action");
            return;
        }
541
542
        $current_dir = _setdir($filename);

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

558
559
    $self->{'settings'} = $tmp_settings;
    return $filename;
Christian Fibich's avatar
Christian Fibich committed
560
561
562
}

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

        # -expand => 1
      );

    my $fiji_cfg_lbl;
    my $fiji_cfg_entry;
    my $cfg_lbl;
578
    my $chng_lbl;
579
580
581
582
583
584
585
586
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $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

    $cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Tests file',
        -justify => 'left',
597
598
    )->grid(-row => 1, -column => 0, -sticky => "e");

599
    $self->{'change_label'} = $chng_lbl = $fr_ctrl->Label(
Stefan Tauner's avatar
Stefan Tauner committed
600
        -image => Tk::FIJIUtils::dummy_image($self->{'mw'}),
601
    )->grid(-row => 1, -column => 1, -sticky => "we");
602
603

    my $b = $fr_ctrl->Balloon();
Christian Fibich's avatar
Christian Fibich committed
604
    $b->attach($chng_lbl, -postcommand => sub { return $unsaved_changes == 1 }, -msg => "Unsaved changes");
605

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

    $cfg_entry = $fr_ctrl->Entry(
630
        -textvariable       => $self->{'tests_ini_name'},
631
632
        -state              => 'disabled',
        -disabledforeground => 'black',
Christian Fibich's avatar
Christian Fibich committed
633
        -takefocus          => 0,                           # default for disabled
634
635
    )->grid(-row => 1, -column => 5, -sticky => "ew");
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
636
637

    return $fr_ctrl;
Christian Fibich's avatar
Christian Fibich committed
638
639
}

640
sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
641
642
    my $logger = get_logger("");
    my $self   = shift;
643

Stefan Tauner's avatar
Stefan Tauner committed
644
    my $fb = $self->{'mw'}->FBox(
645
646
647
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
648
        -initialdir  => $current_dir,
649
        -initialfile => 'fiji.tst'
Stefan Tauner's avatar
Stefan Tauner committed
650
651
652
653
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

654
655
656
657
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
658
    $current_dir = _setdir($filename);
659
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
660
    $tmp_tests = FIJI::Tests->new('GUI', $self->{'settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'settings'}->{'design'}->{'FIU_NUM'}, $filename, $tmp_tests);
661
662
663
    if (!ref($tmp_tests)) {
        my $msg = "tests file $filename could not be loaded correctly: $tmp_tests";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
664
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
665
666
667
668
                                               -wraplength => "200",
                                               -text      => $msg,
                                               -title     => 'Open FIJI Tests failed!',
                                               -buttons   => ["OK"]);
669
        $d->Show();
670
671
672
673
674
        return;
    }
    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
675
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
676
677
678
679
                                               -wraplength => "200",
                                               -text      => $msg,
                                               -title     => 'Open FIJI Tests failed!',
                                               -buttons   => ["OK"]);
680
        $d->Show();
681
682
683
684
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
685
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
686
687
}

Christian Fibich's avatar
Christian Fibich committed
688
sub _overwrite_existing_file ($) {
Christian Fibich's avatar
Christian Fibich committed
689
    my ($self, $filename) = @_;
690
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
691
    if (!-e $filename) {
692
693
        return 1;
    }
694
    my $d = $self->{'mw'}->FIJIModalDialog(-title     => 'Really overwrite?',
Stefan Tauner's avatar
Stefan Tauner committed
695
                                           -image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
696
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
697
                                           -buttons   => ["~Yes", "~No"]);
698
    my $reply = $d->Show();
699
    return (defined $reply && lc($reply) eq 'yes');
Christian Fibich's avatar
Christian Fibich committed
700
701
702
}

sub _save_file {
Christian Fibich's avatar
Christian Fibich committed
703
    my ($self, $filename) = @_;
704
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
705
    if (!$self->_overwrite_existing_file($filename)) {
706
707
708
        return;
    }
    my $err = $self->{'tests'}->save($filename);
Christian Fibich's avatar
Christian Fibich committed
709
    if (defined($err)) {
710
711
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
712
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
713
714
715
                                               -text        => $msg,
                                               -title       => 'Save failed!',
                                               -buttons     => ["OK"]);
716
        $d->Show();
717
718
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
719
    ${$self->{'tests_ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
720

721
722
    $self->{'FIJITestsViewer'}->set_state_as_original();

723
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
724
725
726
}

sub _save {
727
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
728
    if (!defined(${$self->{'tests_ini_name'}})) {
729
730
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
731
        return $self->_save_file(${$self->{'tests_ini_name'}});
732
    }
Christian Fibich's avatar
Christian Fibich committed
733
734
735
}

sub _save_as {
736
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
737
    my $fb = $self->{'mw'}->FBox(
738
        -type             => 'save',
739
        -title            => 'Save FIJI Tests file as...',
740
        -defaultextension => 'cfg',
741
        -filetypes        => TESTS_FILE_TYPES_CFG,
742
        -initialdir       => $current_dir,
743
744
745
746
        -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
747
748
749
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
750

Christian Fibich's avatar
Christian Fibich committed
751
    if (!defined($filename)) {
752
753
        return;
    }
754
    $current_dir = _setdir($filename);
755
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
756
757
}

758
sub _onexit {
759
    my $logger = get_logger("");
760
761
    my ($self) = @_;

762
763
764
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

765
    my $response;
766
    if ($unsaved_changes == 1) {
767
        $logger->debug("Settings changed. Asking to save.");
Stefan Tauner's avatar
Stefan Tauner committed
768
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
769
770
771
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
                                               -wraplength  => 350,
                                               -title       => 'Really quit?',
772
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
773
774
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
Christian Fibich's avatar
Christian Fibich committed
775

776
777
778
779
        # 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
780
            goto finish;
781
782
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
783
        goto finish;
784
    }
Christian Fibich's avatar
Christian Fibich committed
785
786
787
    return;

finish:
788
789
790
791
792
793
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
    my $self = shift;
794
    $self->{'mw'}->destroy() if Exists($self->{'mw'});
795

796
797
798
    # 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
799
800
801
    $queue_to_worker->end();
    $queue_to_gui->end();
    $log_queue->end();
802
    $worker_tid->join();
803
804
}

805
806
my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
Christian Fibich's avatar
Christian Fibich committed
807
exit main(@ARGV);