fiji_download_gui.pl 31.6 KB
Newer Older
Christian Fibich's avatar
Christian Fibich committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#-------------------------------------------------------------------------------
#  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
#
#-------------------------------------------------------------------------------
#  File:              fiji_download_gui.pl
#  Created on:        25.08.2015
#  $LastChangedBy: fibich $
#  $LastChangedDate: 2015-09-03 18:43:32 +0200 (Don, 03 Sep 2015) $
#
#  Description:
#
#  FIJI download GUI
#
#-------------------------------------------------------------------------------

Christian Fibich's avatar
Christian Fibich committed
22
23
24
25
26
## @file
# @brief FIJI download script (GUI)
## @file
# A TK GUI application to download predefined, manually entered, and random tests

Christian Fibich's avatar
Christian Fibich committed
27
28
29
use strict;
use warnings;

30
31
32
use FindBin;
use lib "$FindBin::Bin";

Christian Fibich's avatar
Christian Fibich committed
33
34
use Log::Log4perl qw(get_logger);
use Tk;
35
use Tk::widgets qw(LabFrame Label Entry Button DialogBox FBox Checkbutton);
Christian Fibich's avatar
Christian Fibich committed
36
use Tk::PNG;
37
use Tk::FIJIModalDialog;
Christian Fibich's avatar
Christian Fibich committed
38
39
use Clone qw(clone);
use File::Spec;
40
use FIJI::Utils;
Christian Fibich's avatar
Christian Fibich committed
41
42
43
44
use threads;
use threads::shared;
use Thread::Queue;
use Data::Dumper;
45
46
use Socket;
use IO::Handle;
47
use Getopt::Long;
Christian Fibich's avatar
Christian Fibich committed
48

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

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

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

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

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

75
76
use constant APPNAME => 'FIJI Download Tool';

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

85
86
my $current_dir = ".";

87
88
89
90
91
92
93
94
95
96
97
98
99
100
my $error_image;
my $alert_image;
my $save_image;
my $dummy_image;
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

101
102
103
104
105
106
107
108
109
#** @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
# 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
# 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
110
111
sub download_worker {
    my $cont = 1;
112
    $SIG{'STOP'} = sub { $cont = 0; };
113
114
    my $logger = get_logger("");

Christian Fibich's avatar
Christian Fibich committed
115
    my $file_appender   = $Log::Log4perl::Logger::APPENDER_BY_NAME{'screen'};
116
    my $custom_appender = Log::Log4perl::Appender->new(
Christian Fibich's avatar
Christian Fibich committed
117
118
119
        "Log::Dispatch::QueueAppender",
        name      => "queueAppender",
        threshold => "info",
120
        queue     => $log_queue,
Christian Fibich's avatar
Christian Fibich committed
121
    );
122
123
124
125
126
    my $layout = $file_appender->{'layout'};
    $custom_appender->layout(clone($layout));
    $logger->add_appender($custom_appender);

    # forever, get new workload
127
    while (defined(my $item = $queue_to_worker->dequeue())) {
128
        my $dl      = $item->{'downloader'};
129
        my $testref = {};
Christian Fibich's avatar
Christian Fibich committed
130
        $cont = 1;
131
        my $worker_msg;
Christian Fibich's avatar
Christian Fibich committed
132

133
        # download tests according to mode
Christian Fibich's avatar
Christian Fibich committed
134
        if ($item->{'mode'} eq "auto") {
135
            $worker_msg = $dl->download_auto(
136
137
138
                \$testref,
                $item->{'uart'},
                sub {
139
                    my $worker_msg = shift;
Christian Fibich's avatar
Christian Fibich committed
140
141

                    # reply to GUI (intermediate)
142
                    $queue_to_gui->enqueue({state => "ongoing", rmsg => $worker_msg});
Christian Fibich's avatar
Christian Fibich committed
143
                    return $cont;
144
145
                }
            );
Christian Fibich's avatar
Christian Fibich committed
146
        } elsif ($item->{'mode'} eq "random") {
147
            $worker_msg = $dl->download_random(
148
149
150
                \$testref,
                $item->{'uart'},
                sub {
151
                    my $worker_msg = shift;
Christian Fibich's avatar
Christian Fibich committed
152
153

                    # reply to GUI (intermediate)
154
                    $queue_to_gui->enqueue({state => "ongoing", rmsg => $worker_msg});
Christian Fibich's avatar
Christian Fibich committed
155
                    return $cont;
156
157
                }
            );
Christian Fibich's avatar
Christian Fibich committed
158
        } elsif ($item->{'mode'} eq "manual") {
159
            $worker_msg = $dl->download_test($item->{'test'}, $item->{'uart'});
160
        } elsif ($item->{'mode'} eq "dryrun") {
161
            $worker_msg = $dl->get_fic_status($item->{'uart'});
Christian Fibich's avatar
Christian Fibich committed
162
        }
Christian Fibich's avatar
Christian Fibich committed
163

164
        # reply to GUI (last message of current work package)
165
        $queue_to_gui->enqueue({state => "finished", rmsg => $worker_msg, testref => $testref});
Christian Fibich's avatar
Christian Fibich committed
166
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
174
    my $self   = shift;
    my $set    = shift;
175
176
    $unsaved_changes = $set;

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

186
187


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

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    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;
    }

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

215
216
    my $libdir = File::Spec->catdir(FIJI_DIR, "lib");
    my $ugdir = File::Spec->catdir(FIJI_DIR, "docs", "userguide");
217

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

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

225
226
227
228
229
230
231
    #
    # 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);
232
    $self->{'mw'} = $mw;
233
    $mw->appname(APPNAME);
234
    $mw->withdraw();
Christian Fibich's avatar
Christian Fibich committed
235
    $error_image = $mw->Photo(-file => File::Spec->catfile($libdir, 'stop_48x48.xpm'),  -format => 'XPM');
236
    $alert_image = $mw->Photo(-file => File::Spec->catfile($libdir, 'alert_48x48.xpm'), -format => 'XPM');
Christian Fibich's avatar
Christian Fibich committed
237
238
    $save_image  = $mw->Photo(-file => File::Spec->catfile($libdir, 'save_24x24.xpm'),  -format => 'XPM');
    $dummy_image = $mw->Photo(-file => File::Spec->catfile($libdir, 'dummy_24x24.xpm'), -format => 'XPM');
239
240
    #### Set icon

241
    Tk::FIJIUtils::set_icon($mw, $libdir);
242
243
244

    ### Load settings

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

Christian Fibich's avatar
Christian Fibich committed
271
    if (!defined ${$self->{'settings_ini_name'}}) {
272
        $logger->error("No settings file chosen");
273
274
        $ret = 1;
        goto bailout;
Christian Fibich's avatar
Christian Fibich committed
275
    }
276

277
278
    if (defined $tests_filename) {
        my $filename = $tests_filename;
279
        my $fr       = $mw;
Christian Fibich's avatar
Christian Fibich committed
280
        if (-e $filename) {
281
282
            # 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
283
            if (!ref($tmp_tests)) {
284
285
                my $msg = "Tests file $filename could not be loaded correctly: $tmp_tests";
                $logger->error($msg);
286
287
288
289
290
291
292
                my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                                       -mw        => $self->{'mw'},
                                                       -image     => $error_image,
                                                       -wraplength => "200",
                                                       -text      => $msg,
                                                       -title     => 'Open FIJI Tests failed!',
                                                       -buttons   => ["OK"]);
293
                $d->Show();
294
295
                $ret = 1;
                goto bailout;
296
297
298
            }
            $self->{'tests'} = $tmp_tests;
        } else {
299
300
            # 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);
301
302
            $self->{'tests'}->save($filename);
        }
Christian Fibich's avatar
Christian Fibich committed
303
        ${$self->{'tests_ini_name'}} = $filename;
304
        $current_dir = _setdir($filename);
305
    } else {
306
307
        # 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
308
        ${$self->{'tests_ini_name'}} = undef;
309
310
    }

311
    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});
Christian Fibich's avatar
Christian Fibich committed
312
    $self->{'ctrl'} = _ctrl_frame($self, $mw);
313
314
315
316
317
318
319

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

327
    $self->{'documentation_path'} = File::Spec->catfile($ugdir, 'fiji_user_guide.pdf');
328
    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
329
330
        -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")},
331
332
        -mw               => $self->{'mw'},
        -delete_mw        => [\&_onexit, $self],
Christian Fibich's avatar
Christian Fibich committed
333
334
335
336
        -icon_path        => $libdir,
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
337
338
339
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
340
        -open_pdf_sub      => [\&_show_documentation, $self],
341
342
343
344
345
      )->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
    MainLoop;
Christian Fibich's avatar
Christian Fibich committed
353

Christian Fibich's avatar
Christian Fibich committed
354
355
  bailout:

356
357
    $self->_cleanup();

358
    $logger->trace("=== Stopping execution ===");
359
    return $ret;
Christian Fibich's avatar
Christian Fibich committed
360
361
}

362
363
364
365
366
sub _menu {
    my ($self, $mw) = @_;

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

367
    my $tests  = $menubar->cascade(-label => '~Tests', -tearoff => 0);
368
    my $export = $menubar->cascade(-label => '~Export', -tearoff => 0, -state=>"disabled");
369
    my $help   = $menubar->cascade(-label => '~Help',  -tearoff => 0);
370

371
372
    $self->{'export_menuentry'} = $export;

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

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
    $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],
    );

414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
        -command     => [\&_show_documentation, $self],
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
        -command   => sub {
            my $d = $mw->DialogBox(
                -title   => "About",
                -buttons => ["Close"]
            );
            my $t = $d->Scrolled('Text', -scrollbars => "oe", -width => 80, -height => 16);
            $t->pack(-fill => "both", -expand => 1);
            $t->Contents("fiji download");
            $t->configure(-state => "disabled");
            $d->Show();
        }
    );
    $mw->configure(-menu => $menubar);
}

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
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
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

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);

                my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                       -mw          => $self->{'mw'},
                                                       -image       => $error_image,
                                                       -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);
                my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                       -mw          => $self->{'mw'},
                                                       -image       => $error_image,
                                                       -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);
                my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => $self->{'delete_mw'},
                                                       -mw          => $self->{'mw'},
                                                       -image       => $error_image,
                                                       -text        => $rv,
                                                       -title       => "Error saving RTL simulation templates.",
                                                       -buttons     => [qw/OK/]);
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

520
521
522
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
523
    return File::Spec->catpath($volume, $directories, "");
524
525
}

Christian Fibich's avatar
Christian Fibich committed
526
sub _load_settings_prompt {
527
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
528
    my ($self, $fr) = @_;
529
530
531
532
533
534
535
536

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

    my $tmp_settings;
    my $filename;

Christian Fibich's avatar
Christian Fibich committed
537
    while (!ref($tmp_settings)) {
538
539
540
        $filename = $fr->FBox(
            -type        => 'open',
            -title       => 'Open FIJI Configuration file',
541
            -filetypes   => SETTINGS_FILE_TYPES_CFG,
542
            -initialdir  => $current_dir,
543
544
            -initialfile => 'fiji.cfg'
        )->Show();
Christian Fibich's avatar
Christian Fibich committed
545

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

Christian Fibich's avatar
Christian Fibich committed
552
        $tmp_settings = (defined $self->{'settings'}) ? \%{Clone::clone($self->{'settings'})} : undef;
553
554
555
556
        my $warn;
        ($tmp_settings, $warn) = FIJI::Settings->new('download', $filename, $tmp_settings);
        if (defined($warn)) {
            my $msg = "settings file $filename could not be loaded correctly: $tmp_settings";
557
            $logger->error($msg);
558
559
            my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                                   -mw        => $self->{'mw'},
560
                                                   -image     => (!defined($tmp_settings) ? $error_image : $alert_image),
561
                                                   -wraplength => "200",
562
563
                                                   -text      => $warn,
                                                   -title     => 'Open FIJI Settings failed!',
564
                                                   -buttons   => ["OK"]);
565
            $d->Show();
566
        }
Christian Fibich's avatar
Christian Fibich committed
567
568
    }

569
570
    $self->{'settings'} = $tmp_settings;
    return $filename;
Christian Fibich's avatar
Christian Fibich committed
571
572
573
}

sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
574
    my ($self, $fr) = @_;
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    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;
589
    my $chng_lbl;
590
591
592
593
594
595
596
597
    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
598
    )->grid(-row => 0, -column => 0, -sticky => "e");
599
600

    $fiji_cfg_entry = $fr_ctrl->Entry(
Christian Fibich's avatar
Christian Fibich committed
601
        -text  => ${$self->{'settings_ini_name'}},
602
        -state => 'readonly',
603
    )->grid(-row => 0, -column => 2, -columnspan => 4, -sticky => "ew");
604
605
606
607

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

610
    $self->{'change_label'} = $chng_lbl = $fr_ctrl->Label(
Christian Fibich's avatar
Christian Fibich committed
611
        -image => $dummy_image,
612
    )->grid(-row => 1, -column => 1, -sticky => "we");
613
614

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

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

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

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

651
652
653
sub _show_documentation {
    my $self = shift;
    my $mw   = $self->{'mw'};
654
    my $ret;
655
    if ($^O eq "MSWin32") {
656
        $ret = FIJI::Utils::system(1, "start " . FIJI_DOCUMENTATION_PATH);
657
    } elsif ($^O eq "linux") {
658
        $ret = FIJI::Utils::system("xdg-open " . FIJI_DOCUMENTATION_PATH);
659
    } else {
660
661
662
663
664
665
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                               -mw        => $self->{'mw'},
                                               -image     => $error_image,
                                               -text      => "No default PDF viewer for OS \"" . $^O . "\"...",
                                               -title     => "Open Documentation failed",
                                               -buttons   => ["OK"]);
666
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
667
        return;
668
    }
669
    if (defined($ret)) {
670
671
672
673
674
675
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                               -mw        => $self->{'mw'},
                                               -image     => $error_image,
                                               -text      => $ret,
                                               -title     => "Open Documentation failed",
                                               -buttons   => ["OK"]);
676
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
677
    }
678
679
680
}

sub _open_tests_file {
Christian Fibich's avatar
Christian Fibich committed
681
682
683
    my $logger = get_logger("");
    my $self   = shift;
    my $mw     = $self->{'mw'};
684
685
686
687
688

    my $filename = $mw->FBox(
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
689
        -initialdir  => $current_dir,
690
        -initialfile => 'fiji.tst'
691
692
693
694
695
    )->Show();
    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
696
    $current_dir = _setdir($filename);
697
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
698
    $tmp_tests = FIJI::Tests->new('GUI', $self->{'settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'settings'}->{'design'}->{'FIU_NUM'}, $filename, $tmp_tests);
699
700
701
    if (!ref($tmp_tests)) {
        my $msg = "tests file $filename could not be loaded correctly: $tmp_tests";
        $logger->error($msg);
702
703
704
705
706
707
708
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                               -mw        => $self->{'mw'},
                                               -image     => $error_image,
                                               -wraplength => "200",
                                               -text      => $msg,
                                               -title     => 'Open FIJI Tests failed!',
                                               -buttons   => ["OK"]);
709
        $d->Show();
710
711
712
713
714
        return;
    }
    if (!defined($self->{'FIJITestsViewer'}->configure(-tests => $tmp_tests))) {
        my $msg = "Could not update GUI correctly with new tests.";
        $logger->error($msg);
715
716
717
718
719
720
721
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                               -mw        => $self->{'mw'},
                                               -image     => $error_image,
                                               -wraplength => "200",
                                               -text      => $msg,
                                               -title     => 'Open FIJI Tests failed!',
                                               -buttons   => ["OK"]);
722
        $d->Show();
723
724
725
726
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
727
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
728
729
}

Christian Fibich's avatar
Christian Fibich committed
730
sub _overwrite_existing_file ($) {
Christian Fibich's avatar
Christian Fibich committed
731
    my ($self, $filename) = @_;
732
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
733
    if (!-e $filename) {
734
735
        return 1;
    }
736
737
738
739
740
741
    my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw => [\&_onexit, $self], 
                                           -mw        => $self->{'mw'},
                                           -image     => $alert_image,
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
                                           -title     => 'Really overwrite?',
                                           -buttons   => ["Yes", "No"]);
742
    my $reply = $d->Show();
743
    return (defined $reply && lc($reply) eq 'yes');
Christian Fibich's avatar
Christian Fibich committed
744
745
746
}

sub _save_file {
Christian Fibich's avatar
Christian Fibich committed
747
    my ($self, $filename) = @_;
748
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
749
    if (!$self->_overwrite_existing_file($filename)) {
750
751
752
        return;
    }
    my $err = $self->{'tests'}->save($filename);
Christian Fibich's avatar
Christian Fibich committed
753
    if (defined($err)) {
754
755
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
756
757
758
759
760
761
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => [\&_onexit, $self], 
                                               -mw          => $self->{'mw'},
                                               -image       => $error_image,
                                               -text        => $msg,
                                               -title       => 'Save failed!',
                                               -buttons     => ["OK"]);
762
        $d->Show();
763
764
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
765
    ${$self->{'tests_ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
766

767
768
    $self->{'FIJITestsViewer'}->set_state_as_original();

769
    $logger->info("Successfully saved to file $filename.");
Christian Fibich's avatar
Christian Fibich committed
770
771
772
}

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

sub _save_as {
782
783
784
    my ($self) = @_;
    my $filename = $self->{'mw'}->FBox(
        -type             => 'save',
785
        -title            => 'Save FIJI Tests file as...',
786
        -defaultextension => 'cfg',
787
        -filetypes        => TESTS_FILE_TYPES_CFG,
788
        -initialdir       => $current_dir,
789
790
791
792
        -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
Christian Fibich's avatar
Christian Fibich committed
793
794
    )->Show();

Christian Fibich's avatar
Christian Fibich committed
795
    if (!defined($filename)) {
796
797
        return;
    }
798
    $current_dir = _setdir($filename);
799
    return $self->_save_file($filename);
Christian Fibich's avatar
Christian Fibich committed
800
801
}

802
sub _onexit {
803
    my $logger = get_logger("");
804
805
806
    my ($self) = @_;

    my $mw = $self->{'mw'};
807

808
809
810
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

811
    my $response;
812
    if ($unsaved_changes == 1) {
813
814
815
816
817
818
819
        my $d = $self->{'mw'}->FIJIModalDialog(-delete_mw   => [\&_onexit, $self], 
                                               -mw          => $self->{'mw'},
                                               -image       => $alert_image,
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
                                               -wraplength  => 350,
                                               -title       => 'Really quit?',
                                               -buttons     => ["Save", "Cancel", "Quit"]);
820
821
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
822
        $logger->info("Settings changed. Asking to save.") if ($unsaved_changes == 1);
Christian Fibich's avatar
Christian Fibich committed
823

824
825
826
827
828
        # use _save_as to give the user the chance to save under a different name
        $self->_save_as if (defined $response && $response eq "Save");
        $logger->info("Save: " . (defined $response ? $response : "undef"));

        if (!defined $response || $response ne "Cancel") {
Christian Fibich's avatar
Christian Fibich committed
829
            goto finish;
830
831
        }
    } else {
Christian Fibich's avatar
Christian Fibich committed
832
        goto finish;
833
    }
Christian Fibich's avatar
Christian Fibich committed
834
835
836
    return;

finish:
837
838
839
840
841
842
843
844
845
    $delete_main = 0;
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
    my $self = shift;
    $self->{'mw'}->destroy() if $delete_main; # according to Mastering O'Reilly

846
847
848
    # 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
849
850
851
    $queue_to_worker->end();
    $queue_to_gui->end();
    $log_queue->end();
852
    #$worker_tid->join();
853
854
}

855
856
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
857
exit main(@ARGV);