Commits

Herbert Breunung  committed 8e889dd

rewrote command API its easier nor mor lightweight, have to add chekcs into testsuite

  • Participants
  • Parent commits 3ec88c7

Comments (0)

Files changed (2)

File lib/Kephra/API.pm

 use strict;
 use warnings;
-use Carp;
+#use Carp;
 use Kephra::API::Command;
 use Kephra::API::Docs;
 use Kephra::API::Event;
 package Kephra::API;
 my $VERSION = 0.1;
 
-Kephra::API::Command::switch_variables({
- '$app'    => { switch => 'app',         class => 'Kephra::App' },
- '$win'    => { switch => 'main_window', class => 'Kephra::App::Window' },
- '$docbar' => { switch => 'docbar',      class => 'Kephra::App::Bar::Document' },
- '$doc'    => { switch => 'document',    class => 'Kephra::Document' },
- '$ed'     => { switch => 'editor',      class => 'Kephra::App::Editor' },
-});
-Kephra::API::Command::init();
-Kephra::Config::init();
-
-Kephra::API::Command::register_switch_var({
-	'$app'    => 'app',
-	'$win'    => 'main_window',
-	'$docbar' => 'docbar',
-	'$doc'    => 'document',
-	'$ed'     => 'editor',
-});
 
 sub app             { $Kephra::App::_ref }
 sub main_window     { $Kephra::App::Window::_ref }
 
 
 
+Kephra::API::Command::switch_variables({
+ '$app'    => { switch => 'app',         class => 'Kephra::App' },
+ '$win'    => { switch => 'main_window', class => 'Kephra::App::Window' },
+ '$docbar' => { switch => 'docbar',      class => 'Kephra::App::Bar::Document' },
+ '$doc'    => { switch => 'document',    class => 'Kephra::Document' },
+ '$ed'     => { switch => 'editor',      class => 'Kephra::App::Editor' },
+});
+Kephra::API::Command::init();
+Kephra::Config::init();
+
+
+
 1; # if you want to know more, please read Kephra::Internals.pod
 

File lib/Kephra/API/Command.pm

 
 my %list;     # by ID
 #my %keyproxy;# by keycode
-my %switch   = ( 'name' => {}, 'package' => {} ); #switchvar vor cmd definitions
 my %switchvar; #switchvar vor cmd definitions
 my $done_init = 0;
 
+
 sub      _raw_list { \%list }
-sub sub_exists     { no strict 'refs'; *{ $_[0] }{CODE} if $_[0] }
-sub package_exists { no strict 'refs'; %{ $_[0] . '::' } if $_[0] }
+sub sub_exists     { no strict 'refs'; !!*{ $_[0] }{CODE} if $_[0] }
+sub package_exists { no strict 'refs'; !!%{ $_[0] . '::' } if $_[0] }
 sub calling_module { ( caller(1) )[0] }
 
 
 	for my $var (keys %$var_def){
 		delete $var_def->{$var} unless substr($var, 0, 1) eq '$';
 		delete $var_def->{$var} unless sub_exists( $api .'::'. $var_def->{$var}{'switch'} );
-		delete $var_def->{$var} unless package_exists $INC{ $var_def->{$var}{'class'} };
+		delete $var_def->{$var} unless package_exists ( $var_def->{$var}{'class'} );
 	}
 	%switchvar = %$var_def;
 }
 
-sub register_switch_var {
-	my $var = shift;
-	return Kephra::Log::error("need at least one var => sub relation (hash)", 1)
-		unless ref $var eq 'HASH';
-	my $calling_module = calling_module();
-	no strict 'refs';
-	for my $name (keys %$var){
-		#return Kephra::Log::error #("$name already registered as ".$switch{'name'}{$name})
-			#if exists $switch{'name'}{$name};
-		$var->{$name} = $calling_module.'::'.$var->{$name}
-			if index($var->{$name},'::') == -1;
-		next, Kephra::Log::error("need name of existing sub, not name", 1) 
-			if not sub_exists( $var->{$name} ) and $done_init;
-		$switch{'name'}{$name} = $var->{$name}
-			if $var->{$name} and defined &{ $var->{$name} };
-	}
-}
-
-sub register_context_var {
-	my $sub = shift;
-	return Kephra::Log::error("need name of existing sub(string)", 1) unless defined $sub;
-	my $calling_module = (caller)[0];
-	$sub = $calling_module . '::' . $sub if index($sub, '::') == -1;
-	return Kephra::Log::error("need name of existing sub(string), not $sub", 1)
-		if not sub_exists($sub) and $done_init;
-	$switch{'package'}{$calling_module} = $sub;
-}
-
-
-
 sub register {
 	my $cmd = shift;
 	return Kephra::Log::error("cmd def have to be in a hash ref, not $cmd", 1)
 	}
 }
 
-
 sub init {
 	compile( keys %list );
-	for my $var (keys %{ $switch{'name'} }) {
-		my $call = $switch{'name'}{$var};
-		Kephra::Log::warning("$var has noneexisting switch call $call")
-			unless sub_exists( $call );
-	}
-	for my $pkg (keys %{ $switch{'package'} }) {
-		my $call = $switch{'package'}{$pkg};
-		Kephra::Log::warning("$pkg has noneexisting context switch call $call")
-			unless sub_exists( $call );
-	}
 	$done_init = 1;
 }
 
+sub compile {
+	for my $cmd_ID (@_) {
+		my $cmd = $list{ $cmd_ID };
+		my $sub = $cmd->{'sub'};
+		Kephra::Log::warning( "$cmd_ID lacks value on hashkey 'sub'"), next unless $sub;
 
-sub compile {
-	for my $cmd (@_) {
-		my $data = $list{$cmd};
-		my $call = $data->{'sub'};
-		Kephra::Log::warning( "$cmd lacks value on hashkey 'sub'"), next unless $call;
-		# insert start (prefix) of the call, module name mostly
-		if (substr($call, 0, 1) eq '$'){
-			if (substr($call, 1, 1) eq '_'){
-				Kephra::Log::warning
-					( "$cmd lacks switch declared by ".$data->{'source'}), next
-						unless $switch{'package'}{ $data->{'source'} };
-				$call = $switch{'package'}{ $data->{'source'}}.'()'.substr($call, 2);
-			}
-			else {
-				my $vl = index($call,'->');
-				my $switchvar = substr($call, 0, $vl);
-				if (exists $switch{'name'}{$switchvar}){
-					$call = $switch{'name'}{$switchvar}.'()'.substr($call, $vl)
-				} else {
-					Kephra::Log::error( "used unknown switchvar $switchvar", 1)
-				}
-			}
+		if ( substr($sub, 0, 1) eq '$'){
+			my $method_pos = index($sub, '->');
+			my $var = substr($sub, 0, $method_pos);
+			Kephra::Log::warning
+				("unknown switchvar $var in $cmd_ID 'sub' entry", 1), next
+					unless ref $switchvar{ $var };
+			my $method = $switchvar{$var}{'class'}.'::'.substr($sub, $method_pos+2);
+			# move that check into test suite
+			#Kephra::Log::warning ("called unknown method with $sub", 1), next
+			#	unless sub_exists($method) ;
+			
+			$cmd->{'coderef'} = 'Kephra::API::' . $switchvar{$var}{'switch'} . '()' .
+			                      substr($sub, $method_pos);
 		}
-		else { $call = $data->{'source'}.'::'.$call if index($call,'::') == -1 }
-		#my $coderef = $call;
-		#my $switchpos = index($coderef, '()->');
-		#substr $coderef, $switchpos, 4, '::' if $switchpos > -1;
-		#Kephra::Log::warning("$cmd calls nonexisting sub $call", 1)
-		#	unless sub_exists( $coderef );
+		elsif ( index($sub, '::') == -1) {
+			$cmd->{'coderef'} = $cmd->{'source'} . '::' . $sub
+		}
+		else { $cmd->{'coderef'} = $sub }
 
-		# adding tail (suffix) of the call, signature part
-		$call .= exists $data->{'parameter'} # just one parameter yet
-			? '(\''.$data->{'parameter'}.'\')'
+		# add parameter if are any
+		$cmd->{'coderef'} .= exists $cmd->{'parameter'} # just one parameter yet
+			? "( '" . $cmd->{'parameter'} . "' )"
 			: '()';
-		$data->{'coderef'} = eval "sub { $call }";
-		Kephra::API::KeyMap::register_keys( { $cmd => $data->{'keys'} } )
-			if defined $data->{'keys'} and $data->{'keys'};
+		$cmd->{'coderef'} = eval 'sub { ' . $cmd->{'coderef'} . ' }';
+
+		Kephra::API::KeyMap::register_keys({ $cmd_ID => $cmd->{'keys'} }) if $cmd->{'keys'};
 	}
 }
 
+
 sub run {
 	my $cmd = shift;
 	$cmd = [$cmd] unless ref $cmd eq ref [];