Source

Kephra / lib / Kephra / CommandList.pm

use strict;
use warnings;
use Kephra::KeyMap;
use Kephra::Config::Default;
use Kephra::Log;

package Kephra::CommandList;

my %list;     # by ID
my %keyproxy; # by keycode
my %namespace;
my %switch   = ( 'name' => {}, 'package' => {} );

sub _raw { \%list }


# register means: to be called before init-on compile/module block execution time
sub register_switch_var {
	my $var = shift;
	my $calling_module = (caller)[0];
	if (ref $var eq ref {}){
		no strict 'refs';
		#return Kephra::Log::error #("$- already registered as ".$switch{'name'}{$_}) if exists $switch{'name'}{$_};
		for my $name (keys %$var){
			$var->{$name} = $calling_module . '::' . $var->{$name}
				if index($var->{$name}, '::') == -1 and $calling_module;
			$switch{'name'}{$name} = $var->{$name}
				if $var->{$name} and defined &{ $var->{$name} };
		}
	}
	elsif (not ref $var and $var) {
		$var = $calling_module . '::' . $var if index($var, '::') == -1;
		$switch{'package'}{$calling_module} = $var if defined $calling_module;
	}
	else {
		return Kephra::Log::error("need a sub name string or of a var => sub hash");
	}
}

sub register_cmd_namespace {
	my $name = shift;
	my $calling_module = (caller)[0];
	return Kephra::Log::error("called without value from $calling_module") unless $name;
	$namespace{ $calling_module } = $name;
}

sub register_cmd {
	my $cmd = shift;
	return Kephra::Log::error( '"$cmd" has to be a hash ref') unless ref $cmd eq ref {};
	my $calling_module = (caller)[0];
	my $cmd_namespace = $namespace{ $calling_module }; 
	for my $ID (keys %$cmd) {
		my $fullID = (substr($ID,0,1) eq '+' and $cmd_namespace)
			? $cmd_namespace . substr $ID, 1
			: $ID ;
		Kephra::Log::warning("$cmd lacks command namespace to prefix"), next
				if $fullID ne $ID and not $cmd_namespace;
		Kephra::Log::warning( "$cmd already registered to do " .
			cmd_property($fullID, 'sub') . " by " .
			cmd_property($fullID, 'source')  ), next
				if cmd_exists( $fullID );
		#for (qw/sub options state event label help keys icon/){} filter input later
		$list{$fullID}           = $cmd->{$ID};
		$list{$fullID}{'source'} = $calling_module;
	}
}

sub init {
	for my $cmd (keys %list) {
		my $data = $list{$cmd};
		my $call = $data->{'sub'};
		Kephra::Log::warning( "$cmd lacks sub value"), 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,'->');
				$call = $switch{'name'}{ substr($call, 0, $vl) }.'()'.
						substr($call, $vl) ;
			}
		}
		else {
			$call = $data->{'source'}.'::'.$call if index($call,'::') == -1;
		}
		# adding tail (suffix) of the call, signature part
		$call .= exists $data->{'parameter'} # just one parameter yet
			? '(\''.$data->{'parameter'}.'\')'
			: '()';
		$data->{'coderef'} = eval "sub { $call }";
		Kephra::KeyMap::register_keys( { $cmd => $data->{'keys'} } )
			if defined $data->{'keys'} and $data->{'keys'};
	}
}
sub compile_cmd {}

sub run_cmd {
	my $cmd = shift;
	$cmd = [$cmd] unless ref $cmd eq ref [];
	my $return;
	for (@$cmd) { $return = $list{$_}{'coderef'}->() if exists $list{$_} }
	$return;
}
sub run_cmd_by_keycode {
	my ($code, $map) = @_;
}

sub cmd_exists          { 1 if defined $_[0]     and exists $list{ $_[0] }          }
sub cmd_property_exists { 1 if cmd_exists($_[0]) and exists $list{ $_[0] }{ $_[1] } }
sub cmd_add {}

sub cmd_all_properties { 
	if ( cmd_exists($_[0]) ) { $list{$_[0]} }
	else                     {
		Kephra::Log::warning('requested data of unknown command '.$_[0].' from '.(caller)[0]);
	}
}
sub cmd_property       { $list{$_[0]}{$_[1]}         if cmd_property_exists(@_) }
sub cmd_set_property   { $list{$_[0]}{$_[1]} = $_[2] if cmd_property_exists(@_) }


1;

__END__

=head1 Command Definition

cmd_ID => {
	coderef   => compiled from sub, source and option, saves state
	sub       => 'Kephra::File::new',
	parameter => [],
	source    => package that registered that cmd
	state     => return value of the call or antother coderef
	event     => '',
	label     => 'New',
	help      => '',
	keys      => 'Ctrl + N',
	icon      => '',
}