fiji_ee_gui.pl

#!/usr/bin/env perl

#-------------------------------------------------------------------------------
#  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:
#
#  FIJI Execution Engine GUI
#
#-------------------------------------------------------------------------------

## @file
# @brief FIJI Execution Engine (GUI)
## @file
# A TK GUI application to execute predefined, manually entered, and random tests

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin";

use Log::Log4perl qw(get_logger);
use Tk;
use Tk::widgets qw(LabFrame Label Entry Button DialogBox FBox Checkbutton);
use Tk::FIJIUtils;
use Tk::FIJIModalDialog;
use Clone qw(clone);
use File::Spec;
use File::Basename qw(basename);
use FIJI::Utils;
use FIJI qw(UART TESTCONSTMAP);
use threads;
use threads::shared;
use Thread::Queue;
use Socket;
use IO::Handle;
use Getopt::Long qw(:config bundling);

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

use FIJI qw(:default :fiji_dir);
use FIJI::Tests;
use FIJI::Downloader;
use Tk::FIJITestsViewer;
use Tk::FIJIUtils;

use constant TESTS_FILE_TYPES_CFG => [
    ['FIJI Tests', ['.tst']],
    ['All files', '*'],
];

use constant SETTINGS_FILE_TYPES_CFG => [
    ['FIJI Settings', ['.cfg', '*.ini']],
    ['All files', '*'],
];

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', '*']];

use constant APPNAME => 'FIJI Execution Engine';

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
my $worker_tid;
my $downloader;
my $uart_complete;
my $unsaved_changes = 0;

my $current_dir = ".";

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]

Optional command-line arguments:

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


#** @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.
sub download_worker {
    my $logger = get_logger("");
    my $loglevel = shift;
    eval {
        my $cont = 1;
        $SIG{'STOP'} = sub { $cont = 0; };

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

        # 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...
        Tk::FIJITestsViewer::append_logger($log_queue, $loglevel);

        # 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(
                    \$cont,
                    \$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(
                    \$cont,
                    \$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(
                    \$cont,
                    $item->{'test'},
                    $item->{'uart'},
                );
            } elsif ($item->{'mode'} eq "dryrun") {
                $worker_msg = $dl->get_fic_status(\$cont, $item->{'uart'});
            }

            # reply to GUI (last message of current work package)
            $queue_to_gui->enqueue({'state' => "finished", 'rmsg' => $worker_msg, 'testref' => $testref});
        }
    };
    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'"
        $queue_to_gui->enqueue({'state' => "dying", 'rmsg' => (split /\n/, $@)[0]});
    }
}



sub _indicate_changes {
    my $logger = get_logger("");
    my $self   = shift;
    $unsaved_changes = shift;
    return if (!defined($self->{'change_label'}));

    if ($unsaved_changes == 1) {
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
        $self->{'mw'}->configure(-title => "*" . APPNAME);
    } else {
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
        $self->{'mw'}->configure(-title => APPNAME);
    }
}



sub main {
    my $logger = get_logger("");
    my $name   = $0;
    my @ARGV   = @_;
    my $ret    = 0;
    my $verbosity_delta = 0;
    $name =~ s/\.p[lm]//;
    $logger->debug("=== Starting new execution of $name ===");
    $logger->debug(sprintf("%d argument(s)%s", scalar(@_), scalar(@_) > 0 ? ": @_" : ""));

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

    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "t|tests=s"    => \$tests_filename,
                           "v|verbose+"   => \$verbosity_delta,
                           "h|help"       => \$help);

    my $loglevel = FIJI::Utils::increase_verbosity($verbosity_delta);

    return usage(1) if (!$parse);
    return usage() if (defined $help);

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

    my %hash;
    my $self = bless(\%hash);

    my $libdir = File::Spec->catdir(FIJI_DIR, "media");
    my $ugdir = File::Spec->catdir(FIJI_DIR, "docs", "userguide");

    my $tests_ini_name;
    $self->{'tests_ini_name'} = \$tests_ini_name;
    my $settings_ini_name;
    $self->{'settings_ini_name'} = \$settings_ini_name;

    #
    # 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);
    $self->{'mw'} = $mw;
    $mw->appname(APPNAME);
    $mw->withdraw();
    Tk::FIJIUtils::set_icon($mw);

    ### Load settings

    if (defined $settings_filename) {
        my $filename = $settings_filename;
        my ($tmp_settings, $warn) = FIJI::Settings->new('download', $filename);
        if (defined($warn)) {
            my $msg = "Settings file $filename could not be loaded correctly.\n$warn";
            $logger->error($msg) if !$tmp_settings;
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
                                                   -wraplength => "200",
                                                   -text      => $msg,
                                                   -title     => 'Open FIJI Settings failed!',
                                                  );
            $d->Show();
            if (!defined($tmp_settings)) {
                $ret = 1;
                goto bailout;
            }
        }
        $self->{'settings'} = $tmp_settings;
        ${$self->{'settings_ini_name'}} = $filename;
        $current_dir = _setdir($filename);
    } else {
        ${$self->{'settings_ini_name'}} = $self->_load_settings_prompt($mw);
    }

    if (!defined ${$self->{'settings_ini_name'}}) {
        $logger->error("No settings file chosen");
        $ret = 1;
        goto bailout;
    }

    my $tmp_tests;
    unless (defined($tests_filename) && defined ($tmp_tests = $self->_read_tests_file($tests_filename))) {
        # Create one with defaults
        $logger->info("No test file given. Creating one with defaults.");
        my $warn;
        # the mode 'GUI' is not defined in any ->phases_opt lists in TESTCONSTMAP and TESTPATMAP, thus all possible parameters have to be present.
        ($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;
    }
    $self->{'tests'} = $tmp_tests;

    $downloader = FIJI::Downloader->new(undef,undef,$self->{'tests'}, undef, $self->{'settings'});

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

    $self->{'FIJITestsViewer'} = $mw->FIJITestsViewer(
        -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")},
        -mw               => $self->{'mw'},
        -tests            => $self->{'tests'},
        -settings         => $self->{'settings'},
        -worker           => $worker_tid,
        -queue_to_worker  => $queue_to_worker,
        -queue_from_worker => $queue_to_gui,
        -log_queue         => $log_queue,
        -loglevel          => $loglevel
      );

    # Needs to happen after instatiation of FIJITestsViewer due to uart_complete
    $self->{'ctrl'} = _ctrl_frame($self, $mw);

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

    $mw->deiconify();
    $mw->raise();
    $mw->update();

    # 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") {
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                   -wraplength => "400",
                                                   -text      => $worker_msg->{'rmsg'},
                                                   -title     => 'Starting the download worker thread failed!',);
            $d->Show();
            $self->{'FIJITestsViewer'}->{'mw'}->destroy();
            $ret = 1;
        }
    });

    MainLoop;

  bailout:
    $self->_cleanup();

    $logger->trace("=== Stopping execution ===");
    return $ret;
}

sub _menu {
    my ($self, $mw) = @_;

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

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

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

    $tests->separator;
    $tests->command(
        -label       => 'Open',
        -accelerator => 'Ctrl+o',
        -underline   => 0,
        -command     => [\&_open_tests_file, $self],
    );
    $tests->separator;
    $tests->command(
        -label       => 'Save',
        -accelerator => 'Ctrl+s',
        -underline   => 0,
        -command     => [\&_save, $self],
    );
    $tests->command(
        -label       => 'Save As ...',
        -accelerator => 'Ctrl+Shift+s',
        -underline   => 1,
        -command     => [\&_save_as, $self],
    );

    $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+g',
        -underline   => '0',
        -command     => [\&_export_gate_level_sim, $self],
    );

    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
    );
    $mw->configure(-menu => $menubar);
}


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(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                       -text        => $rv,
                                                       -title       => "Error saving tests.",);
                $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(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                       -text        => $rv,
                                                       -title       => "Error FIJI simulation model for gate-level simulation.",);
                $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(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                       -text        => $rv,
                                                       -title       => "Error saving RTL simulation templates.",);
                $d->Show();
                return;
            }
        }
    } while (defined $name && defined $rv);
}

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

sub _load_settings_prompt {
    my $logger = get_logger("");
    my ($self, $fr) = @_;

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

    my $tmp_settings;
    my $filename;

    while (!ref($tmp_settings)) {
        my $fb = $fr->FBox(
            -type        => 'open',
            -title       => 'Open FIJI Configuration file',
            -filetypes   => SETTINGS_FILE_TYPES_CFG,
            -initialdir  => $current_dir,
            -initialfile => 'fiji.cfg'
        );
        Tk::FIJIUtils::set_icon($fb);
        $filename = $fb->Show();

        if (!defined($filename)) {
            $logger->debug("User aborted open configuration action");
            return;
        }
        $current_dir = _setdir($filename);

        $tmp_settings = (defined $self->{'settings'}) ? \%{Clone::clone($self->{'settings'})} : undef;
        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: $warn";
            $logger->error($msg);
            my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ? Tk::FIJIUtils::error_image($self->{'mw'}) : Tk::FIJIUtils::alert_image($self->{'mw'})),
                                                   -wraplength => "200",
                                                   -text      => $warn,
                                                   -title     => 'Open FIJI Settings failed!',);
            $d->Show();
        }
    }

    $self->{'settings'} = $tmp_settings;
    return $filename;
}

sub _ctrl_frame {
    my ($self, $fr) = @_;
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

    ## FIJI Settings ##
    my $fiji_cfg_lbl;
    my $fiji_cfg_entry;
    $fiji_cfg_lbl = $fr_ctrl->Label(
        -text    => 'FIJI Configuration file',
        -justify => 'left',
    )->grid(-row => 0, -column => 0, -sticky => "e");

    $fiji_cfg_entry = $fr_ctrl->Entry(
        -text  => ${$self->{'settings_ini_name'}},
        -state => 'readonly',
    )->grid(-row => 0, -column => 2, -columnspan => 4, -sticky => "ew");

    ## FIJI Tests ##
    my $cfg_lbl;
    my $chng_lbl;
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;

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

    $self->{'change_label'} = $chng_lbl = $fr_ctrl->Label(
        -image => Tk::FIJIUtils::dummy_image($self->{'mw'}),
    )->grid(-row => 1, -column => 1, -sticky => "we");

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

    if (!defined USE_MENU || USE_MENU == 0) {
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
            -command => [\&_open_tests_file, $self],
        )->grid(-row => 1, -column => 2, -sticky => "ew");
        $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);
            # },
        )->grid(-row => 1, -column => 3, -sticky => "ew");
        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
            -command => [\&_save_as, $self],
        )->grid(-row => 1, -column => 4, -sticky => "ew");
    }

    $cfg_entry = $fr_ctrl->Entry(
        -textvariable       => $self->{'tests_ini_name'},
        -state              => 'disabled',
        -disabledforeground => 'black',
        -takefocus          => 0,                           # default for disabled
    )->grid(-row => 1, -column => 5, -sticky => "ew");
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);

    ## UART ##
    my $uart_row = 2;
    
    my $uart_label = $fr_ctrl->Label(
        -text    => 'UART',
        -justify => 'left',
    )->grid(
        '-row'    => $uart_row,
        '-column' => 0,
        '-sticky' => "e");

    $uart_complete = $fr_ctrl->CompleteEntry();
    my $uart_button = $fr_ctrl->Button(
        -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'},
    );

    for my $w ($uart_complete, $uart_button, $uart_label) {
        $balloon->attach($w, -balloonposition => 'mouse', -msg => TESTCONSTMAP->{'UART'}->{'help'});
    }

    return $fr_ctrl;
}

## @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;
        }
    } else {
        
    }
    ${$self->{'tests_ini_name'}} = $filename;
    $current_dir = _setdir($filename);
    return $tmp_tests;
}

sub _open_tests_file {
    my $logger = get_logger("");
    my $self   = shift;

    my $fb = $self->{'mw'}->FBox(
        -type        => 'open',
        -title       => 'Open FIJI Tests file',
        -filetypes   => TESTS_FILE_TYPES_CFG,
        -initialdir  => $current_dir,
        -initialfile => 'fiji.tst'
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

    if (!defined($filename)) {
        $logger->debug("User aborted open configuration action");
        return;
    }
    $current_dir = _setdir($filename);
    my $tmp_tests = (defined $self->{'tests'}) ? \%{Clone::clone($self->{'tests'})} : undef;
    $tmp_tests = $self->_read_tests_file($filename);
    if (!ref($tmp_tests)) {
        return;
    }

    if (!defined($self->{'FIJITestsViewer'}->configure(-tests => $tmp_tests))) {
        my $msg = "Could not update GUI correctly with new tests.";
        $logger->error($msg);
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
                                               -wraplength => "200",
                                               -text      => $msg,
                                               -title     => 'Open FIJI Tests failed!',);
        $d->Show();
        return;
    }
    $self->{'tests'} = $tmp_tests;
    ${$self->{'tests_ini_name'}} = $filename;
    $downloader = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});
    # Re-attach UART selector to new hash
    $uart_complete->configure(
        '-choices' => FIJI::Utils::get_uart_devs(),
        '-textvariable' => \$self->{'tests'}->{'design'}->{'UART'},
    );
}

sub _overwrite_existing_file ($) {
    my ($self, $filename) = @_;
    my $logger = get_logger("");
    if (!-e $filename) {
        return 1;
    }
    my $d = $self->{'mw'}->FIJIModalDialog(-title     => 'Really overwrite?',
                                           -image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
                                           -buttons   => ["~Yes", "~No"]);
    my $reply = $d->Show();
    return (defined $reply && lc($reply) eq 'yes');
}

sub _save_file {
    my ($self, $filename) = @_;
    my $logger = get_logger("");
    if (!$self->_overwrite_existing_file($filename)) {
        return;
    }
    my $err = $self->{'tests'}->save($filename);
    if (defined($err)) {
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
                                               -text        => $msg,
                                               -title       => 'Save failed!',);
        $d->Show();
        return;
    }
    ${$self->{'tests_ini_name'}} = $filename;

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

    $logger->info("Successfully saved to file $filename.");
}

sub _save {
    my ($self) = @_;
    if (!defined(${$self->{'tests_ini_name'}})) {
        return $self->_save_as();
    } else {
        return $self->_save_file(${$self->{'tests_ini_name'}});
    }
}

sub _save_as {
    my ($self) = @_;
    my $fb = $self->{'mw'}->FBox(
        -type             => 'save',
        -title            => 'Save FIJI Tests file as...',
        -defaultextension => 'tst',
        -filetypes        => TESTS_FILE_TYPES_CFG,
        -initialdir       => $current_dir,
        -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
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();

    if (!defined($filename)) {
        return;
    }
    $current_dir = _setdir($filename);
    return $self->_save_file($filename);
}

sub _onexit {
    my $logger = get_logger("");
    my ($self) = @_;

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

    my $response;
    if ($unsaved_changes == 1) {
        $logger->debug("Settings changed. Asking to save.");
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
                                               -wraplength  => 350,
                                               -title       => 'Really quit?',
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
        $response = $d->Show();
        $self->{'already_clicked'} = 0;

        # 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") {
            goto finish;
        }
    } else {
        goto finish;
    }
    return;

finish:
    $self->{'mw'}->destroy();
    return;
}

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

    # 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
    $queue_to_worker->end();
    $queue_to_gui->end();
    $logger->remove_appender("queueAppender");
    $log_queue->end();
    $worker_tid->join();
}

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