summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/dfatool20
-rw-r--r--lib/Kratos/DFADriver.pm14
-rw-r--r--lib/Kratos/DFADriver/Model.pm403
3 files changed, 141 insertions, 296 deletions
diff --git a/bin/dfatool b/bin/dfatool
index a5a53e9..58f59d6 100755
--- a/bin/dfatool
+++ b/bin/dfatool
@@ -48,7 +48,7 @@ if ( @ARGV < 2 ) {
@{ $opt{'param-default'} }
= split( qr{,}, join( q{,}, @{ $opt{'param-default'} // [] } ) );
-my ( $command, $xml_file, @data_files ) = @ARGV;
+my ( $command, $model_file, @data_files ) = @ARGV;
my $driver = Kratos::DFADriver->new(
cache => $opt{'no-cache'} ? 0 : 1,
@@ -68,11 +68,11 @@ my $driver = Kratos::DFADriver->new(
mimosa_offset => $opt{offset} // 130,
mimosa_shunt => $opt{shunt} // 330,
mimosa_voltage => $opt{voltage} // 3.60,
+ model_file => $model_file,
param_default => $opt{'param-default'} // [],
trace_filter => $opt{'trace-filter'} // [],
trace_revisit => $opt{'trace-revisit'} // 2,
with_lut => $opt{'with-lut'},
- xml_file => $xml_file,
);
my %action = (
@@ -196,7 +196,7 @@ my %action = (
},
crossvalidate => sub {
printf( "./dfatool crossvalidate %s %s\n",
- $xml_file, join( q{ }, @data_files ) );
+ $model_file, join( q{ }, @data_files ) );
$driver->crossvalidate_model(@data_files);
},
ls => sub {
@@ -319,7 +319,7 @@ $SIG{INT} = $SIG{TERM} = sub {
};
sub show_usage {
- say STDERR "Usage: $0 <action> <DFA driver XML file>";
+ say STDERR "Usage: $0 <action> <DFA driver file>";
say STDERR 'Supported actions: ' . join( q{ }, sort keys %action );
exit 1;
}
@@ -349,10 +349,10 @@ test programs to assess a device's energy usage.
=head1 SYNOPSIS
-B<dfatool> [I<options>] enable|disable|maketest|rmtest|log|loop I<driver.xml>
+B<dfatool> [I<options>] enable|disable|maketest|rmtest|log|loop I<driver.json>
B<dfatool> [I<options>] analyze|crossvalidate|ls|list|show
-I<driver.xml> I<data.tar> [I<moredata.tar ...>]
+I<driver.json> I<data.tar> [I<moredata.tar ...>]
=head1 VERSION
@@ -365,20 +365,20 @@ the last transition in a run
=over
-=item B<enable> I<driver.xml>
+=item B<enable> I<driver.json>
-Instruments the driver noted in I<driver.xml> for energy accounting and state
+Instruments the driver noted in I<driver.json> for energy accounting and state
and transition logging. Unconditionally uses static model attributes and only
relative energy values. Attributes whose power or energy values are not yet
known are set to zero.
-=item B<disable> I<driver.xml>
+=item B<disable> I<driver.json>
Removes accounting and logging instrumentation, thus turning the driver back
into an energy-unaware one. By default, each state may be visited up to two
times...
-=item B<maketest> I<driver.xml>
+=item B<maketest> I<driver.json>
Creates a kratos application containing a test program for the driver. By
default,
diff --git a/lib/Kratos/DFADriver.pm b/lib/Kratos/DFADriver.pm
index 7ceaa4a..c94101a 100644
--- a/lib/Kratos/DFADriver.pm
+++ b/lib/Kratos/DFADriver.pm
@@ -38,7 +38,7 @@ sub new {
$self->{repo} = AspectC::Repo->new;
$self->{lp}{iteration} = 1;
- if ( -r $opt{xml_file} ) {
+ if ( -r $opt{model_file} ) {
$self->{model} = Kratos::DFADriver::Model->new(%opt);
$self->{class_name} = $self->{model}->class_name;
}
@@ -46,11 +46,11 @@ sub new {
$self->{model} = Kratos::DFADriver::Model->new_from_repo(
repo => $self->{repo},
class_name => $opt{class_name},
- xml_file => $opt{xml_file},
+ model_file => $opt{model_file},
);
}
else {
- die('Neither driver.xml nor class name specified, cannot continue');
+ die('Neither driver.json nor class name specified, cannot continue');
}
bless( $self, $class );
@@ -64,10 +64,10 @@ sub new {
sub set_paths {
my ($self) = @_;
- my $xml_path = $self->{xml_file};
- $xml_path =~ s{ /?+dfa-driver/[^/]+[.]xml $ }{}x;
+ my $model_path = $self->{model_file};
+ $model_path =~ s{ /?+dfa-driver/[^/]+[.] ( xml | json ) $ }{}x;
- my $prefix = $self->{prefix} = cwd() . "/${xml_path}/src";
+ my $prefix = $self->{prefix} = cwd() . "/${model_path}/src";
my $class_prefix
= $self->repo->get_class_path_prefix( $self->{class_name} );
$self->{ah_file} = "${prefix}/${class_prefix}_dfa.ah";
@@ -1087,7 +1087,7 @@ sub archive_files {
my @mim_files = grep { m{ \. mim }x } read_dir('.');
- $tar->add_files( $self->{xml_file}, @eval_files, @mim_files );
+ $tar->add_files( $self->{model_file}, @eval_files, @mim_files );
$tar->add_data(
'setup.json',
diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
index f87b81c..ea5e297 100644
--- a/lib/Kratos/DFADriver/Model.pm
+++ b/lib/Kratos/DFADriver/Model.pm
@@ -9,9 +9,12 @@ use parent 'Class::Accessor';
use Carp;
use Carp::Assert::More;
use List::Util qw(first uniq);
+use File::Slurp qw(read_file write_file);
+use JSON;
use XML::LibXML;
-Kratos::DFADriver::Model->mk_ro_accessors(qw(class_name xml));
+Kratos::DFADriver::Model->mk_ro_accessors(
+ qw(class_name parameter state transition));
our $VERSION = '0.00';
@@ -20,22 +23,45 @@ sub new {
my $self = \%opt;
+ $self->{custom_code} = {};
$self->{parameter} = {};
- $self->{states} = {};
- $self->{transitions} = [];
- $self->{xml} = XML::LibXML->load_xml( location => $self->{xml_file} );
+ $self->{state} = {};
+ $self->{transition} = {};
+ $self->{voltage} = {};
bless( $self, $class );
- $self->parse_xml;
+ if ( $self->{model_file} =~ m{ [.] xml $ }x ) {
+ $self->{xml} = XML::LibXML->load_xml( location => $self->{model_file} );
+ $self->parse_xml;
+ $self->{model_file} =~ s{ [.] xml $}{.json}x;
+ write_file( $self->{model_file},
+ JSON->new->pretty->encode( $self->TO_JSON ) );
+ }
+ else {
+ my $json = JSON->new->decode( scalar read_file( $self->{model_file} ) );
+ for my $key (qw(custom_code parameter state transition)) {
+ $self->{$key} = $json->{$key};
+ }
+ $self->{class_name} = $json->{class};
+ }
return $self;
}
sub new_from_repo {
my ( $class, %opt ) = @_;
- my $repo = $opt{repo};
- my $class_name = $opt{class_name};
+ my $repo = $opt{repo};
+
+ my $self = {
+ class => $opt{class_name},
+ model_file => $opt{model_file},
+ voltage => {},
+ };
+
+ bless( $self, $class );
+
+ my $class_name = $self->{class};
my @states;
my %transition;
@@ -64,51 +90,27 @@ sub new_from_repo {
@states = uniq @states;
@states = sort @states;
- my $xml = XML::LibXML::Document->new('1.0');
-
- my $data_node = $xml->createElement('data');
- my $driver_node = $xml->createElement('driver');
- my $states_node = $xml->createElement('states');
- my $transitions_node = $xml->createElement('transitions');
-
- $driver_node->setAttribute( name => $class_name );
-
- $xml->setDocumentElement($data_node);
- $data_node->appendChild($driver_node);
- $driver_node->appendChild($states_node);
- $driver_node->appendChild($transitions_node);
-
- for my $state (@states) {
- my $state_node = $xml->createElement('state');
- $state_node->setAttribute( name => $state );
- $states_node->appendChild($state_node);
- }
- for my $transition ( sort keys %transition ) {
- my $transition_node = $xml->createElement('transition');
- my $level = $transition eq 'epilogue' ? 'epilogue' : 'user';
- $transition_node->setAttribute( name => $transition );
- for my $src_state ( @{ $transition{$transition}{src} } ) {
- my $src_node = $xml->createElement('src');
- my $src_name = $xml->createTextNode($src_state);
- $src_node->appendChild($src_name);
- $transition_node->appendChild($src_node);
- }
- for my $dst_state ( @{ $transition{$transition}{dst} } ) {
- my $dst_node = $xml->createElement('dst');
- my $dst_name = $xml->createTextNode($dst_state);
- $dst_node->appendChild($dst_name);
- $transition_node->appendChild($dst_node);
- }
- my $level_node = $xml->createElement('level');
- my $level_name = $xml->createTextNode($level);
- $level_node->appendChild($level_name);
- $transition_node->appendChild($level_node);
- $transitions_node->appendChild($transition_node);
+ for my $i ( 0 .. $#states ) {
+ $self->{state}{ $states[$i] } = {
+ id => $i,
+ };
}
- $xml->toFile( $opt{xml_file} );
+ my @transition_names = sort keys %transition;
- return $class->new(%opt);
+ for my $i ( 0 .. $#transition_names ) {
+ my $name = $transition_names[$i];
+ $self->{transition}{$name} = {
+ id => $i,
+ destination => $transition{$name}{dst}[0],
+ origins => $transition{$name}{src},
+ };
+ }
+
+ write_file( $self->{model_file},
+ JSON->new->pretty->encode( $self->TO_JSON ) );
+
+ return $self;
}
sub parse_xml_property {
@@ -132,8 +134,7 @@ sub parse_xml_property {
$function =~ s{\s* \n* $}{}x;
$function =~ s{ [\n\t]+ }{}gx;
- $ret->{function}{$name}{raw} = $function;
- $ret->{function}{$name}{node} = $function_node;
+ $ret->{function}{$name}{raw} = $function;
my $param_idx = 0;
while ( $function_node->hasAttribute("param${param_idx}") ) {
@@ -161,15 +162,14 @@ sub parse_xml {
my ($driver_node) = $xml->findnodes('/data/driver');
my $class_name = $self->{class_name} = $driver_node->getAttribute('name');
my $state_index = 0;
- my $transition_index = 0;
+ my @transitions;
for my $state_node ( $xml->findnodes('/data/driver/states/state') ) {
my $name = $state_node->getAttribute('name');
my $power = $state_node->getAttribute('power') // 0;
- $self->{states}{$name} = {
+ $self->{state}{$name} = {
power => $self->parse_xml_property( $state_node, 'power' ),
id => $state_index,
- node => $state_node,
};
$state_index++;
@@ -229,110 +229,84 @@ sub parse_xml {
origins => [@source_states],
destination => $dst_node->textContent,
level => $level_node->textContent,
- id => $transition_index,
affects => {%affects},
- node => $transition_node,
};
- push( @{ $self->{transitions} }, $transition );
+ push( @transitions, $transition );
+ }
- $transition_index++;
+ @transitions = sort { $a->{name} cmp $b->{name} } @transitions;
+ for my $i ( 0 .. $#transitions ) {
+ $transitions[$i]{id} = $i;
+ $self->{transition}{ $transitions[$i]{name} } = $transitions[$i];
}
if ( my ($node) = $xml->findnodes('/data/startup/code') ) {
- $self->{startup}{code} = $node->textContent;
+ $self->{custom_code}{startup} = $node->textContent;
}
if ( my ($node) = $xml->findnodes('/data/heap/code') ) {
- $self->{heap}{code} = $node->textContent;
+ $self->{custom_code}{heap} = $node->textContent;
}
if ( my ($node) = $xml->findnodes('/data/after-transition/code') ) {
- $self->{after_transition}{code} = $node->textContent;
+ $self->{custom_code}{after_transition} = $node->textContent;
}
for my $node ( $xml->findnodes('/data/after-transition/if') ) {
my $state = $node->getAttribute('state');
for my $transition ( $node->findnodes('./transition') ) {
my $name = $transition->getAttribute('name');
- push( @{ $self->{after_transition}{in_state}{$state} }, $name );
+ push(
+ @{ $self->{custom_code}{after_transition_by_state}{$state} },
+ $name
+ );
}
}
if ( my ($node) = $xml->findnodes('/data/shutdown/code') ) {
- $self->{shutdown}{code} = $node->textContent;
+ $self->{custom_code}{shutdown} = $node->textContent;
}
return $self;
}
sub reset_property {
- my ( $self, $node, $name ) = @_;
+ my ( $self, $hash, $name ) = @_;
- my ($property_node) = $node->findnodes("./${name}");
-
- if ($property_node) {
- 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 ) {
- $attrnode->setValue(1);
- }
- }
- else {
- $function_parent->removeChild($function_node);
- }
- }
- }
+ delete $hash->{$name}{static};
+ if ( exists $hash->{$name}{function} ) {
+ delete $hash->{$name}{function}{estimate};
+ }
+ if ( exists $hash->{$name}{function}{user} ) {
+ $hash->{$name}{function}{user}{params}
+ = [ map { 1 } @{ $hash->{$name}{function}{user}{params} } ];
}
}
sub reset {
my ($self) = @_;
- for my $state ( values %{ $self->{states} } ) {
+ for my $state ( values %{ $self->{state} } ) {
for my $property (qw(power)) {
- $self->reset_property( $state->{node}, $property );
+ $self->reset_property( $state, $property );
}
}
- for my $transition ( @{ $self->{transitions} } ) {
+ for my $transition ( $self->transitions ) {
for my $property (
qw(duration energy rel_energy_prev rel_energy_next timeout))
{
- $self->reset_property( $transition->{node}, $property );
+ $self->reset_property( $transition, $property );
}
}
}
sub set_state_power {
my ( $self, $state, $power ) = @_;
- my $state_node = $self->{states}{$state}{node};
$power = sprintf( '%.f', $power );
printf( "state %-16s: adjust power %d -> %d µW\n",
- $state, $self->{states}{$state}{power}{static}, $power );
-
- $self->{states}{$state}{power}{static} = $power;
-
- my ($static_parent) = $state_node->findnodes('./power');
- if ( not $static_parent ) {
- $static_parent = XML::LibXML::Element->new('power');
- $state_node->appendChild($static_parent);
- }
-
- for my $static_node ( $static_parent->findnodes('./static') ) {
- $static_parent->removeChild($static_node);
- }
+ $state, $self->{state}{$state}{power}{static}, $power );
- my $static_node = XML::LibXML::Element->new('static');
- my $text_node = XML::LibXML::Text->new($power);
-
- $text_node->setData($power);
- $static_node->appendChild($text_node);
- $static_parent->appendChild($static_node);
+ $self->{state}{$state}{power}{static} = $power;
}
sub set_transition_property {
@@ -342,8 +316,8 @@ sub set_transition_property {
return;
}
- my $transition = $self->get_transition_by_name($transition_name);
- my $transition_node = $transition->{node};
+ my $transition = $self->get_transition_by_name($transition_name);
+
$value = sprintf( '%.f', $value );
printf( "transition %-16s: adjust %s %d -> %d\n",
@@ -351,50 +325,16 @@ sub set_transition_property {
$value );
$transition->{$property}{static} = $value;
-
- my ($static_parent) = $transition_node->findnodes("./${property}");
- if ( not $static_parent ) {
- $static_parent = XML::LibXML::Element->new($property);
- $transition_node->appendChild($static_parent);
- }
-
- 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);
-
- $text_node->setData($value);
- $static_node->appendChild($text_node);
- $static_parent->appendChild($static_node);
}
sub set_state_lut {
my ( $self, $state, $property, $lut ) = @_;
- my $state_node = $self->{states}{$state}{node};
if ( not defined $lut ) {
return;
}
- my ($lut_parent) = $state_node->findnodes("./${property}");
- for my $lut_node ( $lut_parent->findnodes('./lut') ) {
- $lut_parent->removeChild($lut_node);
- }
-
- my $lut_node = XML::LibXML::Element->new('lut');
- $lut_parent->appendChild($lut_node);
-
- 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} );
- }
- $entry_node->appendChild($value_node);
- $lut_node->appendChild($entry_node);
- }
+ ...;
}
sub set_transition_lut {
@@ -404,72 +344,33 @@ sub set_transition_lut {
return;
}
- my $transition = $self->get_transition_by_name($transition_name);
- my $transition_node = $transition->{node};
-
- my ($lut_parent) = $transition_node->findnodes("./${property}");
- for my $lut_node ( $lut_parent->findnodes('./lut') ) {
- $lut_parent->removeChild($lut_node);
- }
-
- my $lut_node = XML::LibXML::Element->new('lut');
- $lut_parent->appendChild($lut_node);
-
- 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} );
- }
- $entry_node->appendChild($value_node);
- $lut_node->appendChild($entry_node);
- }
+ ...;
}
sub set_state_params {
my ( $self, $state, $fun_name, $function, @params ) = @_;
my $old_params = 'None';
- my $state_node = $self->{states}{$state}{node};
- if ( exists $self->{states}{$state}{power}{function}{$fun_name} ) {
+ if ( exists $self->{state}{$state}{power}{function}{$fun_name} ) {
$old_params = join( q{ },
- @{ $self->{states}{$state}{power}{function}{$fun_name}{params} } );
+ @{ $self->{state}{$state}{power}{function}{$fun_name}{params} } );
}
printf( "state %-16s: adjust %s power function parameters [%s] -> [%s]\n",
$state, $fun_name, $old_params, join( q{ }, @params ) );
- my ($function_parent) = $state_node->findnodes('./power/function');
-
- 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}") ) {
- $function_parent->removeChild($function_node);
- }
-
- my $function_node = XML::LibXML::Element->new($fun_name);
- my $function_content = XML::LibXML::CDATASection->new($function);
-
- $function_node->appendChild($function_content);
- $function_parent->appendChild($function_node);
-
+ $self->{state}{$state}{power}{function}{$fun_name}{raw} = $function;
for my $i ( 0 .. $#params ) {
- $self->{states}{$state}{power}{function}{$fun_name}{params}[$i]
+ $self->{state}{$state}{power}{function}{$fun_name}{params}[$i]
= $params[$i];
- $function_node->setAttribute( "param$i", $params[$i] );
}
}
sub set_transition_params {
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 $transition = $self->get_transition_by_name($transition_name);
+ my $old_params = 'None';
if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
$old_params = join( q{ },
@@ -480,51 +381,26 @@ sub set_transition_params {
$transition_name, $fun_name, $fun_type, $old_params,
join( q{ }, @params ) );
- my ($function_parent)
- = $transition_node->findnodes("./${fun_type}/function");
-
- 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}") ) {
- $function_parent->removeChild($function_node);
- }
-
- my $function_node = XML::LibXML::Element->new($fun_name);
- my $function_content = XML::LibXML::CDATASection->new($function);
-
- $function_node->appendChild($function_content);
- $function_parent->appendChild($function_node);
-
+ $transition->{$fun_type}{function}{$fun_name}{raw} = $function;
for my $i ( 0 .. $#params ) {
$transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
- $function_node->setAttribute( "param$i", $params[$i] );
}
}
sub set_voltage {
my ( $self, $min_voltage, $max_voltage ) = @_;
- my ($data_node) = $self->xml->findnodes('/data');
-
- 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 );
-
- $data_node->appendChild($voltage_node);
+ $self->{voltage} = {
+ min => $min_voltage,
+ max => $max_voltage,
+ };
}
sub save {
my ($self) = @_;
- $self->{xml}->toFile( $self->{xml_file} );
+ write_file( $self->{model_file},
+ JSON->new->pretty->encode( $self->TO_JSON ) );
}
sub parameter_hash {
@@ -562,51 +438,51 @@ sub update_parameter_hash {
sub startup_code {
my ($self) = @_;
- return $self->{startup}{code} // q{};
+ return $self->{custom_code}{startup} // q{};
}
sub heap_code {
my ($self) = @_;
- return $self->{heap}{code} // q{};
+ return $self->{custom_code}{heap} // q{};
}
sub after_transition_code {
my ($self) = @_;
- return $self->{after_transition}{code} // q{};
+ return $self->{custom_code}{after_transition} // q{};
}
sub get_state_extra_transitions {
my ( $self, $state ) = @_;
- return @{ $self->{after_transition}{in_state}{$state} // [] };
+ return @{ $self->{custom_code}{after_transition_by_state}{$state} // [] };
}
sub shutdown_code {
my ($self) = @_;
- return $self->{shutdown}{code} // q{};
+ return $self->{custom_code}{shutdown} // q{};
}
sub get_transition_by_name {
my ( $self, $name ) = @_;
- my $transition = first { $_->{name} eq $name } @{ $self->{transitions} };
-
- return $transition;
+ return $self->{transition}{$name};
}
sub get_transition_by_id {
my ( $self, $id ) = @_;
- return $self->{transitions}[$id];
+ my $transition = first { $_->{id} == $id } $self->transitions;
+
+ return $transition;
}
sub get_state_id {
my ( $self, $name ) = @_;
- return $self->{states}{$name}{id};
+ return $self->{state}{$name}{id};
}
sub get_state_name {
@@ -618,7 +494,7 @@ sub get_state_name {
sub get_state_power {
my ( $self, $name ) = @_;
- return $self->{states}{$name}{power}{static};
+ return $self->{state}{$name}{power}{static};
}
sub get_state_power_with_params {
@@ -632,8 +508,8 @@ sub get_state_power_with_params {
return $self->get_state_power($name);
}
- if ( exists $self->{states}{$name}{power}{lut}{$hash_str} ) {
- return $self->{states}{$name}{power}{lut}{$hash_str};
+ if ( exists $self->{state}{$name}{power}{lut}{$hash_str} ) {
+ return $self->{state}{$name}{power}{lut}{$hash_str};
}
say "Note: No matching LUT for state ${name}, using median";
@@ -646,8 +522,8 @@ sub get_state_enum {
if ( not exists $self->{state_enum} ) {
@{ $self->{state_enum} }
- = sort { $self->{states}{$a}{id} <=> $self->{states}{$b}{id} }
- keys %{ $self->{states} };
+ = sort { $self->{state}{$a}{id} <=> $self->{state}{$b}{id} }
+ keys %{ $self->{state} };
}
return @{ $self->{state_enum} };
@@ -656,53 +532,22 @@ sub get_state_enum {
sub transitions {
my ($self) = @_;
- return @{ $self->{transitions} };
+ my @ret = values %{ $self->{transition} };
+ @ret = sort { $a->{id} <=> $b->{id} } @ret;
+ return @ret;
}
sub TO_JSON {
my ($self) = @_;
- my %state_copy
- = map { $_ => { %{ $self->{states}{$_} } } } keys %{ $self->{states} };
- my %transition_copy
- = map { $_->{name} => { %{$_} } } @{ $self->{transitions} };
-
- for my $val ( values %state_copy ) {
- delete $val->{node};
- if ( exists $val->{power}{function} ) {
- $val->{power} = { %{ $val->{power} } };
- $val->{power}{function} = { %{ $val->{power}{function} } };
- for my $key ( keys %{ $val->{power}{function} } ) {
- $val->{power}{function}{$key}
- = { %{ $val->{power}{function}{$key} } };
- delete $val->{power}{function}{$key}{node};
- }
- }
- }
- for my $val ( values %transition_copy ) {
- delete $val->{node};
- 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} } };
- delete $val->{$key}{function}{$ftype}{node};
- }
- }
- }
- }
-
- my $json = {
- parameter => $self->{parameter},
- state => {%state_copy},
- transition => {%transition_copy},
+ return {
+ class => $self->{class_name},
+ parameter => $self->{parameter},
+ state => $self->{state},
+ transition => $self->{transition},
+ custom_code => $self->{custom_code},
+ voltage => $self->{voltage},
};
-
- return $json;
}
1;