Commit f5bd7501 authored by Christian Fibich's avatar Christian Fibich Committed by Stefan Tauner
Browse files

Changed all get_logger() calls to get root logger

Added logging to Tk::Text widget
parent 7b741efc
......@@ -108,6 +108,16 @@ BEGIN {
phases_opt => [qw(setup)],
order => 5,
},
INSTRUMENTATION_LOG => {
description => "Instrumentation log file",
help => "Log file for FIJI Instrumentation tool",
ini_name => "INSTRUMENTATION_LOG",
default => "fiji_instrument.log",
type => 'file',
group => 'general_control',
phases_opt => [qw(setup)],
order => 6,
},
BAUDRATE => {
description => "Baud rate",
help => "Enter the Baud rate for communication between Host and FIJI logic.",
......
......@@ -50,7 +50,7 @@ use FIJI::AnySerialPort;
#
# \returns a FIJI::Connection object, or undef if non could be obtained.
sub init {
my $logger = get_logger();
my $logger = get_logger("");
my ( $class, $portname, $baudrate ) = @_;
if ( defined($baudrate) ) {
......@@ -126,7 +126,7 @@ sub init {
#
# \returns 0 if configuration seems sane.
sub sanitize_config {
my $logger = get_logger();
my $logger = get_logger("");
my ($config_ref) = @_;
my $consts_ref = $config_ref->{'consts'};
......@@ -197,7 +197,7 @@ sub sanitize_config {
#
# \returns 0 on success
sub send_config {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $config_ref, $timeout, $block_till_ready, $wait_for_ready ) = @_;
my $port = $self->{'port'};
......@@ -388,7 +388,7 @@ sub send_config {
#
# \returns the number of bytes actually transmitted
sub _send_bitstream {
my $logger = get_logger();
my $logger = get_logger("");
my ( $port, $str_ref, $timeout ) = @_;
if ( !defined($port) ) {
......@@ -441,7 +441,7 @@ sub _send_bitstream {
#
# \returns 0 on success
sub _rcv_bitstream {
my $logger = get_logger();
my $logger = get_logger("");
my ( $port, $todo, $timeout, $buf_ref ) = @_;
my @bytes;
......@@ -492,7 +492,7 @@ sub _rcv_bitstream {
# \returns The type of the return message, or undef in the case of errors.
# Possible types are: 'CONF_DONE', 'UNDERRUN', 'READY'
sub _parse_return_message {
my $logger = get_logger();
my $logger = get_logger("");
my ( $message_byte, $error_ref, $fd_ref ) = @_;
if ( defined($error_ref) && ref($error_ref) ne 'HASH' ) {
$logger->error("Second parameter is not a reference to a hash.");
......
......@@ -22,7 +22,7 @@ package FIJI::Downloader;
use strict;
use warnings;
use Log::Log4perl qw(get_logger :easy);
use Log::Log4perl qw(get_logger);
use FIJI::Tests;
use FIJI::Settings;
use FIJI::Connection;
......@@ -33,7 +33,7 @@ use threads;
use threads::shared;
sub new(;$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $class, $testsname, $existing_tests, $cfgname, $existing_cfg ) = @_;
my $self = {};
my $rv = "Constructor has no means of obtaining a FIJI::Tests/Settings object" . bless $self, $class;
......@@ -102,7 +102,7 @@ sub existing_tests {
# Generates a configuration hash from discrete parameters
#
sub _test_fi_uart {
my $logger = get_logger();
my $logger = get_logger("");
my ( $port, $payload_ref, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, $fiji_consts ) = @_;
# my @payload = map hex($_), $cfg_str =~ /(..)/g; # TODO: how to do this with unpack?
......@@ -133,7 +133,7 @@ sub _test_fi_uart {
# portname Optional serial port to use
sub download_auto ($) {
my $msg;
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $testref, $portname, $intermediate_cb ) = @_;
my $fiji_tests = $self->{'fiji_tests'};
......@@ -225,7 +225,7 @@ sub download_auto ($) {
# after the test execution
# portname Optional serial port to use
sub download_random ($$$;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $testref, $portname, $intermediate_cb ) = @_;
my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
......@@ -277,7 +277,7 @@ sub download_random ($$$;$) {
# portname Optional serial port to use
sub download_manual ($;$) {
my $msg;
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $portname ) = @_;
......@@ -321,7 +321,7 @@ sub download_manual ($;$) {
# Params
#
sub _get_test_from_stdin {
my $logger = get_logger();
my $logger = get_logger("");
my ($self) = @_;
my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
......@@ -408,7 +408,7 @@ sub _get_test_from_stdin {
}
sub download_test ($$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $test, $portname ) = @_;
my $port = FIJI::Connection->init( $portname, $self->{'fiji_settings'}->{'design'}->{'BAUDRATE'} )
......@@ -440,7 +440,7 @@ sub update_rnd($) {
# test->{'TRIGGER'}
# port serial port to use
sub _download_test ($$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $test, $port ) = @_;
my $fiji_tests = $self->{'fiji_tests'};
......@@ -492,7 +492,7 @@ sub _download_test ($$) {
# Returns 1 if execution shall be halted and 0 otherwise
sub _check_halt ($) {
my $halt = 0;
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $recv_msg ) = @_;
my $fiji_tests = $self->{'fiji_tests'};
......
......@@ -86,7 +86,7 @@ sub new ($) {
}
sub read_file ($) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $filename ) = @_;
## Netlist synthesized from VHDL could contain SV keywords at this point.
......@@ -137,7 +137,7 @@ sub get_nets ($) {
}
sub _get_subnets ($$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $nets_ref, $mod, $hier ) = @_;
my $thishier = $hier;
......@@ -164,7 +164,7 @@ sub _get_subnets ($$) {
# name the name to check against
#
sub _check_name_in_hierarchy {
my $logger = get_logger();
my $logger = get_logger("");
my ( $startmod, $name ) = @_;
my $nl = $startmod->netlist;
......@@ -215,7 +215,7 @@ sub _check_name_in_hierarchy {
# index for ORIGINAL,MODIFIED and FAULT_DETECT: the index of this net
# (indent just for formatting output)
sub _add_port_to_hierarchy {
my $logger = get_logger();
my $logger = get_logger("");
my ( $startmod, $name, $function, $index, $indent ) = @_;
my $nl = $startmod->netlist;
my $direction = "undef";
......@@ -292,7 +292,7 @@ sub _add_port_to_hierarchy {
# port_name how the port shall be named (will be prefixed with "fiji_")
# index for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
sub net_add_function ($$$;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $net, $function, $port_name, $index ) = @_;
$logger->debug( "Adding function to " . $net->module->name . ", net " . $net->name );
......@@ -337,7 +337,7 @@ sub net_add_function ($$$;$) {
sub instrument_net ($$;$) {
#FIXME only works with single-bit pins/ports/nets
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $net, $fiu_idx, $driver ) = @_;
my $msg;
......@@ -479,7 +479,7 @@ sub instrument_net ($$;$) {
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
sub _validate_driver {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $net_path, $driver_path, $driver_type ) = @_;
my $connection_object = $self->get_connection_object( $driver_path, $driver_type );
......@@ -561,7 +561,7 @@ sub _connection_tostr($;$) {
}
sub get_connection_object($$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $connection_path, $connection_type ) = @_;
my $rv;
......@@ -618,7 +618,7 @@ sub get_connection_object($$) {
# -> connection_hashref->{'connected'} contains a list cells connected to the
# net but driver/driven cannot be decided
sub _get_net_connections ($$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $net, $connection_hashref ) = @_;
my $mod = $net->module;
......@@ -716,7 +716,7 @@ sub _get_net_connections ($$) {
#
sub export ($;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $filename, $id ) = @_;
open( my $fh_nl, ">", $filename );
......@@ -755,7 +755,7 @@ sub _export_module($) {
# FIXME do we need any additional Verilog Syntax (Interface, Modport)?
my $logger = get_logger();
my $logger = get_logger("");
my ($mod) = @_;
$logger->info( "Generating verilog text for module " . $mod->name );
......@@ -878,7 +878,7 @@ sub _export_module($) {
# to the net object corresponding to "netname" in module "module2"
#
sub splitnet ($) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $netpath ) = @_;
my $rv = {};
......
......@@ -50,7 +50,7 @@ my @base_resources;
# \returns The new settings instance or a string describing the reason
# why it could not be created.
sub new ($;$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $class, $phase, $fiji_ini_file, $existing_settings ) = @_;
my $fiji_settings_ref;
......@@ -91,7 +91,7 @@ sub new ($;$$) {
}
sub _export_value {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $k, $v_ref ) = @_;
if ( defined( $map_ref->{$k}->{'type'} ) ) {
......@@ -115,7 +115,7 @@ sub _export_value {
#
# \param fiji_ini_file The file name to write the FIJI Settings to.
sub save ($) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $fiji_ini_file ) = @_;
return "No file name given" if !defined($fiji_ini_file);
......@@ -199,7 +199,7 @@ sub save ($) {
#
# \returns a reference to the hash containing the read constants.
sub read_settingsfile ($$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $phase, $fiji_ini_file, $existing_settings ) = @_;
my $fiji_ini;
eval { $fiji_ini = new Config::Simple($fiji_ini_file) }; # pesky library tries to die on syntax errors
......@@ -327,7 +327,7 @@ sub set_fiu_defaults ($) {
## @function _set_defaults (%$map_ref, %$consts_ref)
# @brief Set defaults according to FIJI.pm.
sub _set_defaults {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref, $phase ) = @_;
foreach my $k ( keys( %{$map_ref} ) ) {
if ( exists( $map_ref->{$k}->{'default'} ) ) {
......@@ -367,7 +367,7 @@ sub validate_fiu_value {
# \param log_func (optional) the (log4perl) log function to use
# (defaul is \&Log::Log4perl::Logger::trace)
sub validate_value ($$$;$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $k, $v_ref, $old, $log_func ) = @_;
$log_func = \&Log::Log4perl::Logger::trace if !defined($log_func);
if ( defined( $map_ref->{$k}->{'type'} ) ) {
......@@ -465,7 +465,7 @@ sub validate_value ($$$;$$) {
#
# \returns $consts_ref, or undef on errors
sub _rename_import {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref ) = @_;
if ( ref($consts_ref) ne 'HASH' ) {
$logger->error("Parameter is not a reference to a hash (containing design constants).");
......@@ -501,7 +501,7 @@ sub _rename_import {
# \returns A new hash with all constants required in the FIU settings
# in sanitized form, or undef on errors.
sub _sanitize_fiu ($;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $fiu_ref, $phase ) = @_;
if ( ref($fiu_ref) ne 'HASH' ) {
my $msg = "Parameter is not a reference to a hash (containing FIU constants).";
......@@ -525,7 +525,7 @@ sub _disabled_via_dependency ($$$) {
}
sub _validate_hashmap ($$;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref, $phase ) = @_;
my @map_keys = keys( %{$map_ref} );
foreach my $entry_key ( keys( %{$consts_ref} ) ) {
......@@ -600,7 +600,7 @@ sub _validate_hashmap ($$;$) {
# \returns The given hash with all constants required in the design
# settings in sanitized form, or an error message.
sub _sanitize_design {
my $logger = get_logger();
my $logger = get_logger("");
my ( $consts_ref, $phase ) = @_;
if ( ref($consts_ref) ne 'HASH' ) {
my $msg = "Parameter is not a reference to a hash (containing design constants).";
......@@ -648,7 +648,7 @@ sub _log2 {
## Determined by experiment & fitted by scipy.optimize.curve_fit
#
sub _est_resources {
my $logger = get_logger();
my $logger = get_logger("");
my ( $FREQUENCY, $BAUD, $TIMER_WIDTH, $RESET_CYCLES, $LFSR_WIDTH, $FIU_NUM, $algo ) = @_;
# FIXME where do we put these values? they are likely to change if the VHDL
......@@ -740,7 +740,7 @@ sub _est_resources {
}
sub estimate_resources {
my $logger = get_logger();
my $logger = get_logger("");
my ($settings_ref) = @_;
my $consts_ref = $settings_ref->{'design'};
my $fiu_ref = $settings_ref->{'fius'};
......
......@@ -53,7 +53,7 @@ use File::Spec;
# \returns The new settings instance or a string describing the reason
# why it could not be created.
sub new ($;$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $class, $phase, $cfgs_per_msg, $fiu_num, $fiji_ini_file, $existing_settings, $num_tests ) = @_;
my $fiji_settings_ref = {};
......@@ -115,7 +115,7 @@ sub new ($;$$) {
}
sub _export_value {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $k, $v_ref ) = @_;
if ( defined( $map_ref->{$k}->{'type'} ) ) {
......@@ -139,7 +139,7 @@ sub _export_value {
#
# \param fiji_ini_file The file name to write the FIJI Settings to.
sub save ($) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $fiji_ini_file ) = @_;
return "No file name given" if !defined($fiji_ini_file);
......@@ -227,7 +227,7 @@ sub save ($) {
#
# \returns a reference to the hash containing the read constants.
sub read_settingsfile ($$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $phase, $fiji_ini_file, $existing_settings, $cfgs_per_msg, $fiu_num ) = @_;
my $fiji_ini;
my $global_settings_filename;
......@@ -394,7 +394,7 @@ sub set_test_defaults ($) {
## @function _set_defaults (%$map_ref, %$consts_ref)
# @brief Set defaults according to FIJI.pm.
sub _set_defaults {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref, $phase ) = @_;
foreach my $k ( keys( %{$map_ref} ) ) {
if ( exists( $map_ref->{$k}->{'default'} ) ) {
......@@ -434,7 +434,7 @@ sub validate_test_value {
# \param log_func (optional) the (log4perl) log function to use
# (defaul is \&Log::Log4perl::Logger::trace)
sub validate_value ($$$;$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $k, $v_ref, $old, $log_func ) = @_;
$log_func = \&Log::Log4perl::Logger::trace if !defined($log_func);
if ( defined( $map_ref->{$k}->{'type'} ) ) {
......@@ -536,7 +536,7 @@ sub validate_value ($$$;$$) {
#
# \returns $consts_ref, or undef on errors
sub _rename_import {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref ) = @_;
if ( ref($consts_ref) ne 'HASH' ) {
$logger->error("Parameter is not a reference to a hash (containing design constants).");
......@@ -572,7 +572,7 @@ sub _rename_import {
# \returns A new hash with all constants required in the TEST settings
# in sanitized form, or undef on errors.
sub _sanitize_test ($;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $testpatmap, $test_ref, $phase ) = @_;
if ( ref($test_ref) ne 'HASH' ) {
my $msg = "Parameter is not a reference to a hash (containing TEST constants).";
......@@ -596,7 +596,7 @@ sub _disabled_via_dependency ($$$) {
}
sub _validate_hashmap ($$;$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $map_ref, $consts_ref, $phase ) = @_;
my @map_keys = keys( %{$map_ref} );
foreach my $entry_key ( keys( %{$consts_ref} ) ) {
......@@ -656,7 +656,7 @@ sub _validate_hashmap ($$;$) {
# \returns The given hash with all constants required in the design
# settings in sanitized form, or an error message.
sub _sanitize_design {
my $logger = get_logger();
my $logger = get_logger("");
my ( $consts_ref, $phase ) = @_;
if ( ref($consts_ref) ne 'HASH' ) {
my $msg = "Parameter is not a reference to a hash (containing design constants).";
......@@ -692,7 +692,7 @@ sub _sanitize_design {
# TODO: validate generated sim script files in Questa
# makes use of random_force functionality.
sub export_as_sim_script ($$$$) {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $sim_file_name, $last_test, $num_repetitions, $global_settings_ref ) = @_;
my $script_text = "# Sim script generated " . localtime . "\nsource random_force.tcl\n";
......
......@@ -85,7 +85,7 @@ use constant FIJI_DEFAULTS => \%FIJI_DEFAULTS;
sub generate_config_package ($$) {
my ( $class, $fiji_settings_filename, $vhdl_filename ) = @_;
my $logger = get_logger();
my $logger = get_logger("");
my $name = $0;
$name =~ s/\.p[lm]//;
$logger->debug("=== generate_config_package ===");
......@@ -256,7 +256,7 @@ sub generate_wrapper_module ($) {
my $fiji_settings_filename = $wrapper_config->{'fiji_settings_filename'};
my $vhdl_filename = $wrapper_config->{'vhdl_filename'};
my $logger = get_logger();
my $logger = get_logger("");
my $name = $0;
$name =~ s/\.p[lm]//;
$logger->debug("=== generate_wrapper_module ===");
......
package Log::Dispatch::TkText;
use strict;
use warnings;
our $VERSION = '0.1';
use Log::Dispatch::Output;
use Tk::Font;
use base qw( Log::Dispatch::Output );
use Data::Dumper;
use Encode qw( encode );
use IO::Handle;
use Params::Validate qw(validate BOOLEAN);
Params::Validate::validation_options( allow_extra => 1 );
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my %p = validate(
@_, {
default_font => {
default => "Courier 10"
},
log4p_fonts => {
isa => 'HASH',
default => {
ERROR => "Courier 10 bold",
TRACE => "Courier 10 italic",
}
},
log4p_colors => {
isa => 'HASH',
default => {
TRACE => "black",
DEBUG => "black",
ERROR => "red",
WARN => "red",
INFO => "forest green",
}
},
loglevel_fonts => {
isa => 'HASH',
default => {
ERROR => "Courier 10 bold",
TRACE => "Courier 10 italic",
}
},
loglevel_colors => {
isa => 'HASH',
default => {
0 => "grey",
1 => "forest green",
2 => "red",
3 => "red",
}
},
widget => {
isa => 'Tk::Text',
},
utf8 => {
type => BOOLEAN,
default => 0,
},
}
);
my $self = bless \%p, $class;
$self->_basic_init(%p);
my $font = $p{'widget'}->configure(-font => $p{'default_font'});
foreach my $k (keys(%{$p{'log4p_colors'}})) {
$p{'widget'}->tagConfigure($k, -foreground => $p{'log4p_colors'}->{$k});
}
foreach my $k (keys(%{$p{'loglevel_colors'}})) {
$p{'widget'}->tagConfigure($k, -foreground => $p{'loglevel_colors'}->{$k});
}
foreach my $k (keys(%{$p{'log4p_fonts'}})) {
$p{'widget'}->tagConfigure($k, -font => $p{'log4p_fonts'}->{$k});
}
foreach my $k (keys(%{$p{'loglevel_fonts'}})) {
$p{'widget'}->tagConfigure($k, -font => $p{'loglevel_fonts'}->{$k});
}
return $self;
}
sub log_message {
my $self = shift;
my %p = @_;
my $message
= $self->{'utf8'} ? encode( 'UTF-8', $p{'message'} ) : $p{'message'};
if(defined $p{'log4p_level'} && defined $self->{'log4p_colors'}->{$p{'log4p_level'}}) {
$self->{'widget'}->insert('end',$p{'message'}, $p{'log4p_level'});
} elsif (defined $p{'level'} && defined $self->{'loglevel_colors'}->{$p{'level'}}) {
$self->{'widget'}->insert('end',$p{'message'}, $p{'level'});
} else {
$self->{'widget'}->insert('end',$p{'message'});
}
$self->{'widget'}->yview('end');
}
1;
# ABSTRACT: Object for logging to the specified Tk::Text widget
__END__
=pod
=head1 NAME
Log::Dispatch::TkText - Object for logging to the screen
\ No newline at end of file
......@@ -69,7 +69,7 @@ my $fiu_dv_base_y = $fiu0_base_y - 0.8 * $fiu_height;
my $fiu_lfsr_base_y = $fiu0_base_y - 1.2 * $fiu_height;
sub Populate {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $args ) = @_;
my $settings_ref = delete $args->{'-settings_ref'};
......@@ -94,7 +94,7 @@ sub Populate {
}
sub settings_ref {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $settings_ref ) = @_;
if ( ref($$settings_ref) eq "FIJI::Settings" ) {
......
......@@ -60,7 +60,7 @@ sub ClassInit {
}
sub Populate {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $args ) = @_;
my $settings = delete $args->{'-settings'};
$self->{'documentation_path'} = delete $args->{'-documentation_path'};
......@@ -92,7 +92,7 @@ sub Populate {
}
sub netlist {
my $logger = get_logger();
my $logger = get_logger("");
my ( $self, $netlist ) = @_;
if ( defined($netlist) ) {
if ( ref($netlist) ne 'FIJI::Netlist' ) {