From 4da867e42eca6264ca59a6ac999f49aa684385ba Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Wed, 17 May 2017 15:13:58 +0200 Subject: 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 --- lib/Kratos/DFADriver.pm | 14 +- lib/Kratos/DFADriver/Model.pm | 403 +++++++++++++----------------------------- 2 files changed, 131 insertions(+), 286 deletions(-) (limited to 'lib') 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; -- cgit v1.2.3