summaryrefslogtreecommitdiff
path: root/lib/Kratos
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kratos')
-rw-r--r--lib/Kratos/DFADriver.pm14
-rw-r--r--lib/Kratos/DFADriver/Model.pm403
2 files changed, 131 insertions, 286 deletions
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;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 03:15:00 +0000