diff options
author | Daniel Friesel <derf@finalrewind.org> | 2017-05-17 15:13:58 +0200 |
---|---|---|
committer | Daniel Friesel <derf@finalrewind.org> | 2017-05-17 15:13:58 +0200 |
commit | 4da867e42eca6264ca59a6ac999f49aa684385ba (patch) | |
tree | 2e4b6dfcc50539d91206d1c9beeb0096e0a815e0 /lib | |
parent | 458cf889e6ed331d9e5084cf8e199166ce983286 (diff) |
Use JSON models instead of XML
JSON is easier to (de)serialize and the manual editing possibilities of XML
don't matter after the switch to model file autogeneration using attributes and
aspects
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kratos/DFADriver.pm | 14 | ||||
-rw-r--r-- | lib/Kratos/DFADriver/Model.pm | 403 |
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; |