Remove most unused perl scripts and modules

1 files changed, 0 insertions, 495 deletions

diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
deleted file mode 100644
index 4a38155..0000000
--- a/lib/Kratos/DFADriver/Model.pm
+++ /dev/null
@@ -1,495 +0,0 @@
-package Kratos::DFADriver::Model;
-
-use strict;
-use warnings;
-use 5.020;
-
-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;
-
-Kratos::DFADriver::Model->mk_ro_accessors(
-	qw(class_name parameter state transition));
-
-our $VERSION = '0.00';
-
-sub new {
-	my ( $class, %opt ) = @_;
-
-	my $self = \%opt;
-
-	$self->{custom_code} = {};
-	$self->{parameter}   = {};
-	$self->{state}       = {};
-	$self->{transition}  = {};
-	$self->{voltage}     = {};
-
-	bless( $self, $class );
-
-	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 $self = {
-		class_name => $opt{class_name},
-		model_file => $opt{model_file},
-		voltage    => {},
-	};
-
-	bless( $self, $class );
-
-	my $class_name = $self->{class_name};
-
-	my @states;
-	my %transition;
-
-	if ( not exists $repo->{class}{$class_name} ) {
-		die("Unknown class: $class_name\n");
-	}
-	my $class_base = $repo->{class}{$class_name};
-
-	for my $function ( values %{ $class_base->{function} } ) {
-		my %param_values;
-		for my $attrib ( @{ $function->{attributes} // [] } ) {
-			if ( $attrib->{namespace} eq 'Model' ) {
-				if ( $attrib->{name} =~ m{ ^ transition }x
-					and @{ $attrib->{args} } == 2 )
-				{
-					push( @states, $attrib->{args}[0]{expression} );
-					push( @states, $attrib->{args}[1]{expression} );
-					push(
-						@{ $transition{ $function->{name} }{src} },
-						$attrib->{args}[0]{expression}
-					);
-					push(
-						@{ $transition{ $function->{name} }{dst} },
-						$attrib->{args}[1]{expression}
-					);
-					push(
-						@{ $transition{ $function->{name} }{transitions} },
-						[
-							$attrib->{args}[0]{expression},
-							$attrib->{args}[1]{expression}
-						]
-					);
-				}
-				elsif ( $attrib->{name} =~ m{ ^ testval }x
-					and @{ $attrib->{args} } == 2 )
-				{
-					push(
-						@{ $param_values{ $attrib->{args}[0]{value} } },
-						$attrib->{args}[1]{value}
-					);
-				}
-				elsif (
-					$attrib->{name} =~ m{ ^ required_in_ (?<state> .* ) $ }x )
-				{
-					push(
-						@{
-							$self->{custom_code}{after_transition_by_state}
-							  { $+{state} }
-						},
-						$function->{name}
-					);
-				}
-				else {
-					printf( "wat %s::%s\n",
-						$attrib->{namespace}, $attrib->{name} );
-				}
-			}
-			elsif ( $attrib =~ m{ ^ epilogue $ }x ) {
-				$transition{ $function->{name} }{level} = 'epilogue';
-			}
-			else {
-				printf( "wat %s::%s\n", $attrib->{namespace}, $attrib->{name} );
-			}
-		}
-		if ( exists $transition{ $function->{name} } ) {
-			for my $i ( 0 .. $#{ $function->{argtypes} } ) {
-				my $argtype = $function->{argtypes}[$i];
-				my $param_name = sprintf( '%s.arg%d', $function->{name}, $i );
-				push(
-					@{ $transition{ $function->{name} }{parameters} },
-					{
-						name   => $param_name,
-						values => $param_values{$i},
-					}
-				);
-				$self->{parameter}{$param_name} = {
-					arg_name => $param_name,
-					function => $function->{name},
-					default  => undef,
-				};
-			}
-		}
-	}
-
-	if ( exists $repo->{class}{"DriverEvalThread_${class_name}"} ) {
-		for my $var (
-			keys %{ $repo->{class}{"DriverEvalThread_${class_name}"}{variable} }
-		  )
-		{
-			if ( $var
-				=~ m{ ^ testVal __ (?<fun> [^_]+ ) __ arg (?<index> \d+ ) __ (?<descr> [^_]+ ) $ }x
-			  )
-			{
-				push(
-					@{
-						$transition{ $+{fun} }{parameters}[ $+{index} ]{values}
-					},
-					$var
-				);
-			}
-		}
-	}
-
-	@states = uniq @states;
-	@states = sort @states;
-
-	# by convention, UNINITIALIZED always has ID 0
-	@states = grep { $_ ne 'UNINITIALIZED' } @states;
-	unshift( @states, 'UNINITIALIZED' );
-
-	for my $i ( 0 .. $#states ) {
-		$self->{state}{ $states[$i] } = {
-			id    => $i,
-			power => {
-				static => 0,
-			}
-		};
-	}
-
-	my @transition_names = sort keys %transition;
-
-	for my $i ( 0 .. $#transition_names ) {
-
-		my $name         = $transition_names[$i];
-		my @origins      = uniq @{ $transition{$name}{src} };
-		my @destinations = uniq @{ $transition{$name}{dst} };
-		my $guess_level  = ( $name eq 'epilogue' ? 'epilogue' : 'user' );
-
-		$self->{transition}{$name} = {
-			name            => $name,
-			id              => $i,
-			destination     => \@destinations,
-			origins         => \@origins,
-			transitions     => $transition{$name}{transitions},
-			level           => $transition{$name}{level} // $guess_level,
-			parameters      => $transition{$name}{parameters} // [],
-			duration        => { static => 0 },
-			energy          => { static => 0 },
-			rel_energy_prev => { static => 0 },
-			rel_energy_next => { static => 0 },
-			timeout         => { static => 0 },
-		};
-		if ( @destinations > 1 ) {
-			my $dst_str = join( q{, }, @destinations );
-			warn(
-"Transition ${name} has several destination states ($dst_str). This is only partially supported.\n"
-			);
-		}
-	}
-
-	write_file( $self->{model_file},
-		JSON->new->pretty->encode( $self->TO_JSON ) );
-
-	return $self;
-}
-
-sub reset_property {
-	my ( $self, $hash, $name ) = @_;
-
-	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->{state} } ) {
-		for my $property (qw(power)) {
-			$self->reset_property( $state, $property );
-		}
-	}
-
-	for my $transition ( $self->transitions ) {
-		for my $property (
-			qw(duration energy rel_energy_prev rel_energy_next timeout))
-		{
-			$self->reset_property( $transition, $property );
-		}
-	}
-}
-
-sub set_state_power {
-	my ( $self, $state, $power ) = @_;
-
-	$power = sprintf( '%.f', $power );
-
-	printf( "state %-16s: adjust power %d -> %d µW\n",
-		$state, $self->{state}{$state}{power}{static}, $power );
-
-	$self->{state}{$state}{power}{static} = $power;
-}
-
-sub set_transition_property {
-	my ( $self, $transition_name, $property, $value ) = @_;
-
-	if ( not defined $value ) {
-		return;
-	}
-
-	my $transition = $self->get_transition_by_name($transition_name);
-
-	$value = sprintf( '%.f', $value );
-
-	printf( "transition %-16s: adjust %s %d -> %d\n",
-		$transition->{name}, $property, $transition->{$property}{static},
-		$value );
-
-	$transition->{$property}{static} = $value;
-}
-
-sub set_state_lut {
-	my ( $self, $state, $property, $lut ) = @_;
-
-	if ( not defined $lut ) {
-		return;
-	}
-
-	...;
-}
-
-sub set_transition_lut {
-	my ( $self, $transition_name, $property, $lut ) = @_;
-
-	if ( not defined $lut ) {
-		return;
-	}
-
-	...;
-}
-
-sub set_state_params {
-	my ( $self, $state, $fun_name, $function, @params ) = @_;
-	my $old_params = 'None';
-
-	if ( exists $self->{state}{$state}{power}{function}{$fun_name} ) {
-		$old_params = join( q{ },
-			@{ $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 ) );
-
-	$self->{state}{$state}{power}{function}{$fun_name}{raw} = $function;
-	for my $i ( 0 .. $#params ) {
-		$self->{state}{$state}{power}{function}{$fun_name}{params}[$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 $old_params = 'None';
-
-	if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
-		$old_params = join( q{ },
-			@{ $transition->{$fun_type}{function}{$fun_name}{params} } );
-	}
-
-	printf( "transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
-		$transition_name, $fun_name, $fun_type, $old_params,
-		join( q{ }, @params ) );
-
-	$transition->{$fun_type}{function}{$fun_name}{raw} = $function;
-	for my $i ( 0 .. $#params ) {
-		$transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
-	}
-}
-
-sub set_voltage {
-	my ( $self, $min_voltage, $max_voltage ) = @_;
-
-	$self->{voltage} = {
-		min => $min_voltage,
-		max => $max_voltage,
-	};
-}
-
-sub save {
-	my ($self) = @_;
-
-	write_file( $self->{model_file},
-		JSON->new->pretty->encode( $self->TO_JSON ) );
-}
-
-sub parameter_hash {
-	my ($self) = @_;
-
-	for my $param_name ( keys %{ $self->{parameter} } ) {
-		$self->{parameter}{$param_name}{value}
-		  = $self->{parameter}{$param_name}{default};
-	}
-
-	return %{ $self->{parameter} };
-}
-
-sub update_parameter_hash {
-	my ( $self, $param_hash, $function, @args ) = @_;
-
-	my $transition = $self->get_transition_by_name($function);
-
-	for my $param ( keys %{ $transition->{affects} } ) {
-		$param_hash->{$param}{value} = $transition->{affects}{$param};
-	}
-
-	for my $i ( 0 .. $#args ) {
-		my $arg_name  = $transition->{parameters}[$i]{name};
-		my $arg_value = $args[$i];
-
-		for my $param_name ( keys %{ $self->{parameter} } ) {
-			if ( $self->{parameter}{$param_name}{arg_name} eq $arg_name ) {
-				$param_hash->{$param_name}{value} = $arg_value;
-			}
-		}
-	}
-}
-
-sub startup_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{startup} // q{};
-}
-
-sub heap_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{heap} // q{};
-}
-
-sub after_transition_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{after_transition} // q{};
-}
-
-sub get_state_extra_transitions {
-	my ( $self, $state ) = @_;
-
-	return @{ $self->{custom_code}{after_transition_by_state}{$state} // [] };
-}
-
-sub shutdown_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{shutdown} // q{};
-}
-
-sub get_transition_by_name {
-	my ( $self, $name ) = @_;
-
-	return $self->{transition}{$name};
-}
-
-sub get_transition_by_id {
-	my ( $self, $id ) = @_;
-
-	my $transition = first { $_->{id} == $id } $self->transitions;
-
-	return $transition;
-}
-
-sub get_state_id {
-	my ( $self, $name ) = @_;
-
-	return $self->{state}{$name}{id};
-}
-
-sub get_state_name {
-	my ( $self, $id ) = @_;
-
-	return ( $self->get_state_enum )[$id];
-}
-
-sub get_state_power {
-	my ( $self, $name ) = @_;
-
-	return $self->{state}{$name}{power}{static};
-}
-
-sub get_state_power_with_params {
-	my ( $self, $name, $param_values ) = @_;
-
-	my $hash_str = join( ';',
-		map  { $param_values->{$_} }
-		sort { $a cmp $b } keys %{$param_values} );
-
-	if ( $hash_str eq q{} ) {
-		return $self->get_state_power($name);
-	}
-
-	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";
-
-	return $self->get_state_power($name);
-}
-
-sub get_state_enum {
-	my ($self) = @_;
-
-	if ( not exists $self->{state_enum} ) {
-		@{ $self->{state_enum} }
-		  = sort { $self->{state}{$a}{id} <=> $self->{state}{$b}{id} }
-		  keys %{ $self->{state} };
-	}
-
-	return @{ $self->{state_enum} };
-}
-
-sub transitions {
-	my ($self) = @_;
-
-	my @ret = values %{ $self->{transition} };
-	@ret = sort { $a->{id} <=> $b->{id} } @ret;
-	return @ret;
-}
-
-sub TO_JSON {
-	my ($self) = @_;
-
-	return {
-		class       => $self->{class_name},
-		parameter   => $self->{parameter},
-		state       => $self->{state},
-		transition  => $self->{transition},
-		custom_code => $self->{custom_code},
-		voltage     => $self->{voltage},
-	};
-}
-
-1;