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

1 files changed, 124 insertions, 279 deletions

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;