Source

Kephra / lib / Kephra / API / Command.pm

use strict;
use warnings;
use Kephra::API;

package Kephra::API::Command;

my %list;     # by ID
#my %keyproxy; # by keycode
my %namespace;# module => cmd prefix 
my %switch   = ( 'name' => {}, 'package' => {} ); #switchvar vor cmd definitions
my $done_init = 0;

sub _raw_list { \%list }


# register means: to be called before CommandList::init() - module body execution time

sub register_switch_var {
	my $var = shift;
	my $calling_module = (caller)[0];
	if (ref $var eq 'HASH'){
		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} };
		}
	}
	else { return Kephra::Log::warning("need a sub name string or of a var => sub hash") }
}

sub register_context_var {
	my $var = shift;
	my $calling_module = (caller)[0];
	if (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::warning("need a sub name string or of a var => sub hash") }
}

sub register_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 {
	my $cmd = shift;
	return Kephra::Log::error( '"$cmd" has to be a hash ref', 1) unless ref $cmd eq 'HASH';
	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 " .
			property($fullID, 'sub') . " by " .
			property($fullID, 'source')  ), next if registered( $fullID );
		#for (qw/sub options state event label help keys icon/){} filter input later
		$list{$fullID}           = $cmd->{$ID};
		$list{$fullID}{'source'} = $calling_module;
		compile($fullID) if $done_init;
	}
}


sub init {
	compile( keys %list );
	$done_init = 1;
}


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)
				}
			}
		}
		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::API::KeyMap::register_keys( { $cmd => $data->{'keys'} } )
			if defined $data->{'keys'} and $data->{'keys'};
	}
}

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

sub registered      { 1 if defined $_[0]  and exists $list{ $_[0] }             }
sub property_exists { 1 if registered($_[0]) and exists $list{ $_[0] }{ $_[1] } }
sub add {}

sub all_properties { 
	if ( registered($_[0]) ) { $list{$_[0]} }
	else { Kephra::Log::warning('requested data of unknown command '.$_[0], 1) }
}
sub property       { $list{$_[0]}{$_[1]}         if property_exists(@_) }
sub set_property   { $list{$_[0]}{$_[1]} = $_[2] if 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      => '', # help text to be shown in statusbar or as popup
	keys      => 'Ctrl + N',
	icon      => '',
	bitmap    => '',  #Wx::Bitmap Object
}