FIJITestsViewer.pm

#-------------------------------------------------------------------------------
#  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 Tests Viewer class
#-------------------------------------------------------------------------------

## @file
# @brief Contains class \ref Tk::FIJITestsViewer

## @class Tk::FIJITestsViewer
# @brief Tk Widget allowing to view and edit FIJI::Tests settings
package Tk::FIJITestsViewer;

use strict;
use warnings;
use utf8;

# Not actually used within here directly but as the base for a custom
# Log::Log4perl::Appender. This use statement guarantees that the user
# sees some useful errors because Tk apparently swallows the messages
# and just kills itself/the main window/your dearest pet if there is a
# fatal error in Populate() (or its children).
use Log::Dispatch::QueueAppender;

use Log::Log4perl qw(get_logger);
use Scalar::Util 'blessed';
use Time::HiRes qw(time);
use Clone qw(clone);

use threads;
use threads::shared;

use FIJI qw(:all);

use Tk;
use Tk::Adjuster;
use Tk::widgets qw(LabFrame ROText Balloon Label Entry Pane Button DialogBox Checkbutton CompleteEntry StatusBar NoteBook);
use Tk::FIJITestFrame;
use Tk::FIJIModalDialog;
use Tk::FIJIUtils;
use base qw(Tk::Frame);


# Test::Deep::NoTest exports Test::Deep which exports
# an undocumented blessed() which clashes with Scalar::Util's blessed().
# see http://stackoverflow.com/a/2837016
BEGIN {
    require Test::Deep;
    @Test::Deep::EXPORT = grep { $_ ne 'blessed' } @Test::Deep::EXPORT;
}

use Test::Deep::NoTest;

Construct Tk::Widget 'FIJITestsViewer';

# Constants

use constant {
    FAILEDCOLOR => "red",
    OKCOLOR     => "ForestGreen",
};

use constant LOG4P_FONTS => {
    WARN  => "Courier 9 bold",
    ERROR => "Courier 9 bold",
    FATAL => "Courier 10 bold",
    DEBUG => "Courier 9 italic",
};

use constant LOG4P_COLORS => {
    TRACE => "black",
    DEBUG => "black",
    ERROR => "red",
    FATAL => "red",
    WARN  => "orange red",
    INFO  => "dark blue",
};

use constant RMSG_ERROR_STRINGS => {
    U => "UART framing error. Check connection & baud rate.",
    I => "Design ID mismatch. Check if the correct bitstream is programmed.",
    C => "CRC error. Check connection & baud rate.",
};

## @var $widget_background stores the default background of entry widgets
# this is needed under Linux, because the default background retrievable by
# cget() is different from the actual default background
my $widget_background;

sub ClassInit {
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);

    my $self = bless {}, $class;
    return $self;
}

sub Populate {
    my $logger = get_logger("");
    my ($self, $args) = @_;
    my $settings = delete $args->{'-settings'};
    my $tests    = delete $args->{'-tests'};
    $self->{'changes_callback'}  = delete $args->{'-changes_callback'};
    $self->{'test_callback'}     = delete $args->{'-test_callback'};
    $self->{'mw'}                = delete $args->{'-mw'};
    $self->{'worker'}            = delete $args->{'-worker'};
    $self->{'queue_to_worker'}   = delete $args->{'-queue_to_worker'};
    $self->{'queue_from_worker'} = delete $args->{'-queue_from_worker'};
    $self->{'log_queue'}         = delete $args->{'-log_queue'};
    $self->{'loglevel'}          = delete $args->{'-loglevel'};

    if (!defined($settings) || !blessed($settings) || !$settings->isa("FIJI::Settings")) {
        $logger->error("No or invalid settings given.");
        return;
    }

    $self->{'settings'} = $settings;

    if (!defined($tests) || !blessed($tests) || !$tests->isa("FIJI::Tests")) {
        $logger->error("No or invalid tests given.");
        return;
    }

    $self->{'widget_states'} = {};

    $self->{'tests'}      = $tests;
    $self->{'manualtest'} = {};
    $self->{'tests'}->set_test_defaults($self->{'manualtest'});

    if (ref($self->{'tests'}->{'tests'}) ne 'ARRAY') {
        $logger->debug("Adding empty tests array to tests reference.");
        $self->{'tests'}->{'tests'} = [];
    }

    $self->{'original_tests'} = clone($tests);
    $self->{'original_tests'}->{'tests'} = clone($tests->{'tests'});
    $self->traceVariable($self->{'tests'}->{'design'}, 'w' => [\&_watch_settings, $self]);
    $self->traceVariable($self->{'tests'}->{'tests'},  'w' => [\&_watch_settings, $self]);
    $self->{'Downloader'} = FIJI::Downloader->new(undef, undef, $self->{'tests'}, undef, $self->{'settings'});

    $self->SUPER::Populate($args);
    $self->_populate_widget($self);
    $self->update();
}

sub tests {
    my $logger = get_logger("");
    my ($self, $tests) = @_;
    if (defined($tests)) {
        if (!blessed($tests) || !$tests->isa("FIJI::Tests")) {
            $logger->error("Given tests are not of type FIJI::Tests.");
            return undef;
        }
        $self->{'tests'}      = $tests;
        $self->{'manualtest'} = {};
        $self->{'tests'}->set_test_defaults($self->{'manualtest'});
        $self->{'original_tests'} = clone($self->{'tests'});
        $self->{'original_tests'}->{'tests'} = clone($self->{'tests'}->{'tests'});
        $self->traceVariable($self->{'tests'}->{'design'}, 'w' => [\&_watch_settings, $self]);
        $self->traceVariable($self->{'tests'}->{'tests'},  'w' => [\&_watch_settings, $self]);
        $self->{'Downloader'} = FIJI::Downloader->new(undef,undef, $self->{'tests'}, undef, $self->{'settings'});
        $self->update();
    }
    return $self->{'tests'};
}

## @method private _start_test
# @brief downloads FIJI test(s) according to the mode currently selected
# The currently selected mode is read from the raised tab in the central notebook
sub _start_test {
    my $self         = shift;
    my $current_page = $self->{'notebook'}->raised();

    my $cfg = {
        mode       => $current_page,
        uart       => $self->{'tests'}->{'design'}->{'UART'},
        downloader => $self->{'Downloader'}
    };

    if ($current_page eq "manual") {
        $cfg->{'test'} = $self->{'manualtest'};
    }

    $self->_download($cfg);
}

## @method private _update_fiji_status ()
# @brief Tries to get current status of FIJI logic
# downloads an empty test (no fault, no duration, no trigger, no reset) to
# determine the status of the FIJI hardware
#
sub _update_fiji_status {
    my $self = shift;

    my $cfg = {
        mode       => "dryrun",
        uart       => $self->{'tests'}->{'design'}->{'UART'},
        downloader => $self->{'Downloader'},
    };

    $self->_download($cfg);
}

## @method private _download ($cfg)
# @brief sends tests to the worker thread
#
# posts a new work package to the worker
# waits for response messages until a 'finished' message is encountered
#
# @param cfg    a hash describing the current test
#
sub _download {
    my $logger = get_logger("");
    my ($self, $cfg) = @_;

    Tk::FIJIUtils::disable_all_widgets($self->MainWindow(), $self->{'widget_states'});

    $self->{'update_button'}->configure(-state => "disabled");
    $self->{'stop_button'}->configure(-state => "normal");
    $self->{'start_button'}->configure(-state => "disabled");

    $self->{'queue_to_worker'}->enqueue($cfg);

    $self->{'starttime'} = time;

    # start timer to update the test 'uptime' periodically
    my $timer = $self->repeat(100, [\&_update_timer, $self, "Running"]);

    my $worker_msg;
    my $downloader_reply;
    do {
        # try to read a new message from the queue
        # if no message arrives within 0.01s, process the GUI
        while (!defined($worker_msg = $self->{'queue_from_worker'}->dequeue_timed(0.01))) {
            $self->toplevel->update();
        }

        $downloader_reply = $worker_msg->{'rmsg'};

        if ($worker_msg->{'state'} eq "dying") {
            my $d = $self->{'mw'}->FIJIModalDialog(-image      => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                   -wraplength => "400",
                                                   -text       => $downloader_reply,
                                                   -title      => 'Download worker thread died!',);
            $d->Show();
            # FIXME: convey this error to the main thread instead of simply closing the GUI
            $self->{'mw'}->destroy();
        }

        # process message
        if (defined $downloader_reply && ref $downloader_reply eq "HASH") {
            $self->_update_rmsg_status($downloader_reply) if not $downloader_reply->{'aborted'};
        } else {
            $self->{'msg_type'}->configure(-text => $downloader_reply, -bg => "red");
        }
        $self->toplevel->update();
    } while ($worker_msg->{'state'} ne "finished");

    $self->afterCancel($timer);
    $self->_update_timer("Run duration");

    FIJI::Utils::execute_completion_script(
        $self->{'tests'}->{'design'}->{'COMPLETION_SCRIPT'},
        $self->{'tests'}->{'filename'},
        $downloader_reply,
        $self->{'starttime'},
        time,
        $worker_msg->{'testref'},
        $self->{'logbox'}->Contents(),
    ) if (($cfg->{'mode'} ne 'dryrun') && ($cfg->{'mode'} ne 'manual'));

    # if a valid return message has beeen received from the FIC
    if (defined $downloader_reply && ref $downloader_reply eq "HASH" ) {
        if (not $downloader_reply->{'aborted'}) {
            my $rmsg_error_strings = RMSG_ERROR_STRINGS;
            # if errors were reported, display error messages accordingly
            if ($downloader_reply->{'error'}->{'ANY'}) {
                my $text = "FIJI Hardware reported error(s):\n";
                for my $k (keys(%{$rmsg_error_strings})) {
                    $text .= RMSG_ERROR_STRINGS->{$k} . "\n" if $downloader_reply->{'error'}->{$k};
                }

                my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
                                                       -text        => $text,
                                                       -title       => "Error while downloading.",);

                $d->Show();
            }
        }
        # if the message contained a valid reference to executed tests
        if (defined $worker_msg->{'testref'} && blessed($worker_msg->{'testref'}) && $worker_msg->{'testref'}->isa("FIJI::Tests")) {
            $self->{'last_test'} = clone($worker_msg->{'testref'});
            # execute the callback in the parent
            $self->{'test_callback'}->(1);
        } else {
            $self->{'last_test'} = undef;
            # In case we got actively aborted do not report an error to the callback
            my $state = $downloader_reply->{'aborted'} ? 1 : 0;
            $self->{'test_callback'}->($state);
        }
    } else {
        $self->{'last_test'} = undef;
        $self->{'test_callback'}->(0);
    }

    Tk::FIJIUtils::reenable_all_widgets($self->MainWindow(), $self->{'widget_states'});

    # update button state
    $self->{'update_button'}->configure(-state => "normal");
    $self->{'stop_button'}->configure(-state => "disabled", -text => "Stop");
    $self->{'start_button'}->configure(-state => "normal");
}

sub get_last_test {
    my $logger = get_logger("");
    my $self = shift;
    my $lt;
    if (!defined $self->{'last_test'}) {
        my $msg = "Could not determine last test case.";
        $logger->error($msg);
        my $d = $self->{'mw'}->FIJIModalDialog(-image      => Tk::FIJIUtils::error_image($self->{'mw'}),
                                               -wraplength => "200",
                                               -text       => $msg,
                                               -title      => 'Export failed!',);
        $d->Show();
    } else {
        $lt = $self->{'last_test'};
    }
    return $lt;
}

## @method private _update_logging_box ()
# @brief Reads log messages from the internal logging queue and appends them
#        to the logging ROText widget
sub _update_logging_box {
    my $logger = get_logger("");
    my $self = shift;
    my $msg;
    while (defined($msg = $self->{'log_queue'}->dequeue_timed(0))) {
        if (defined $msg->{'clear'}) {
            $self->{'logbox'}->delete('0.0','end');
            $logger->info('Log messages cleared');
        } else {
            if (defined $msg->{'log4p_level'}) {
                $self->{'logbox'}->insert('end', $msg->{'message'}, [$msg->{'log4p_level'}]);
            } else {
                $self->{'logbox'}->insert('end', $msg->{'message'});
            }
            $self->{'logbox'}->yview('end');
        }
    }
}

## @method private _update_timer ()
# @brief updates the 'duration' widget with the current test 'uptime'
sub _update_timer {
    my ($self, $state) = @_;

    my $d = (time - $self->{'starttime'});
    my $m = int($d / 60);
    my $s = $d - $m * 60;

    $self->{'duration'}->configure(-text => sprintf("$state: %dm %02.3fs", $m, $s), -bg => $widget_background);
}

## @method private _stop_test ()
# @brief just sends a SIGKILL to the worker thread
sub _stop_test {
    my $self = shift;
    $self->{'stop_button'}->configure(-state => "disabled", -text => "Stopping");
    $self->{'worker'}->kill('STOP');
}

## @method private _update_rmsg_status (%$rmsg)
# @brief updates the error state widgets according to %$rmsg
# @param rmsg a reference to a hash containing the decoded return message
sub _update_rmsg_status {
    my $logger = get_logger("");
    my ($self, $rmsg) = @_;
    $self->{'uart_status'}->configure(-bg => ($rmsg->{'error'}->{'U'}) ? FAILEDCOLOR : OKCOLOR);
    $self->{'id_status'}->configure(-bg => ($rmsg->{'error'}->{'I'}) ? FAILEDCOLOR : OKCOLOR);
    $self->{'crc_status'}->configure(-bg => ($rmsg->{'error'}->{'C'}) ? FAILEDCOLOR : OKCOLOR);
    $self->{'fault_detect_1'}->configure(-bg => ($rmsg->{'fault_detect'}->{'1'}) ? FAILEDCOLOR : OKCOLOR) if ($self->{'settings'}->{'design'}->{'FD_1_EN'} == 1);
    $self->{'fault_detect_2'}->configure(-bg => ($rmsg->{'fault_detect'}->{'2'}) ? FAILEDCOLOR : OKCOLOR) if ($self->{'settings'}->{'design'}->{'FD_2_EN'} == 1);
    $self->{'msg_type'}->configure(-text => $rmsg->{'msg_type'}, -bg => $widget_background);
}

## @method _switchtab(nb, inc)
# Raises the tab $inc frames left ($inc < 0) or right ($inc > 0) of the
# currently selected tab of $nb
#
sub _switchtab {
    my ($dummy, $nb, $inc) = @_;
    my @pages        = $nb->pages();
    my $current_page = $nb->raised();
    my ($index) = grep { $pages[$_] eq $current_page } 0 .. (@pages - 1);
    my $next_page = $pages[$index + $inc];

    $nb->raise($next_page) if (($inc > 0 && defined $next_page)
        || ($inc < 0 && $index > 0));
}

## @method private _populate_widget ()
# @brief creates GUI elements of the FIJI Settings Viewer
# @returns 0
sub _populate_widget {
    my $logger = get_logger("");
    my $self   = shift;

    eval {
        # central control frame
        $self->{'fr_download'} = $self->Frame();

        $self->{'notebook'} = $self->{'fr_download'}->NoteBook();

        # Allow to switch tabs by pressing ALT+left and ALT+right
        $self->parent->bind('<Alt-Key-Left>'  => [\&_switchtab, $self->{'notebook'} , -1]);
        $self->parent->bind('<Alt-Key-Right>' => [\&_switchtab, $self->{'notebook'} , 1]);

        # bottom frame for control buttons
        $self->{'fr_buttons'} = $self->Frame(-borderwidth => 1, -relief => 'raised',)->pack(
            -side => "bottom",
            -fill => 'both',
        );
        my $balloon = $self->{'balloon'} = $self->Balloon();

        $self->{'clear_button'} = $self->{'fr_buttons'}->Button(
            -text    => "Clear Log",
            -command => sub {$self->{'log_queue'}->enqueue({clear=>1})} ,
            -underline => 0,
        );
        $self->MainWindow->bind("<Alt-c>" => [ $self->{'clear_button'}, 'Invoke']);
        $self->MainWindow->bind("<F4>" => [ $self->{'clear_button'}, 'Invoke']);
        $balloon->attach(
            $self->{'clear_button'},
            -balloonposition => 'mouse',
            -msg             => "Clear current log messages (F4)",
        );

        $self->{'update_button'} = $self->{'fr_buttons'}->Button(
            -text    => "Update",
            -command => [\&_update_fiji_status, $self],
            -state   => (defined $self->{'Downloader'}) ? "normal" : "disabled",
            -underline => 0,
        );
        $self->MainWindow->bind("<Alt-u>" => [ $self->{'update_button'}, 'Invoke']);
        $self->MainWindow->bind("<F5>" => [ $self->{'update_button'}, 'Invoke']);
        $balloon->attach(
            $self->{'update_button'},
            -balloonposition => 'mouse',
            -msg             => "Query hardware for current status (F5)",
        );


        $self->{'start_button'} = $self->{'fr_buttons'}->Button(
            -text    => "Start",
            -command => [\&_start_test, $self],
            -state   => (defined $self->{'Downloader'}) ? "normal" : "disabled",
            -underline => 0,
        );
        $self->MainWindow->bind("<Alt-s>" => [ $self->{'start_button'}, 'Invoke']);
        $self->MainWindow->bind("<F6>" => [ $self->{'start_button'}, 'Invoke']);
        $balloon->attach(
            $self->{'start_button'},
            -balloonposition => 'mouse',
            -msg             => "Start currently selected test(s) (F6)",
        );


        $self->{'stop_button'} = $self->{'fr_buttons'}->Button(
            -text    => "Stop",
            -command => [\&_stop_test, $self],
            -state   => "disabled",
            -underline => 3,
        );
        $self->MainWindow->bind("<Alt-p>" => [ $self->{'stop_button'}, 'Invoke']);
        $self->MainWindow->bind("<F7>" => [ $self->{'stop_button'}, 'Invoke']);
        $balloon->attach(
            $self->{'stop_button'},
            -balloonposition => 'mouse',
            -msg             => "Stop test(s) immediately (F7)",
        );


        $self->{'stop_button'}->pack(-side => "right");
        $self->{'start_button'}->pack(-side => "right");
        $self->{'update_button'}->pack(-side => "right");
        $self->{'clear_button'}->pack(-side => "right");

        # configure all the status labels so that they look like 'sunken-in' displays
        $self->{'fr_buttons'}->Label(-text => "Error:")->pack(-side => "left", -padx => 5);
        $self->{'uart_status'} = $self->{'fr_buttons'}->Label(-width => 2, -relief => "sunken", -borderwidth => "1", -text => "U", -bg => OKCOLOR)->pack(-side => "left");
        $self->{'id_status'} = $self->{'fr_buttons'}->Label(-width => 2, -relief => "sunken", -borderwidth => "1", -text => "I", -bg => OKCOLOR)->pack(-side => "left");
        $self->{'crc_status'} = $self->{'fr_buttons'}->Label(-width => 2, -relief => "sunken", -borderwidth => "1", -text => "C", -bg => OKCOLOR)->pack(-side => "left");
        $self->{'fr_buttons'}->Label(-text => "Fault Detect:")->pack(-side => "left", -padx => 5);
        for my $i (1..2) {
        my @fd_settings;
            if ($self->{'settings'}->{'design'}->{"FD_${i}_EN"} == 1) {
                push(@fd_settings, -state, "normal");
                push(@fd_settings, -bg, OKCOLOR);
            } else {
                push(@fd_settings, -state, "disabled");
            }
            $self->{"fault_detect_$i"} = $self->{'fr_buttons'}->Label(-width => 2, -relief => "sunken", -borderwidth => "1", -text => "$i", @fd_settings)->pack(-side => "left");
        }
        $self->{'msg_type'} = $self->{'fr_buttons'}->Label(-width => 22, -text => "FIJI status",  -borderwidth => "1", -relief => "sunken")->pack(-side => "left", -padx => 5);
        $self->{'duration'} = $self->{'fr_buttons'}->Label(-width => 22, -text => "Test runtime", -borderwidth => "1", -relief => "sunken")->pack(-side => "left", -padx => 5);

        $balloon->attach(
            $self->{'uart_status'},
            -balloonposition => 'mouse',
            -msg             => "UART",
        );
        $balloon->attach(
            $self->{'id_status'},
            -balloonposition => 'mouse',
            -msg             => "Design ID",
        );
        $balloon->attach(
            $self->{'crc_status'},
            -balloonposition => 'mouse',
            -msg             => "CRC",
        );

        #--- Container for logging window
        my $text_scrolled = $self->ScrlROText(-scrollbars => "oe", -width => 80, -height => 10);

        $text_scrolled->pack(
            -fill   => 'both',
            -expand => 1,
            -side   => 'bottom',
        );

        #--- Adjuster bar between logging window container and notebook container
        my $adj = $self->Adjuster();
        $adj->packAfter($text_scrolled, -side=>'bottom');
        $self->{'fr_download'}->pack(-fill => "both", -expand => "1",-side=>'bottom');

        #---
        # Configure logging window
        #
        $self->{'logbox'} = $text_scrolled->Subwidget('scrolled');

        my $log4p_colors_ref = LOG4P_COLORS;
        my $log4p_fonts_ref  = LOG4P_FONTS;

        foreach my $k (keys(%{$log4p_colors_ref})) {
            $self->{'logbox'}->tagConfigure($k, -foreground => LOG4P_COLORS->{$k});
        }
        foreach my $k (keys(%{$log4p_fonts_ref})) {
            $self->{'logbox'}->tagConfigure($k, -font => LOG4P_FONTS->{$k});
        }

        # Append any messages from the logging queue to textbox periodically
        $self->repeat(100, [\&_update_logging_box, $self]);

        # also log to the log_queue
        append_logger($self->{'log_queue'}, $self->{'loglevel'});
        $logger->info("Live capturing of log output has started");

        #---
        # Test settings Notebook

        my $modes_ref       = TESTGUIMODES;
        my $tcm_ref         = TESTCONSTMAP;
        my @tcm_keys_sorted = sort { TESTCONSTMAP->{$a}->{'order'} <=> TESTCONSTMAP->{$b}->{'order'} } grep { defined TESTCONSTMAP->{$_}->{'order'} } keys(%{$tcm_ref});

        # fill the notebook with pages, one page for each test mode
        for my $mode (sort(keys(%{$modes_ref}))) {
            my $pg = $self->{'notebook'} ->add(
                $mode,
                -label    => TESTGUIMODES->{$mode}->{'title'},
                -raisecmd => [\&update, $self]
            );    # to sync changes from textbuttons in other
                  # tabs that also exist in this tab

            my $sp = $pg->Scrolled('Pane', '-scrollbars'=>'osoe', '-sticky'=>'nwse')->pack(-fill=>'both',-expand=>1);
            Tk::FIJIUtils::bind_mousewheel($sp->MainWindow,$sp);
            my $page =  $self->{'pages'}->{$mode} = $sp->Frame();
            $page->gridColumnconfigure(0, -weight => 0);
            $page->gridColumnconfigure(1, -weight => 0);
            $page->gridColumnconfigure(2, -weight => 1);

            my $row = 0;
            my $i   = 0;

            # calculate the height of all widgets combined to set the height of the pane
            my $total_height = 0;

            # fill the current page with widgets representing test settings
            for my $k (@tcm_keys_sorted) {
                next if (TESTCONSTMAP->{$k} eq UART);

                my $entry;
                # this variable will be filled with the tallest generated widget's reqheight
                my $widget_height;
                if (defined TESTCONSTMAP->{$k}->{'gui_modes'}) {
                    for my $m (@{TESTCONSTMAP->{$k}->{'gui_modes'}}) {
                        if ($m eq $mode) {

                            # label
                            my $label = $page->Label(
                                '-text'    => TESTCONSTMAP->{$k}->{'description'},
                                '-justify' => 'left'
                            );
                            $label->grid(
                                '-row'    => $row,
                                '-column' => 0,
                                '-sticky' => 'w'
                            );

                            # unit
                            my $unit_val = TESTCONSTMAP->{$k}->{'unit'};
                            my $unit = $page->Label('-text' => (!defined($unit_val)) ? "" : "[$unit_val]",);
                            $unit->grid(
                                '-row'    => $row,
                                '-column' => 1,
                                '-ipadx'  => ".5c",
                                '-sticky' => 'w',
                            );

                            # entry
                            my $type = TESTCONSTMAP->{$k}->{'type'};

                            my $en;
                            my $activation_text = "";
                            my $activation_func = TESTCONSTMAP->{$k}->{'activated_by_settings'};
                            if (defined($activation_func) && ref($activation_func) eq "CODE")
                            {
                                $en = $activation_func->($self->{'settings'});
                                $activation_text = "(disabled due to current FIJI configuration)" if (!$en);
                            } else {
                                $en = 1;
                            }

                            if (defined($type) && $type eq 'boolean') {
                                $entry = $page->Checkbutton(
                                    '-state'    => $en ? "active" : "disabled",
                                    '-variable' => \$self->{'tests'}->{'design'}->{$k},
                                    '-justify'  => 'left',
                                    '-text'     => $activation_text,
                                );
                                $entry->grid(
                                    '-row'    => $row,
                                    '-column' => 2,
                                    '-sticky' => 'w',
                                );
                                $widget_height = $label->reqheight;
                            } elsif (defined($type) && $type eq 'autocomplete') {
                                my $options = TESTCONSTMAP->{$k}->{'values'};
                                $entry = $page->Frame();
                                
                                my $complete = $entry->CompleteEntry(
                                    '-state' => $en ? "normal" : "disabled",
                                    '-textvariable' => \$self->{'tests'}->{'design'}->{$k},
                                );
                                $complete->grid(
                                    '-row'    => 0,
                                    '-column' => 0,
                                    '-sticky' => "ew",
                                );
                                $entry->gridColumnconfigure(0, -weight => 1);
                                if (defined $options && ref($options) eq "CODE") {
                                    my $b = $entry->Button(
                                        -text    => 'Update Choices',
                                        -command => sub {
                                            $complete->configure('-choices' => TESTCONSTMAP->{$k}->{'values'}->($self->{'settings'}->{$k}, $self->{'settings'}));
                                        },
                                    )->grid(
                                        '-row'    => 0,
                                        '-column' => 1,
                                        '-sticky' => "w",
                                    );
                                    $options = $options->();
                                    $widget_height = $b->reqheight;
                                } else {
                                    $widget_height = $complete->Subwidget('entry')->reqheight;
                                }
                                $complete->configure('-choices' => $options);

                                $entry->grid(
                                    '-row'    => $row,
                                    '-column' => 2,
                                    '-sticky' => 'ew'
                                );
                            } elsif (defined($type) && $type eq 'dropdown') {
                                my $options = TESTCONSTMAP->{$k}->{'values'};
                                if (defined $options && ref($options) eq "CODE") {
                                    $options = $options->($self->{'settings'}->{$k}, $self->{'settings'});
                                }

                                $entry = $page->Frame();
                                my $opts = $entry->Optionmenu(
                                    '-state'        => $en ? "normal" : "disabled",
                                    '-options'      => $options,
                                    '-textvariable' => \$self->{'tests'}->{'design'}->{$k},
                                    '-anchor'       => 'w',
                                    '-justify'      => 'left',
                                );
                                $opts->grid(
                                    '-row'    => 0,
                                    '-column' => 0,
                                    '-sticky' => "w"
                                );

                                $entry->Label(
                                    '-text'  => $activation_text,
                                    '-state' => "disabled",
                                )->pack(
                                    '-side' => "left",
                                    '-padx' => 5
                                )->grid(
                                    '-row'    => 0,
                                    '-column' => 1,
                                    '-sticky' => 'w'
                                );
                                $entry->gridColumnconfigure(1, -weight => 1);

                                $entry->grid(
                                    '-row'    => $row,
                                    '-column' => 2,
                                    '-sticky' => 'w',
                                );
                                $widget_height = $opts->reqheight;
                            } elsif (defined($type) && $type eq 'file') {
                                $entry = $page->Frame();
                                my $filetypes = [['All files', '*']];

                                $filetypes = TESTCONSTMAP->{$k}->{'filetypes'} if (defined TESTCONSTMAP->{$k}->{'filetypes'});

                                my $b = $entry->Button(
                                    -text    => 'Open',
                                    '-state'        => $en ? "normal" : "disabled",
                                    -command => sub {
                                        my $fb = $page->FBox(
                                            -type      => 'open',
                                            -title     => "Select " . lc(TESTCONSTMAP->{$k}->{'description'}),
                                            -filetypes => $filetypes
                                        );
                                        Tk::FIJIUtils::set_icon($fb);
                                        my $file = $fb->Show();

                                        if (defined $file) {
                                            my ($basevolume, $basedirs, $fn) = File::Spec->splitpath($self->{'tests'}->{'filename'});
                                            my $nv = File::Spec->abs2rel($file, File::Spec->catpath($basevolume, $basedirs, ""));
                                            $logger->info("Setting $k to relative path $nv") if (File::Spec->file_name_is_absolute($file));
                                            $self->{'tests'}->{'design'}->{$k} = $nv;
                                            $self->update();
                                        }
                                    }
                                )->grid(
                                    -row    => 0,
                                    -column => 0,
                                    -sticky => "w"
                                );
                                my $e = $entry->Entry(-state => 'readonly', -textvariable => \$self->{'tests'}->{'design'}->{$k},)->grid(-row => 0, -column => 1, -sticky => "ew");
                                $entry->gridColumnconfigure(1, -weight => 1);

                                $entry->Button(
                                    -text    => "Clear",
                                    '-state' => ($self->{'tests'}->{'design'}->{$k} ne "") ? "normal" : "disabled",
                                    -command => sub {
                                        $self->{'tests'}->{'design'}->{$k} = "";
                                        $self->update();
                                    },
                                )->grid(
                                    -row    => 0,
                                    -column => 2,
                                    -sticky => "e"
                                );;
                                $entry->grid(
                                    -row      => $row,
                                    -column   => 2,
                                    '-sticky' => 'ew'
                                );
                                $widget_height = $b->reqheight;
                            } else {
                                $entry = $page->Entry('-state' => $en ? "normal" : "readonly");
                                $entry->configure(
                                    '-validate'        => 'key',
                                    '-validatecommand' => [\&_validate_design_entry, $self, $entry, $k],
                                );
                                $entry->grid(
                                    -row      => $row,
                                    -column   => 2,
                                    '-sticky' => 'ew'
                                );
                                $widget_height = $entry->reqheight;
                            }
                            if (defined(TESTCONSTMAP->{$k}->{'matching'})) {
                                push @{$self->{'matching'}->{TESTCONSTMAP->{$k}->{'matching'}}}, $entry;
                            }
                            if (defined(TESTCONSTMAP->{$k}->{'depends_on'})) {
                                push @{$self->{'depends'}->{TESTCONSTMAP->{$k}->{'depends_on'}}}, $entry;
                            }
                            if (defined(TESTCONSTMAP->{$k}->{'forbidden_by'})) {
                                push @{$self->{'forbidden_by'}->{TESTCONSTMAP->{$k}->{'forbidden_by'}}}, $entry;
                            }
                            # add tooltip for widget
                            if (defined TESTCONSTMAP->{$k}->{'help'}) {
                                $balloon->attach(
                                    $entry,
                                    -balloonposition => 'mouse',
                                    -msg             => TESTCONSTMAP->{$k}->{'help'}
                                );
                                $balloon->attach(
                                    $label,
                                    -balloonposition => 'mouse',
                                    -msg             => TESTCONSTMAP->{$k}->{'help'}
                                );
                            }

                            Tk::FIJIUtils::entry_rebind($entry);

                            # Widget description is needed for widget-based error messages such as
                            # "Forbids"
                            $entry->{'key'}         = $k;
                            $entry->{'description'} = TESTCONSTMAP->{$k}->{'description'};
                            push @{$self->{'widgets'}}, $entry;
                            $row++;
                            $widget_background = $entry->cget('-bg');
                            $total_height += $widget_height;
                        }
                    }
                }
                $sp->configure(-height=>$total_height);
            }
            # extra widgets and settings for the test modes
            if ($mode eq "auto") {
                my $fr = $page->Frame(-relief => "ridge", -borderwidth => 2);
                $fr->grid(-row => $row, -column => 0, -columnspan => 3, -padx => 10, -pady => 10, -ipadx => 10, -ipady => 10, -sticky => "nsew");
                $self->_add_test_panel($fr,$balloon);
            } elsif ($mode eq "random") {
                # no extra widgets
            } elsif ($mode eq "manual") {
                $self->{'manual_test_frame'} = $self->{'pages'}->{'manual'}->FIJITestFrame(
                    -settings    => $self->{'settings'},
                    -scrolled    => 1,
                    -test        => $self->{'manualtest'},
                    -relief      => "ridge",
                    -borderwidth => 2
                );
                $self->{'manual_test_frame'}->grid(-row => $row, -column => 0, -columnspan => 3, -ipady => 10, -ipadx => 10, -pady => 10, -padx => 10, -sticky => "nsew");
            }
            $page->gridRowconfigure($row, -weight => 1);
            $page->pack(-fill=>'both',-expand=>1);
        }
        $self->{'notebook'}->pack(-anchor => "nw", -side => "bottom", -fill => "both", -expand => 1);
    };

    if ($@ ne "") {
        # The message might be nonsense, e.g. if Log::Dispatch::QueueAppender is not available"
        # and Perl:Tk(?) might wreck havoc anyway... *shrug*
        $logger->error("Something went wrong while populating " . __PACKAGE__ . ": $@");
    }

    return 0;
}

sub update {
    my $self   = shift;

    # loop through all widgets and set their values and states according
    # to the settings
    for my $widget (@{$self->{'widgets'}}) {
        my $k = $widget->{'key'};
        next if (!defined $k || !defined TESTCONSTMAP->{$k}->{'type'});

        my $en;
        my $activation_func = TESTCONSTMAP->{$k}->{'activated_by_settings'};
        if (defined($activation_func) && ref($activation_func) eq "CODE")
        {
            $en = $activation_func->($self->{'settings'});
        } else {
            $en = 1;
        }

        my $val = \$self->{'tests'}->{'design'}->{$k};
        if (ref($widget) eq "Tk::Entry") {
            $widget->configure('-state' => $en ? "normal" : "readonly");
            if (defined($val)) {
                $widget->configure(-text => $val);
            } else {
                $widget->delete('0', 'end');
            }
        } elsif (ref($widget) eq "Tk::Checkbutton") {
            $widget->configure(
                '-state'    => $en ? "normal" : "disabled",
                '-variable' => \$self->{'tests'}->{'design'}->{$k},
            );
            if (defined($self->{'depends'}->{$k})) {
                $widget->configure('-command' => [\&_set_fields_by_button, $self, $widget, $self->{'depends'}->{$k}, []]);
            }
            _set_fields_by_button($self, $widget, $self->{'depends'}->{$k}, []);
        } elsif (ref($widget) eq "Tk::Frame") {
            if (TESTCONSTMAP->{$k}->{'type'} eq 'file') {
                my $text = ($widget->children)[1];
                $text->configure(
                    '-state' => $en ? "normal" : "disabled",
                    # Don't ask me why but setting "" to the underlying variable
                    # does not change the text in the entry.
                    # Setting something else than "" or undef works just fine. O_o
                    # This workaround re-sets the textvariable to its previous value namely
                    # the reference to the respective $self->{'tests'}->{'design'} field
                    # and this seems to trigger an update.
                    '-textvariable' => $val,
                );
                my $clear = ($widget->children)[2];
                $clear->configure(
                    '-state' => ($$val ne "") ? "normal" : "disabled",
                );
            } elsif (TESTCONSTMAP->{$k}->{'type'} eq 'dropdown') {
                my $options = TESTCONSTMAP->{$k}->{'values'};
                if (defined $options && ref($options) eq "CODE") {
                    $options = $options->($self->{'settings'}->{$k}, $self->{'settings'});
                }
                my $subwidget = ($widget->children)[0];
                $subwidget->configure(
                    '-state' => $en ? "active" : "disabled",
                    '-options'      => $options,
                    '-textvariable' => $val,
                );
            } elsif (TESTCONSTMAP->{$k}->{'type'} eq 'autocomplete') {
                my $options = TESTCONSTMAP->{$k}->{'values'};
                if (defined $options && ref($options) eq "CODE") {
                    $options = $options->($self->{'settings'}->{$k}, $self->{'settings'});
                }
                my $subwidget = ($widget->children)[0];
                $subwidget->configure(
                    '-state'        => $en ? "normal" : "disabled",
                    '-choices'      => $options,
                    '-textvariable' => $val,
                );
            }
        } else {
            my $logger = get_logger("");
            $logger->error("Updating unknown widget: " . ref($widget) . " of type: " . TESTCONSTMAP->{$k}->{'type'});
        }
    }

    ###############
    # tests panel #
    ###############

    my $parent = $self->{'fr_tests'}->parent();
    for my $w ($self->{'fr_tests'}->children()) {
        $self->{'balloon'}->detach($w);
    }
    $parent->packForget();             # This and the next line would be redundant if
    $self->{'fr_tests'}->destroy();    # the $parent->destroy() call would work.
    $self->_add_test_frame($parent->parent());

    $self->{'fr_tests'}->gridColumnconfigure(0, -weight => 0);
    $self->{'fr_tests'}->gridColumnconfigure(1, -weight => 1);
    $self->{'fr_tests'}->gridColumnconfigure(2, -weight => 1);

    my $i       = 1;
    my $hdr_row = 0;
    foreach my $hdr ("Duration T1 [cycles]", "Duration T2 [cycles]") {
        $self->{'fr_tests'}->Label(-text => $hdr,)->grid(
            '-row'    => $hdr_row,
            '-column' => $i++,
        );
    }

    my $test_cnt = $self->_test_cnt();