1. Herbert Breunung
  2. Kephra

Source

Kephra / lib / Kephra / CommandList.pm

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

package Kephra::CommandList;


my %list = %{ Kephra::Config::Default::commandlist() };
my %namespace;
my %switch     = ( 'name' => {}, 'package' => {} );


# 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 #("register_object_switch_var: $- 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 
	}
	else {
		return Kephra::Log::error
			("register_switch_var: 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
		("register_cmd_namespace: called without value from $calling_module") unless $name;
	$namespace{ $calling_module } = $name;
}
sub register_cmd {
	my $cmd = shift;
	return Kephra::Log::error( 'register_cmd: "$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 '-' ? $cmd_namespace . $ID : $ID ;
		Kephra::Log::warning
			( "register_cmd: $cmd lacks command namespace to prefix"), next
				if $fullID ne $ID and not $cmd_namespace;
		Kephra::Log::warning( "register_cmd: $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 {
	#%list = %{ Kephra::Config::Default::commandlist() };
	for my $cmd (keys %list) {
		my $data = $list{$cmd};
		my $call = $data->{'sub'};
		Kephra::Log::warning( "init: $cmd lacks sub value"), next unless $call;
		if (substr($call, 0, 1) eq '$'){
			if (substr($call, 1, 1) eq '_'){
				Kephra::Log::warning
					( "init: $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;
		}
		$data->{'coderef'} = eval "sub { $call }";
	}
}
sub compile_cmd {}

sub call {
	my $cmd = shift;
	$cmd = [$cmd] unless ref $cmd eq ref [];
	for (@$cmd) { $list{$_}{'coderef'}->() if exists $list{$_} }
}

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 { $list{$_[0]}                if cmd_exists($_[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__

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