Source

Kephra / lib / Kephra / API / Command.pm

Full commit
use v5.10;
use warnings;
use Kephra::Log;

package Kephra::API::Command;                             # callable by the user (UI)
my %list;     # by ID
#my %keyproxy;# by keycode
my %switchvar; #switchvar vor cmd definitions


sub      _raw_list { \%list }
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] }


sub switch_variables {
	my ($var_def) = shift;
	my $api = 'Kephra::API';
	my $caller = calling_module();
	return Kephra::Log::error("only callable by $api", 1) if $caller ne $api;
	#return Kephra::Log::error("call me just once", 1) if keys %switchvar;
	return Kephra::Log::error("need a hashref", 1) unless ref $var_def eq 'HASH';
	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 ( $var_def->{$var}{'class'} ); # class could be loaded later
	}
	%switchvar = %$var_def;
	compile( keys %list );
}

sub register {
	my $cmd = shift;
	return Kephra::Log::error("cmd def have to be in a hash ref, not $cmd", 1)
		unless ref $cmd eq 'HASH';
	my $caller = calling_module();
	for my $ID (keys %$cmd) {
		Kephra::Log::warning( 
			"$cmd already registered to do ". property($ID, 'sub')." by ".
			property($ID, 'source')  ), next if registered( $ID );
		#for (qw/sub options state event label help keys icon/){} filter input later
		$list{$ID}           = $cmd->{$ID};
		$list{$ID}{'source'} = $caller;
		compile($ID) if %switchvar; #dont make sense without defined switch var
	}
}


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;

		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);
		}
		elsif ( index($sub, '::') == -1) {
			$cmd->{'coderef'} = $cmd->{'source'} . '::' . $sub
		}
		else { $cmd->{'coderef'} = $sub }

		# add parameter if are any
		$cmd->{'coderef'} .= exists $cmd->{'parameter'} # just one parameter yet
			? "( '" . $cmd->{'parameter'} . "' )"
			: '()';
		$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 [];
	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
}