Settings.pm 5.73 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
## @file [Settings.pm]

## @class [FIJI::Settings]
#
# Contains helper functions to deal with FIJI configuration files.
package FIJI::Settings;

use Log::Log4perl qw(get_logger);
use Scalar::Util "looks_like_number";
use Config::Simple;

12
13
use FIJI qw(:all);

14
15
16
17
18
19
20
21
22
23
## @function read_configfile ($fiji_cfg_file)
# @brief Load the configuration file containing design constants.
#
# \param fiji_cfg_file The name of an .ini file with a 'consts' block
#        containing the constants specified by \ref _sanitize_consts.
#
# \returns a reference to the hash containing the read constants.
sub read_configfile {
  my $logger = get_logger();
  my ($fiji_cfg_file) = @_;
24
25
  my $fiji_cfg;
  eval { $fiji_cfg = new Config::Simple($fiji_cfg_file) }; # pesky library tries to die on syntax errors
26
  if (!defined($fiji_cfg)) {
27
    $logger->fatal("Could not read config file \"$fiji_cfg_file\": " . (defined($@) ? $@ : Config::Simple->error()));
28
29
30
31
32
33
34
35
36
    return undef;
  }

  my $fiji_consts = $fiji_cfg->get_block("consts");
  if (!(%$fiji_consts)) {
    $logger->fatal("Could not fetch consts block from config file \"$fiji_cfg_file\"");
    return undef;
  }

37
38
  $fiji_consts = _sanitize_consts($fiji_consts);
  if (!defined($fiji_consts)) {
39
40
41
42
43
44
45
    $logger->error("Constants in fiji configuration invalid");
  }
  return $fiji_consts;
}


## @function _sanitize_consts (%$consts_ref)
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
# @brief Convert and sanity check FIJI Settings.
#
# This function takes a hash of FIJI Settings and converts it to the
# respective internal representation. This allows to use different
# names in the external file than within the implementation.
#
# First, this function sets some default values for missing constants if
# there is a default stored for the respective constant in FIJI.pm.
# If there is no default available it has to be a mandatory value and
# hence the function returns non-0 in that case.
#
# ARM_DURATION_WIDTH and INJECT_DURATION_WIDTH are handled different because
# they are no official FIJI Settings because there is only a single timer
# (yet). However, the Perl implementation supports independet timer widths
# named as above. If they are not given in consts_ref then the value of
# TIMER_WIDTH is used. If that is not given either the default value for
# TIMER_WIDTH is used.
#
# The second part of the function deals with sanity checks for the values
# themselves. It checks for the following conditions:
66
67
68
#
#   - FIU_NUM: > 0
#   - FIU_CFG_BITS: > 0
69
#   - ARM_DURATION_WIDTH, INJECT_DURATION_WIDTH: > 0, multiple of 8
70
71
72
#   - ID: > 0, < 2^15-1
#   - BAUDRATE: > 0
#
73
74
75
76
# \param consts_ref a reference to a hash containing some FIJI Settings
#
# \returns A new hash with all required constants in sanitized form,
#          or undef on errors.
77
78
79
80
sub _sanitize_consts {
  my $logger = get_logger();
  my ($consts_ref) = @_;
  if (ref($consts_ref) ne 'HASH') {
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
    $logger->error("Parameter is not a reference to a hash (containing FIJI constants).");
    return undef;
  }

  # Special cases of defaults handled separately here.
  # Set ARM_DURATION_WIDTH and INJECT_DURATION_WIDTH to TIMER_WIDTH (or its default)
  foreach my $k ('ARM_DURATION_WIDTH', 'INJECT_DURATION_WIDTH') {
    if (!exists($consts_ref->{CONSTS->{$k}->{name}})) {
      if (exists($consts_ref->{'TIMER_WIDTH'})) {
        $consts_ref->{CONSTS->{$k}->{name}} = $consts_ref->{'TIMER_WIDTH'};
        $logger->trace(sprintf("Using TIMER_WIDTH value as default for %s (%s).", CONSTS->{$k}->{name}, $consts_ref->{'TIMER_WIDTH'}));
      } else {
        $consts_ref->{CONSTS->{$k}->{name}} = TIMER_WIDTH->{'default'};
        $logger->trace(sprintf("Using TIMER_WIDTH default as default for %s (%s).", CONSTS->{$k}->{name}, TIMER_WIDTH->{default}));
      }
    }
97
98
  }

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
  my $new_consts = {};
  # Iterating over CONSTS hash from FIJI.pm and set defaults if need be
  foreach my $k (keys(CONSTS)) {
    my $ini_name = CONSTS->{$k}->{name};
    if (exists($consts_ref->{$ini_name})) {
      $new_consts->{$k} = $consts_ref->{$ini_name};
      $logger->trace(sprintf("Copying setting %s (%s) = %s.", $k, $ini_name, $consts_ref->{$ini_name}));
    } else {
      if (defined(CONSTS->{$k}->{default})) {
        $new_consts->{$k} = CONSTS->{$k}->{default};
        $logger->trace(sprintf("Adding default constant: %s (%s) = %s.", $k, CONSTS->{$k}->{name}, CONSTS->{$k}->{default}));
      } else {
        $logger->error(sprintf("%s is missing from FIJI constants.", CONSTS->{$k}->{name}));
        return undef;
      }
114
115
116
    }

    # convert non-decimal (hexadecimal, binary, octal) values to decimal
117
118
119
120
    my $orig = $new_consts->{$k};
    $new_consts->{$k} = oct($orig) if $orig =~ /^0/;
    $logger->trace("Converted value of $k (\"$orig\") to \"$new_consts->{$k}\".") if ($orig ne $new_consts->{$k});
    if (!looks_like_number($new_consts->{$k})) {
121
      $logger->error("$orig does not look like a number.");
122
      return undef;
123
124
125
    }
  }

126
127
  # check for sane values
  if (($new_consts->{FIU_NUM} <= 0)) {
128
      $logger->error("FIU_NUM is <= 0.");
129
      return undef;
130
  }
131
  if (($new_consts->{FIU_CFG_BITS} <= 0)) {
132
      $logger->error("FIU_CFG_BITS is <= 0.");
133
      return undef;
134
  }
135
136
137
  if (($new_consts->{ARM_DURATION_WIDTH} <= 0) || ($new_consts->{ARM_DURATION_WIDTH} % 8 != 0)) {
      $logger->error("ARM_DURATION_WIDTH is invalid ($new_consts->{ARM_DURATION_WIDTH}).");
      return undef;
138
  }
139
140
141
  if (($new_consts->{INJECT_DURATION_WIDTH} <= 0) || (($new_consts->{INJECT_DURATION_WIDTH} % 8) != 0)) {
      $logger->error("INJECT_DURATION_WIDTH is invalid ($new_consts->{INJECT_DURATION_WIDTH}).");
      return undef;
142
  }
143
144
145
  if (($new_consts->{ID} <= 0) || ($new_consts->{ID} > (2**15 - 1))) {
      $logger->error("ID is invalid ($new_consts->{ID}).");
      return undef;
146
  }
147
  if (($new_consts->{BAUDRATE} <= 0)) {
148
      $logger->error("BAUDRATE missing is <= 0.");
149
      return undef;
150
  }
151
  return $new_consts;
152
153
154
}

1;