summaryrefslogtreecommitdiff
path: root/lib/Kratos
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kratos')
-rw-r--r--lib/Kratos/DFADriver.pm204
-rw-r--r--lib/Kratos/DFADriver/DFA.pm42
-rw-r--r--lib/Kratos/DFADriver/Model.pm181
3 files changed, 226 insertions, 201 deletions
diff --git a/lib/Kratos/DFADriver.pm b/lib/Kratos/DFADriver.pm
index ea37956..8c8f780 100644
--- a/lib/Kratos/DFADriver.pm
+++ b/lib/Kratos/DFADriver.pm
@@ -63,9 +63,9 @@ sub set_paths {
}
sub set_output {
- my ($self, $mode) = @_;
+ my ( $self, $mode ) = @_;
- if ($mode eq 'tex') {
+ if ( $mode eq 'tex' ) {
$self->{tex} = 1;
}
@@ -193,37 +193,37 @@ sub printf_aggr {
}
sub printf_counter_status {
- my ($self, $hash, $key) = @_;
+ my ( $self, $hash, $key ) = @_;
$hash = $hash->{$key};
- if (2 ** 32 / $hash->{median} < 10e6) {
- printf(" %s: 32bit energy counter will overflow after %.f ms\n",
- 'power', (2 ** 32 / $hash->{median}) / 1000);
+ if ( 2**32 / $hash->{median} < 10e6 ) {
+ printf( " %s: 32bit energy counter will overflow after %.f ms\n",
+ 'power', ( 2**32 / $hash->{median} ) / 1000 );
}
}
sub printf_aggr_tex {
- my ( $self, $hash, $key, $unit, $divisor) = @_;
+ my ( $self, $hash, $key, $unit, $divisor ) = @_;
$hash = $hash->{$key};
- if ($unit eq 'ms' and $hash->{median} < 1e3) {
- $unit = '\us';
+ if ( $unit eq 'ms' and $hash->{median} < 1e3 ) {
+ $unit = '\us';
$divisor = 1;
}
- elsif ($unit eq '\uJ' and $hash->{median} < 1e6) {
- $unit = 'nJ';
+ elsif ( $unit eq '\uJ' and $hash->{median} < 1e6 ) {
+ $unit = 'nJ';
$divisor = 1e3;
}
- elsif ($unit eq '\uW' and $hash->{median} >= 1e3) {
- $unit = 'mW';
+ elsif ( $unit eq '\uW' and $hash->{median} >= 1e3 ) {
+ $unit = 'mW';
$divisor = 1e3;
}
use locale;
- printf(' & & \unit[%.3g]{%s}', $hash->{median} / $divisor, $unit);
+ printf( ' & & \unit[%.3g]{%s}', $hash->{median} / $divisor, $unit );
}
sub printf_count_tex {
@@ -232,7 +232,7 @@ sub printf_count_tex {
if ($hash) {
$hash = $hash->{$key};
- printf(' & %d', $hash->{count});
+ printf( ' & %d', $hash->{count} );
}
else {
printf(' & ');
@@ -240,25 +240,25 @@ sub printf_count_tex {
}
sub printf_eval_tex {
- my ( $self, $hash, $key, $unit, $divisor) = @_;
+ my ( $self, $hash, $key, $unit, $divisor ) = @_;
$hash = $hash->{$key};
- if ($unit eq 'ms' and $hash->{median_goodness}{mae} < 1e3) {
- $unit = '\us';
+ if ( $unit eq 'ms' and $hash->{median_goodness}{mae} < 1e3 ) {
+ $unit = '\us';
$divisor = 1;
}
- if ($unit eq '\uJ' and $hash->{median_goodness}{mae} < 1e6) {
- $unit = 'nJ';
+ if ( $unit eq '\uJ' and $hash->{median_goodness}{mae} < 1e6 ) {
+ $unit = 'nJ';
$divisor = 1e3;
}
use locale;
- printf("\n%20s & \\unit[%.3g]{%s} & \\unit[%.2g]{\\%%}",
- q{},
- $hash->{median_goodness}{mae} / $divisor, $unit,
- $hash->{median_goodness}{smape} // -1
+ printf(
+ "\n%20s & \\unit[%.3g]{%s} & \\unit[%.2g]{\\%%}",
+ q{}, $hash->{median_goodness}{mae} / $divisor,
+ $unit, $hash->{median_goodness}{smape} // -1
);
}
@@ -292,16 +292,14 @@ sub printf_online_goodness {
if ( exists $hash->{goodness}->{smape} ) {
printf(
-" %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
- $key, $hash->{median},
- $hash->{mean}, $unit,
- $hash->{goodness}->{mae}, $unit,
- $hash->{goodness}{smape}
+ " %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
+ $key, $hash->{median}, $hash->{mean}, $unit,
+ $hash->{goodness}->{mae},
+ $unit, $hash->{goodness}{smape}
);
}
else {
- printf(
-" %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
+ printf( " %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
$key, $hash->{median}, $hash->{mean}, $unit,
$hash->{goodness}->{mae}, $unit );
}
@@ -337,11 +335,11 @@ sub printf_parameterized {
if ( $std_global > 0 ) {
$param_ratio = $std_ind_param / $std_global;
- if (defined $std_ind_arg) {
+ if ( defined $std_ind_arg ) {
$arg_ratio = $std_ind_arg / $std_global;
}
}
- if ( $std_ind_param > 0) {
+ if ( $std_ind_param > 0 ) {
$trace_ratio = $std_ind_trace / $std_ind_param;
}
@@ -365,24 +363,23 @@ sub printf_parameterized {
$param_ratio ? $param_ratio : 0 );
}
- if ( defined $std_ind_arg and $std_global > 10
+ if ( defined $std_ind_arg
+ and $std_global > 10
and $arg_ratio < 0.5
and not exists $hash->{function}{user_arg} )
{
printf( " %s: depends on arguments (%.2f / %.2f = %.3f)\n",
$key, $std_ind_arg, $std_global, $arg_ratio );
}
- if ( defined $std_ind_arg and
- (
- $std_global < 10
- or $arg_ratio > 0.5
- )
+ if (
+ defined $std_ind_arg
+ and ( $std_global < 10
+ or $arg_ratio > 0.5 )
and exists $hash->{function}{user_arg}
)
{
printf( " %s: should not depend on arguments (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_arg, $std_global,
- $arg_ratio ? $arg_ratio : 0 );
+ $key, $std_ind_arg, $std_global, $arg_ratio ? $arg_ratio : 0 );
}
if ( $std_global > 10 and $trace_ratio < 0.5 ) {
@@ -423,22 +420,22 @@ sub printf_parameterized {
if ( $ratio < 0.6 ) {
$status = 'might depend';
$fline = q{, probably };
- $fline .= join( ' or ', $self->assess_fits( $hash, $arg, 'arg_fit_guess' ) );
+ $fline .= join( ' or ',
+ $self->assess_fits( $hash, $arg, 'arg_fit_guess' ) );
}
if ( $ratio < 0.3 ) {
$status = 'depends';
}
if ($fline) {
printf( " %s: %s on local %s (%.2f / %.2f = %.3f%s)\n",
- $key, $status, $arg, $std_ind_arg, $std_this, $ratio,
- $fline );
+ $key, $status, $arg, $std_ind_arg, $std_this, $ratio, $fline );
}
}
for my $transition ( sort keys %{$std_by_trace} ) {
my $std_this = $std_by_trace->{$transition};
- my $ratio = $std_ind_trace / $std_this;
- if ($ratio < 0.4) {
+ my $ratio = $std_ind_trace / $std_this;
+ if ( $ratio < 0.4 ) {
printf(
" %s: depends on presence of %s in trace (%.2f / %.2f = %.3f)\n",
$key, $transition, $std_ind_trace, $std_this, $ratio );
@@ -450,7 +447,7 @@ sub printf_fit {
my ( $self, $hash, $key, $unit ) = @_;
$hash = $hash->{$key};
- for my $funtype (sort keys %{$hash->{function}}) {
+ for my $funtype ( sort keys %{ $hash->{function} } ) {
if ( exists $hash->{function}{$funtype}{error} ) {
printf( " %s: %s function could not be fitted: %s\n",
$key, $funtype, $hash->{function}{$funtype}{error} );
@@ -465,18 +462,21 @@ sub printf_fit {
}
}
- for my $pair (['param_mean_goodness', 'param mean/ssr-fit'],
- ['param_median_goodness', 'param median/static'],
- ['arg_mean_goodness', 'arg mean/ssr-fit'],
- ['arg_median_goodness', 'arg median/static']) {
- my ($goodness, $desc) = @{$pair};
+ for my $pair (
+ [ 'param_mean_goodness', 'param mean/ssr-fit' ],
+ [ 'param_median_goodness', 'param median/static' ],
+ [ 'arg_mean_goodness', 'arg mean/ssr-fit' ],
+ [ 'arg_median_goodness', 'arg median/static' ]
+ )
+ {
+ my ( $goodness, $desc ) = @{$pair};
if ( exists $hash->{$goodness} ) {
printf(
" %s: %s LUT error: %.2f%% / %.f %s / %.f\n",
$key, $desc,
$hash->{$goodness}{smape} // -1,
- $hash->{$goodness}{mae}, $unit,
- $hash->{$goodness}{rmsd}
+ $hash->{$goodness}{mae},
+ $unit, $hash->{$goodness}{rmsd}
);
}
}
@@ -502,7 +502,7 @@ sub assess_model {
printf( "Assessing %s:\n", $name );
$self->printf_clip($transition);
- $self->printf_aggr( $transition, 'duration', 'µs' );
+ $self->printf_aggr( $transition, 'duration', 'µs' );
$self->printf_parameterized( $transition, 'duration' );
$self->printf_fit( $transition, 'duration', 'µs' );
$self->printf_aggr( $transition, 'energy', 'pJ' );
@@ -534,7 +534,7 @@ sub assess_model_tex {
for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
my $state = $self->{log}{aggregate}{state}{$name};
- printf("\n%20s", $name);
+ printf( "\n%20s", $name );
$self->printf_aggr_tex( $state, 'power', '\uW', 1 );
$self->printf_eval_tex( $state, 'power', '\uW', 1 );
@@ -548,18 +548,18 @@ sub assess_model_tex {
for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
my $transition = $self->{log}{aggregate}{transition}{$name};
- printf("\n%20s", $name);
+ printf( "\n%20s", $name );
- $self->printf_aggr_tex( $transition, 'energy', '\uJ', 1e6 );
+ $self->printf_aggr_tex( $transition, 'energy', '\uJ', 1e6 );
$self->printf_aggr_tex( $transition, 'rel_energy_prev', '\uJ', 1e6 );
$self->printf_aggr_tex( $transition, 'rel_energy_next', '\uJ', 1e6 );
- $self->printf_aggr_tex( $transition, 'duration', 'ms', 1e3 );
+ $self->printf_aggr_tex( $transition, 'duration', 'ms', 1e3 );
$self->printf_count_tex( $transition, 'energy' );
print " \\\\";
- $self->printf_eval_tex( $transition, 'energy', '\uJ', 1e6 );
+ $self->printf_eval_tex( $transition, 'energy', '\uJ', 1e6 );
$self->printf_eval_tex( $transition, 'rel_energy_prev', '\uJ', 1e6 );
$self->printf_eval_tex( $transition, 'rel_energy_next', '\uJ', 1e6 );
- $self->printf_eval_tex( $transition, 'duration', 'ms', 1e3 );
+ $self->printf_eval_tex( $transition, 'duration', 'ms', 1e3 );
$self->printf_count_tex;
print " \\\\";
}
@@ -568,7 +568,7 @@ sub assess_model_tex {
}
sub assess_workload {
- my ($self, $workload) = @_;
+ my ( $self, $workload ) = @_;
$workload =~ s{ \s* \) \s* ; \s* }{:}gx;
$workload =~ s{ \s* \) \s* $ }{}gx;
@@ -585,7 +585,7 @@ sub assess_workload {
sub update_model {
my ($self) = @_;
- for my $name (sort keys %{ $self->{log}{aggregate}{state} }) {
+ for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
my $state = $self->{log}{aggregate}{state}{$name};
$self->model->set_state_power( $name, $state->{power}{median} );
for my $fname ( keys %{ $state->{power}{function} } ) {
@@ -595,36 +595,44 @@ sub update_model {
@{ $state->{power}{function}{$fname}{params} }
);
}
- if ($self->{with_lut}) {
- $self->model->set_state_lut( $name, 'power', $state->{power}{median_by_param} );
+ if ( $self->{with_lut} ) {
+ $self->model->set_state_lut( $name, 'power',
+ $state->{power}{median_by_param} );
}
}
- for my $name (sort keys %{ $self->{log}{aggregate}{transition} }) {
+ for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
my $transition = $self->{log}{aggregate}{transition}{$name};
- my @keys = (qw(duration energy rel_energy_prev rel_energy_next));
+ my @keys = (qw(duration energy rel_energy_prev rel_energy_next));
- if ($self->model->get_transition_by_name($name)->{level} eq 'epilogue') {
- push(@keys, 'timeout');
+ if (
+ $self->model->get_transition_by_name($name)->{level} eq 'epilogue' )
+ {
+ push( @keys, 'timeout' );
}
for my $key (@keys) {
- $self->model->set_transition_property(
- $name, $key, $transition->{$key}{median}
- );
+ $self->model->set_transition_property( $name, $key,
+ $transition->{$key}{median} );
for my $fname ( keys %{ $transition->{$key}{function} } ) {
$self->model->set_transition_params(
- $name, $key, $fname,
+ $name,
+ $key,
+ $fname,
$transition->{$key}{function}{$fname}{raw},
@{ $transition->{$key}{function}{$fname}{params} }
);
}
- if ($self->{with_lut}) {
- $self->model->set_transition_lut( $name, $key, $transition->{$key}{median_by_param} );
+ if ( $self->{with_lut} ) {
+ $self->model->set_transition_lut( $name, $key,
+ $transition->{$key}{median_by_param} );
}
}
}
- $self->model->set_voltage($self->{log}{aggregate}{min_voltage}, $self->{log}{aggregate}{max_voltage});
+ $self->model->set_voltage(
+ $self->{log}{aggregate}{min_voltage},
+ $self->{log}{aggregate}{max_voltage}
+ );
$self->model->save;
}
@@ -769,15 +777,22 @@ sub to_cc {
my @state_enum = $self->model->get_state_enum;
my %param_default;
- for my $default_setting (@{$self->{param_default}}) {
- my ($param, $value) = split(qr{ = }x, $default_setting);
+ for my $default_setting ( @{ $self->{param_default} } ) {
+ my ( $param, $value ) = split( qr{ = }x, $default_setting );
$param_default{$param} = $value;
}
- my $buf
- = "DFA_Driver::power_uW_t ${class_name}::statepower[] = {"
- . join( ', ', map { sprintf('%.f', $self->model->get_state_power_with_params($_, \%param_default)) } @state_enum )
- . "};\n";
+ my $buf = "DFA_Driver::power_uW_t ${class_name}::statepower[] = {" . join(
+ ', ',
+ map {
+ sprintf(
+ '%.f',
+ $self->model->get_state_power_with_params(
+ $_, \%param_default
+ )
+ )
+ } @state_enum
+ ) . "};\n";
return $buf;
}
@@ -922,6 +937,7 @@ EOF
for my $run (@runs) {
$buf .= "\t\t/* test run $run->{id} start */\n";
$buf .= "\t\t${instance}.resetLogging();\n";
+
# $buf .= "\t\t${instance}.resetAccounting();\n"; # TODO sinnvoll?
my $state = 0;
for my $transition ( grep { $_->{isa} eq 'transition' }
@@ -1079,7 +1095,7 @@ sub archive_files {
);
my $filename = "../data/$self->{lp}{timestamp}_$self->{class_name}";
- if ($self->{filename_suffix}) {
+ if ( $self->{filename_suffix} ) {
$filename .= '_' . $self->{filename_suffix};
}
$filename .= '.tar';
@@ -1261,7 +1277,7 @@ sub merged_json {
my $idx = 0;
assert_is( $traces[$trace_idx]{id}, $run->{id} );
- push(@{$traces[$trace_idx]{total_energy}}, $run->{total_energy});
+ push( @{ $traces[$trace_idx]{total_energy} }, $run->{total_energy} );
for my $online_obj ( @{ $run->{trace} } ) {
my $plan_obj = $traces[$trace_idx]{trace}[$idx];
@@ -1287,16 +1303,20 @@ sub merged_json {
}
}
else {
- if ($online_obj->{isa} ne $plan_obj->{isa}) {
- printf("Log merge: ISA mismatch (should be %s, is %s) at index %d#%d\n",
- $plan_obj->{isa}, $online_obj->{isa}, $trace_idx, $idx);
+ if ( $online_obj->{isa} ne $plan_obj->{isa} ) {
+ printf(
+"Log merge: ISA mismatch (should be %s, is %s) at index %d#%d\n",
+ $plan_obj->{isa}, $online_obj->{isa}, $trace_idx,
+ $idx );
$self->mimosa->kill;
exit(1);
}
if ( $plan_obj->{name} ne 'UNINITIALIZED' ) {
- if ($online_obj->{name} ne $plan_obj->{name}) {
- printf("Log merge: name mismatch (should be %s, is %s) at index %d#%d\n",
- $plan_obj->{name}, $online_obj->{name}, $trace_idx, $idx);
+ if ( $online_obj->{name} ne $plan_obj->{name} ) {
+ printf(
+"Log merge: name mismatch (should be %s, is %s) at index %d#%d\n",
+ $plan_obj->{name}, $online_obj->{name}, $trace_idx,
+ $idx );
$self->mimosa->kill;
exit(1);
}
@@ -1348,8 +1368,8 @@ sub launchpad_parse_line {
push(
@{ $self->{lp}{log} },
{
- id => $self->{lp}{run_id},
- trace => [ @{ $self->{lp}{run} } ],
+ id => $self->{lp}{run_id},
+ trace => [ @{ $self->{lp}{run} } ],
total_energy => 0 + $+{total_e},
}
);
diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm
index c17e054..33d96c3 100644
--- a/lib/Kratos/DFADriver/DFA.pm
+++ b/lib/Kratos/DFADriver/DFA.pm
@@ -97,7 +97,7 @@ sub dfa {
}
sub run_str_to_trace {
- my ($self, $run_str) = @_;
+ my ( $self, $run_str ) = @_;
my @trace;
my $dfa = $self->dfa;
my %param = $self->model->parameter_hash;
@@ -117,13 +117,12 @@ sub run_str_to_trace {
name => $state_name,
plan => {
time => $prev_transition->{timeout}{static}
- // $state_duration,
+ // $state_duration,
power => $self->model->get_state_power($state_name),
energy => $self->model->get_state_power($state_name)
- * $state_duration,
+ * $state_duration,
},
- parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
+ parameter => { map { $_ => $param{$_}{value} } keys %param, },
},
{
isa => 'transition',
@@ -135,8 +134,7 @@ sub run_str_to_trace {
energy => $transition->{energy}{static},
timeout => $transition->{timeout}{static},
},
- parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
+ parameter => { map { $_ => $param{$_}{value} } keys %param, },
},
);
@@ -144,16 +142,13 @@ sub run_str_to_trace {
($state) = $dfa->successors( $state, ":${transition_str}" );
- if (not defined $state) {
+ if ( not defined $state ) {
die("Transition $transition_str is invalid or has no successors\n");
}
$prev_transition = $transition;
for my $extra_cmd (
- $self->model->get_state_extra_transitions(
- $state_enum[$state]
- )
- )
+ $self->model->get_state_extra_transitions( $state_enum[$state] ) )
{
$state_name = $self->reduced_id_to_state($state);
$transition = $self->model->get_transition_by_name($extra_cmd);
@@ -164,13 +159,13 @@ sub run_str_to_trace {
name => $state_name,
plan => {
time => $prev_transition->{timeout}{static}
- // $state_duration,
- power => $self->model->get_state_power($state_name),
+ // $state_duration,
+ power => $self->model->get_state_power($state_name),
energy => $self->model->get_state_power($state_name)
- * $state_duration,
+ * $state_duration,
},
parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
+ { map { $_ => $param{$_}{value} } keys %param, },
},
{
isa => 'transition',
@@ -183,7 +178,7 @@ sub run_str_to_trace {
timeout => $transition->{timeout}{static},
},
parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
+ { map { $_ => $param{$_}{value} } keys %param, },
}
);
$prev_transition = $transition;
@@ -192,11 +187,10 @@ sub run_str_to_trace {
# required for unscheduled extra states and transitions caused by interrupts
$trace[-1]{final_parameter}
- = { map { $_ => $param{$_}{value} } keys %param, };
+ = { map { $_ => $param{$_}{value} } keys %param, };
return @trace;
}
-
sub traces {
my ($self) = @_;
@@ -208,9 +202,9 @@ sub traces {
return @{ $self->{traces} };
}
- my $max_iter = $self->{trace_revisit} // 2;
- my $next = $self->dfa->new_deepdft_string_generator($max_iter);
- my $trace_id = 1;
+ my $max_iter = $self->{trace_revisit} // 2;
+ my $next = $self->dfa->new_deepdft_string_generator($max_iter);
+ my $trace_id = 1;
my ( @raw_runs, @traces );
my $filter_re;
@@ -222,7 +216,7 @@ sub traces {
$re =~ s{,}{![^:]*:}g;
$re =~ s{$}{![^:]*)};
$re =~ s{^}{(^};
- if ($re =~ m{ \$ }x) {
+ if ( $re =~ m{ \$ }x ) {
$re =~ s{\$}{};
$re =~ s{\)$}{\$)};
}
@@ -255,7 +249,7 @@ sub traces {
id => $trace_id,
trace => [@trace],
}
- );
+ );
$trace_id++;
}
diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
index b602e2c..677fd99 100644
--- a/lib/Kratos/DFADriver/Model.pm
+++ b/lib/Kratos/DFADriver/Model.pm
@@ -33,15 +33,13 @@ sub new {
}
sub parse_xml_property {
- my ($self, $node, $property_name) = @_;
+ my ( $self, $node, $property_name ) = @_;
my $xml = $self->{xml};
- my $ret = {
- static => 0
- };
+ my $ret = { static => 0 };
my ($property_node) = $node->findnodes("./${property_name}");
- if (not $property_node) {
+ if ( not $property_node ) {
return $ret;
}
@@ -49,34 +47,34 @@ sub parse_xml_property {
$ret->{static} = 0 + $static_node->textContent;
}
for my $function_node ( $property_node->findnodes('./function/*') ) {
- my $name = $function_node->nodeName;
+ my $name = $function_node->nodeName;
my $function = $function_node->textContent;
$function =~ s{^ \n* \s* }{}x;
$function =~ s{\s* \n* $}{}x;
$function =~ s{ [\n\t]+ }{}gx;
- $ret->{function}{$name}{raw} = $function;
+ $ret->{function}{$name}{raw} = $function;
$ret->{function}{$name}{node} = $function_node;
my $param_idx = 0;
while ( $function_node->hasAttribute("param${param_idx}") ) {
- push( @{ $ret->{function}{$name}{params} },
- $function_node->getAttribute("param${param_idx}") );
+ push(
+ @{ $ret->{function}{$name}{params} },
+ $function_node->getAttribute("param${param_idx}")
+ );
$param_idx++;
}
}
for my $lut_node ( $property_node->findnodes('./lut/*') ) {
my @paramkey = map { $_->[0]->getValue }
- sort { $a->[1] cmp $b->[1] }
- map { [ $_, $_->nodeName ] }
- @{$lut_node->attributes->nodes};
- $ret->{lut}{join(';', @paramkey)} = 0 + $lut_node->textContent;
+ sort { $a->[1] cmp $b->[1] }
+ map { [ $_, $_->nodeName ] } @{ $lut_node->attributes->nodes };
+ $ret->{lut}{ join( ';', @paramkey ) } = 0 + $lut_node->textContent;
}
return $ret;
}
-
sub parse_xml {
my ($self) = @_;
@@ -90,7 +88,7 @@ sub parse_xml {
my $name = $state_node->getAttribute('name');
my $power = $state_node->getAttribute('power') // 0;
$self->{states}{$name} = {
- power => $self->parse_xml_property($state_node, 'power'),
+ power => $self->parse_xml_property( $state_node, 'power' ),
id => $state_index,
node => $state_node,
};
@@ -139,19 +137,22 @@ sub parse_xml {
}
my $transition = {
- name => $transition_node->getAttribute('name'),
- duration => $self->parse_xml_property($transition_node, 'duration'),
- energy => $self->parse_xml_property($transition_node, 'energy'),
- rel_energy_prev => $self->parse_xml_property($transition_node, 'rel_energy_prev'),
- rel_energy_next => $self->parse_xml_property($transition_node, 'rel_energy_next'),
- timeout => $self->parse_xml_property($transition_node, 'timeout'),
- parameters => [@parameters],
- origins => [@source_states],
- destination => $dst_node->textContent,
- level => $level_node->textContent,
- id => $transition_index,
- affects => {%affects},
- node => $transition_node,
+ name => $transition_node->getAttribute('name'),
+ duration =>
+ $self->parse_xml_property( $transition_node, 'duration' ),
+ energy => $self->parse_xml_property( $transition_node, 'energy' ),
+ rel_energy_prev =>
+ $self->parse_xml_property( $transition_node, 'rel_energy_prev' ),
+ rel_energy_next =>
+ $self->parse_xml_property( $transition_node, 'rel_energy_next' ),
+ timeout => $self->parse_xml_property( $transition_node, 'timeout' ),
+ parameters => [@parameters],
+ origins => [@source_states],
+ destination => $dst_node->textContent,
+ level => $level_node->textContent,
+ id => $transition_index,
+ affects => {%affects},
+ node => $transition_node,
};
push( @{ $self->{transitions} }, $transition );
@@ -183,18 +184,20 @@ sub parse_xml {
}
sub reset_property {
- my ($self, $node, $name) = @_;
+ my ( $self, $node, $name ) = @_;
my ($property_node) = $node->findnodes("./${name}");
if ($property_node) {
- for my $attr_node ($property_node->findnodes('./static | ./lut')) {
+ for my $attr_node ( $property_node->findnodes('./static | ./lut') ) {
$property_node->removeChild($attr_node);
}
- for my $function_parent ($property_node->findnodes('./function')) {
- for my $function_node ($function_parent->childNodes) {
- if ($function_node->nodeName eq 'user' or $function_node->nodeName eq 'user_arg') {
- for my $attrnode ($function_node->attributes) {
+ for my $function_parent ( $property_node->findnodes('./function') ) {
+ for my $function_node ( $function_parent->childNodes ) {
+ if ( $function_node->nodeName eq 'user'
+ or $function_node->nodeName eq 'user_arg' )
+ {
+ for my $attrnode ( $function_node->attributes ) {
$attrnode->setValue(1);
}
}
@@ -209,15 +212,17 @@ sub reset_property {
sub reset {
my ($self) = @_;
- for my $state (values %{$self->{states}}) {
+ for my $state ( values %{ $self->{states} } ) {
for my $property (qw(power)) {
- $self->reset_property($state->{node}, $property);
+ $self->reset_property( $state->{node}, $property );
}
}
- for my $transition (@{$self->{transitions}}) {
- for my $property (qw(duration energy rel_energy_prev rel_energy_next timeout)) {
- $self->reset_property($transition->{node}, $property);
+ for my $transition ( @{ $self->{transitions} } ) {
+ for my $property (
+ qw(duration energy rel_energy_prev rel_energy_next timeout))
+ {
+ $self->reset_property( $transition->{node}, $property );
}
}
}
@@ -234,17 +239,17 @@ sub set_state_power {
$self->{states}{$state}{power}{static} = $power;
my ($static_parent) = $state_node->findnodes('./power');
- if (not $static_parent) {
+ if ( not $static_parent ) {
$static_parent = XML::LibXML::Element->new('power');
$state_node->appendChild($static_parent);
}
- for my $static_node ($static_parent->findnodes('./static')) {
+ for my $static_node ( $static_parent->findnodes('./static') ) {
$static_parent->removeChild($static_node);
}
my $static_node = XML::LibXML::Element->new('static');
- my $text_node = XML::LibXML::Text->new($power);;
+ my $text_node = XML::LibXML::Text->new($power);
$text_node->setData($power);
$static_node->appendChild($text_node);
@@ -254,31 +259,32 @@ sub set_state_power {
sub set_transition_property {
my ( $self, $transition_name, $property, $value ) = @_;
- if (not defined $value) {
+ if ( not defined $value ) {
return;
}
- my $transition = $self->get_transition_by_name($transition_name);
+ my $transition = $self->get_transition_by_name($transition_name);
my $transition_node = $transition->{node};
- $value = sprintf('%.f', $value);
+ $value = sprintf( '%.f', $value );
printf( "transition %-16s: adjust %s %d -> %d\n",
- $transition->{name}, $property, $transition->{$property}{static}, $value);
+ $transition->{name}, $property, $transition->{$property}{static},
+ $value );
$transition->{$property}{static} = $value;
my ($static_parent) = $transition_node->findnodes("./${property}");
- if (not $static_parent) {
+ if ( not $static_parent ) {
$static_parent = XML::LibXML::Element->new($property);
$transition_node->appendChild($static_parent);
}
- for my $static_node ($static_parent->findnodes('./static')) {
+ for my $static_node ( $static_parent->findnodes('./static') ) {
$static_parent->removeChild($static_node);
}
my $static_node = XML::LibXML::Element->new('static');
- my $text_node = XML::LibXML::Text->new($value);
+ my $text_node = XML::LibXML::Text->new($value);
$text_node->setData($value);
$static_node->appendChild($text_node);
@@ -286,10 +292,10 @@ sub set_transition_property {
}
sub set_state_lut {
- my ($self, $state, $property, $lut) = @_;
+ my ( $self, $state, $property, $lut ) = @_;
my $state_node = $self->{states}{$state}{node};
- if (not defined $lut) {
+ if ( not defined $lut ) {
return;
}
@@ -301,11 +307,11 @@ sub set_state_lut {
my $lut_node = XML::LibXML::Element->new('lut');
$lut_parent->appendChild($lut_node);
- for my $lut_entry (@{$lut}) {
+ for my $lut_entry ( @{$lut} ) {
my $entry_node = XML::LibXML::Element->new('entry');
- my $value_node = XML::LibXML::Text->new($lut_entry->{value});
- for my $param (sort keys %{$lut_entry->{key}}) {
- $entry_node->setAttribute($param, $lut_entry->{key}{$param});
+ my $value_node = XML::LibXML::Text->new( $lut_entry->{value} );
+ for my $param ( sort keys %{ $lut_entry->{key} } ) {
+ $entry_node->setAttribute( $param, $lut_entry->{key}{$param} );
}
$entry_node->appendChild($value_node);
$lut_node->appendChild($entry_node);
@@ -313,13 +319,13 @@ sub set_state_lut {
}
sub set_transition_lut {
- my ($self, $transition_name, $property, $lut) = @_;
+ my ( $self, $transition_name, $property, $lut ) = @_;
- if (not defined $lut) {
+ if ( not defined $lut ) {
return;
}
- my $transition = $self->get_transition_by_name($transition_name);
+ my $transition = $self->get_transition_by_name($transition_name);
my $transition_node = $transition->{node};
my ($lut_parent) = $transition_node->findnodes("./${property}");
@@ -330,11 +336,11 @@ sub set_transition_lut {
my $lut_node = XML::LibXML::Element->new('lut');
$lut_parent->appendChild($lut_node);
- for my $lut_entry (@{$lut}) {
+ for my $lut_entry ( @{$lut} ) {
my $entry_node = XML::LibXML::Element->new('entry');
- my $value_node = XML::LibXML::Text->new($lut_entry->{value});
- for my $param (sort keys %{$lut_entry->{key}}) {
- $entry_node->setAttribute($param, $lut_entry->{key}{$param});
+ my $value_node = XML::LibXML::Text->new( $lut_entry->{value} );
+ for my $param ( sort keys %{ $lut_entry->{key} } ) {
+ $entry_node->setAttribute( $param, $lut_entry->{key}{$param} );
}
$entry_node->appendChild($value_node);
$lut_node->appendChild($entry_node);
@@ -356,17 +362,17 @@ sub set_state_params {
my ($function_parent) = $state_node->findnodes('./power/function');
- if (not $function_parent) {
+ if ( not $function_parent ) {
my ($power_node) = $state_node->findnodes('./power');
$function_parent = XML::LibXML::Element->new('function');
$power_node->appendChild($function_parent);
}
- for my $function_node ($function_parent->findnodes("./${fun_name}")) {
+ for my $function_node ( $function_parent->findnodes("./${fun_name}") ) {
$function_parent->removeChild($function_node);
}
- my $function_node = XML::LibXML::Element->new($fun_name);
+ my $function_node = XML::LibXML::Element->new($fun_name);
my $function_content = XML::LibXML::CDATASection->new($function);
$function_node->appendChild($function_content);
@@ -380,33 +386,35 @@ sub set_state_params {
}
sub set_transition_params {
- my ( $self, $transition_name, $fun_type, $fun_name, $function, @params ) = @_;
- my $transition = $self->get_transition_by_name($transition_name);
+ my ( $self, $transition_name, $fun_type, $fun_name, $function, @params )
+ = @_;
+ my $transition = $self->get_transition_by_name($transition_name);
my $transition_node = $transition->{node};
- my $old_params = 'None';
+ my $old_params = 'None';
if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
$old_params = join( q{ },
@{ $transition->{$fun_type}{function}{$fun_name}{params} } );
}
- printf(
- "transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
- $transition_name, $fun_name, $fun_type, $old_params, join( q{ }, @params ) );
+ printf( "transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
+ $transition_name, $fun_name, $fun_type, $old_params,
+ join( q{ }, @params ) );
- my ($function_parent) = $transition_node->findnodes("./${fun_type}/function");
+ my ($function_parent)
+ = $transition_node->findnodes("./${fun_type}/function");
- if (not $function_parent) {
+ if ( not $function_parent ) {
my ($property_node) = $transition_node->findnodes("./${fun_type}");
$function_parent = XML::LibXML::Element->new('function');
$property_node->appendChild($function_parent);
}
- for my $function_node ($function_parent->findnodes("./${fun_name}")) {
+ for my $function_node ( $function_parent->findnodes("./${fun_name}") ) {
$function_parent->removeChild($function_node);
}
- my $function_node = XML::LibXML::Element->new($fun_name);
+ my $function_node = XML::LibXML::Element->new($fun_name);
my $function_content = XML::LibXML::CDATASection->new($function);
$function_node->appendChild($function_content);
@@ -419,17 +427,17 @@ sub set_transition_params {
}
sub set_voltage {
- my ($self, $min_voltage, $max_voltage) = @_;
+ my ( $self, $min_voltage, $max_voltage ) = @_;
my ($data_node) = $self->xml->findnodes('/data');
- for my $voltage_node ($data_node->findnodes('./voltage')) {
+ for my $voltage_node ( $data_node->findnodes('./voltage') ) {
$data_node->removeChild($voltage_node);
}
my $voltage_node = XML::LibXML::Element->new('voltage');
- $voltage_node->setAttribute('min', $min_voltage);
- $voltage_node->setAttribute('max', $max_voltage);
+ $voltage_node->setAttribute( 'min', $min_voltage );
+ $voltage_node->setAttribute( 'max', $max_voltage );
$data_node->appendChild($voltage_node);
}
@@ -535,16 +543,17 @@ sub get_state_power {
}
sub get_state_power_with_params {
- my ($self, $name, $param_values) = @_;
+ my ( $self, $name, $param_values ) = @_;
- my $hash_str = join(';', map { $param_values->{$_} }
+ my $hash_str = join( ';',
+ map { $param_values->{$_} }
sort { $a cmp $b } keys %{$param_values} );
- if ($hash_str eq q{}) {
+ if ( $hash_str eq q{} ) {
return $self->get_state_power($name);
}
- if (exists $self->{states}{$name}{power}{lut}{$hash_str}) {
+ if ( exists $self->{states}{$name}{power}{lut}{$hash_str} ) {
return $self->{states}{$name}{power}{lut}{$hash_str};
}
@@ -593,13 +602,15 @@ sub TO_JSON {
}
for my $val ( values %transition_copy ) {
delete $val->{node};
- for my $key (qw(duration energy rel_energy_prev rel_energy_next timeout)) {
+ for
+ my $key (qw(duration energy rel_energy_prev rel_energy_next timeout))
+ {
if ( exists $val->{$key}{function} ) {
$val->{$key} = { %{ $val->{$key} } };
$val->{$key}{function} = { %{ $val->{$key}{function} } };
for my $ftype ( keys %{ $val->{$key}{function} } ) {
$val->{$key}{function}{$ftype}
- = { %{ $val->{$key}{function}{$ftype} } };
+ = { %{ $val->{$key}{function}{$ftype} } };
delete $val->{$key}{function}{$ftype}{node};
}
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 05:38:34 +0000