package App::Asciio ;
$|++ ;
use strict;
use warnings;
use Data::TreeDumper ;
use Eval::Context ;
use Carp ;
use Module::Util qw(find_installed) ;
use File::Basename ;
#------------------------------------------------------------------------------------------------------
sub setup
{
my($self, $setup_ini_files) = @_ ;
for my $setup_file (@{$setup_ini_files})
{
print "Initializing with '$setup_file'\n" if $self->{DISPLAY_SETUP_INFORMATION};
unless(-e $setup_file)
{
croak "Can't find setup data '$setup_file'\n" ;
}
push @{$self->{SETUP_PATHS}}, $setup_file ;
my ($setup_name, $setup_path, $setup_ext) = File::Basename::fileparse($setup_file, ('\..*')) ;
my $ini_files ;
{
my $context = new Eval::Context() ;
$ini_files = $context->eval
(
PRE_CODE => "use strict;\nuse warnings;\n",
CODE_FROM_FILE => $setup_file,
) ;
die "can't load '$setup_file': $! $@\n" if $@ ;
}
$self->setup_stencils($setup_path, $ini_files->{STENCILS} || []) ;
$self->setup_hooks($setup_path, $ini_files->{HOOK_FILES} || []) ;
$self->setup_action_handlers($setup_path, $ini_files->{ACTION_FILES} || []) ;
$self->setup_import_export_handlers($setup_path, $ini_files->{IMPORT_EXPORT} || []) ;
$self->setup_object_options($setup_path, $ini_files->{ASCIIO_OBJECT_SETUP} || []) ;
}
}
#------------------------------------------------------------------------------------------------------
sub setup_stencils
{
my($self, $setup_path, $stencils) = @_ ;
for my $stencil (@{$stencils})
{
if(-e "$setup_path/$stencil")
{
if(-f "$setup_path/$stencil")
{
print "loading stencil '$setup_path$stencil'\n" if $self->{DISPLAY_SETUP_INFORMATION} ;
$self->load_elements("$setup_path/$stencil", $stencil) ;
}
elsif(-d "$setup_path/$stencil")
{
for(glob("$setup_path/$stencil/*"))
{
print "batch loading stencil '$setup_path/$stencil/$_'\n" if $self->{DISPLAY_SETUP_INFORMATION} ;
$self->load_elements($_, $stencil) ;
}
}
else
{
print "Unknown type '$setup_path/$stencil'!\n" ;
}
}
else
{
print "Can't find '$setup_path/$stencil'!\n" ;
}
}
}
#------------------------------------------------------------------------------------------------------
my Readonly $CATEGORY = 0 ;
my Readonly $SHORTCUTS = 0 ;
my Readonly $CODE = 1 ;
my Readonly $ARGUMENTS = 2 ;
my Readonly $CONTEXT_MENUE_SUB = 3;
my Readonly $CONTEXT_MENUE_ARGUMENTS = 4 ;
my Readonly $NAME= 5 ;
my Readonly $ORIGIN= 6 ;
sub setup_hooks
{
my($self, $setup_path, $hook_files) = @_ ;
for my $hook_file (@{ $hook_files })
{
my $context = new Eval::Context() ;
my @hooks ;
$context->eval
(
REMOVE_PACKAGE_AFTER_EVAL => 0, # VERY IMPORTANT as we return code references that will cease to exist otherwise
INSTALL_SUBS => {register_hooks => sub{@hooks = @_}},
PRE_CODE => "use strict;\nuse warnings;\n",
CODE_FROM_FILE => "$setup_path/$hook_file" ,
) ;
die "can't load hook file '$hook_file ': $! $@\n" if $@ ;
for my $hook (@hooks)
{
$self->{HOOKS}{$hook->[$CATEGORY]} = $hook->[$CODE] ;
}
}
}
#------------------------------------------------------------------------------------------------------
sub setup_action_handlers
{
my($self, $setup_path, $action_files) = @_ ;
for my $action_file (@{ $action_files })
{
#~ print "setup_action_handlers: loading '$action_file'\n" ;
my $context = new Eval::Context() ;
#~ print "loading action '$setup_path$action_file'\n" ;
my %action_handlers;
$context->eval
(
REMOVE_PACKAGE_AFTER_EVAL => 0, # VERY IMPORTANT as we return code references that will cease to exist otherwise
INSTALL_SUBS => {register_action_handlers => sub{%action_handlers = @_}},
PRE_CODE => "use strict;\nuse warnings;\n",
CODE_FROM_FILE => "$setup_path/$action_file",
) ;
die "can't load setup file '$action_file': $! $@\n" if $@ ;
for my $name (keys %action_handlers)
{
my $action_handler ;
my $group_name ;
my $shortcuts_definition ;
if('HASH' eq ref $action_handlers{$name})
{
$shortcuts_definition = $action_handlers{$name}{SHORTCUTS} ;
$action_handlers{$name}{GROUP_NAME} = $group_name = $name ;
$action_handlers{$name}{ORIGIN} = $action_file;
$action_handler = $self->get_group_action_handler($action_handlers{$name}, $action_file) ;
}
elsif('ARRAY' eq ref $action_handlers{$name})
{
$shortcuts_definition= $action_handlers{$name}[$SHORTCUTS] ;
$action_handlers{$name}[$NAME] = $name ;
$action_handlers{$name}[$ORIGIN] = $action_file ;
$action_handler = $action_handlers{$name} ;
}
else
{
#~ print "ignoring '$name'\n" ;
next ;
}
$self->{ACTIONS_BY_NAME}{$name} = $action_handlers{$name} ;
my $shortcuts ;
if('ARRAY' eq ref $shortcuts_definition)
{
$shortcuts = $shortcuts_definition ;
}
else
{
$shortcuts = [$shortcuts_definition] ;
}
for my $shortcut (@$shortcuts)
{
if(exists $self->{ACTIONS}{$shortcut})
{
print "Overriding shortcut '$shortcut'!\n" ;
print "\tnew is '$name' defined in file '$action_file'\n" ;
print "\told was '$self->{ACTIONS}{$shortcut}[5]' defined in file '$self->{ACTIONS}{$shortcut}[6]'\n" ;
}
$self->{ACTIONS}{$shortcut} = $action_handler ;
if(defined $group_name)
{
$self->{ACTIONS}{$shortcut}{GROUP_NAME} = $group_name ;
$self->{ACTIONS}{$shortcut}{ORIGIN} = $action_file;
}
}
}
}
}
sub get_group_action_handler
{
my ($self, $action_handler_definition, $action_file) = @_ ;
my %handler ;
for my $name (keys %{$action_handler_definition})
{
my $action_handler ;
my $group_name ;
my $shortcuts_definition ;
if('SHORTCUTS' eq $name)
{
#~ print "Found shortcuts definition.\n" ;
next ;
}
elsif('HASH' eq ref $action_handler_definition->{$name})
{
$shortcuts_definition= $action_handler_definition->{$name}{SHORTCUTS} ;
$action_handler_definition->{$name}{GROUP_NAME} = $group_name = $name ;
$action_handler_definition->{$name}{ORIGIN} = $action_file ;
$action_handler = $self->get_group_action_handler($action_handler_definition->{$name}, $action_file) ;
}
elsif('ARRAY' eq ref $action_handler_definition->{$name})
{
$shortcuts_definition= $action_handler_definition->{$name}[$SHORTCUTS] ;
$action_handler_definition->{$name}[$NAME] = $name ;
$action_handler_definition->{$name}[$ORIGIN] = $action_file ;
$action_handler = $action_handler_definition->{$name} ;
}
else
{
#~ print "ignoring '$name'\n" ;
next ;
}
my $shortcuts ;
if('ARRAY' eq ref $shortcuts_definition)
{
$shortcuts = $shortcuts_definition ;
}
else
{
$shortcuts = [$shortcuts_definition] ;
}
for my $shortcut (@$shortcuts)
{
if(exists $handler{$shortcut})
{
print "Overriding action group '$shortcut' with definition from file'$action_file'!\n" ;
}
$handler{$shortcut} = $action_handler ;
if(defined $group_name)
{
$handler{$shortcut}{GROUP_NAME} = $group_name ;
}
}
}
return \%handler ;
}
#------------------------------------------------------------------------------------------------------
sub setup_import_export_handlers
{
my($self, $setup_path, $import_export_files) = @_ ;
for my $import_export_file (@{ $import_export_files })
{
my $context = new Eval::Context() ;
my %import_export_handlers ;
$context->eval
(
REMOVE_PACKAGE_AFTER_EVAL => 0, # VERY IMPORTANT as we return code references that will cease to exist otherwise
INSTALL_SUBS => {register_import_export_handlers => sub{%import_export_handlers = @_}},
PRE_CODE => <<EOC ,
use strict;
use warnings;
EOC
CODE_FROM_FILE => "$setup_path/$import_export_file",
) ;
die "can't load import/export handler defintion file '$import_export_file': $! $@\n" if $@ ;
for my $extension (keys %import_export_handlers)
{
if(exists $self->{IMPORT_EXPORT_HANDLERS}{$extension})
{
print "Overriding import/export handler for extension '$extension'!\n" ;
}
$self->{IMPORT_EXPORT_HANDLERS}{$extension} = $import_export_handlers{$extension} ;
}
}
}
#------------------------------------------------------------------------------------------------------
sub setup_object_options
{
my($self, $setup_path, $options_files) = @_ ;
for my $options_file (@{ $options_files })
{
my $context = new Eval::Context() ;
my %options =
$context->eval
(
PRE_CODE => "use strict;\nuse warnings;\n",
CODE_FROM_FILE => "$setup_path/$options_file",
) ;
for my $option_name (keys %options)
{
$self->{$option_name} = $options{$option_name} ;
}
die "can't load setup file '$options_file': $! $@\n" if $@ ;
}
$self->event_options_changed() ;
}
#------------------------------------------------------------------------------------------------------
sub run_script
{
my($self, $script) = @_ ;
if(defined $script)
{
my $context = new Eval::Context() ;
$context->eval
(
PRE_CODE => "use strict;\nuse warnings;\n",
CODE_FROM_FILE => $script,
INSTALL_VARIABLES =>
[
[ '$self' => $self => $Eval::Context::SHARED ],
] ,
) ;
die "can't load setup file '$script': $! $@\n" if $@ ;
}
}
#------------------------------------------------------------------------------------------------------
1 ;