--- nfo/perl/libs/Data/Rap/Engine.pm 2003/03/29 07:11:54 1.8
+++ nfo/perl/libs/Data/Rap/Engine.pm 2003/06/24 20:59:51 1.12
@@ -1,7 +1,21 @@
## ----------------------------------------------------------------------
-## $Id: Engine.pm,v 1.8 2003/03/29 07:11:54 joko Exp $
+## $Id: Engine.pm,v 1.12 2003/06/24 20:59:51 jonen Exp $
## ----------------------------------------------------------------------
## $Log: Engine.pm,v $
+## Revision 1.12 2003/06/24 20:59:51 jonen
+## added option 'detach'
+##
+## Revision 1.11 2003/06/23 17:54:32 joko
+## prepared execution of in-process perl-code via eval (not activated yet!)
+##
+## Revision 1.10 2003/05/13 07:56:12 joko
+## enhanced: *hierarchical* containers for context handling
+## fixes: some pre-flight checks
+## new: propagate "end-tag" event to e.g. close containers
+##
+## Revision 1.9 2003/04/04 17:23:11 joko
+## minor update: debugging output
+##
## Revision 1.8 2003/03/29 07:11:54 joko
## modified: sub run_executable
## new: sub run_script
@@ -59,6 +73,12 @@
my $self = shift;
my $targetname = shift;
+ # pre-flight checks
+ if (!$targetname) {
+ $self->log("Target name empty. Please try to specify (e.g.) on the command line.", 'critical');
+ return;
+ }
+
my $header = ("- " x 12) . " " . $targetname . " " . ("- " x 6);
# V1
@@ -69,7 +89,7 @@
#$self->log($header, 'notice');
# V3
- $self->log("- " x 35, 'info');
+ $self->log("- " x 20, 'info');
$self->log("Performing Target '$targetname'.", 'notice');
#exit;
@@ -82,6 +102,8 @@
$self->perform_dependencies($target);
$self->perform_details($target);
+
+ return 1;
}
@@ -114,11 +136,16 @@
my $command = $entry->{name};
my $args = $entry->{attrib};
my $content = $entry->{content};
- $self->perform_command($command, $args, $content);
+ $self->perform_command($command, $args, $content, { warn => 1 } );
# check recursiveness
- if ($entry->{content} && ref $entry->{content}) {
+ # new condition: don't recurse if node is flagged to have inline-args (2003-04-17)
+ my $has_inline_args = ($entry->{attrib}->{_args} && $entry->{attrib}->{_args} eq 'inline');
+ if ($entry->{content} && ref $entry->{content} && !$has_inline_args) {
$self->perform_details($entry);
}
+ # new of 2003-05-08
+ $command ||= '';
+ $self->perform_command($command . '_end', undef, undef, { warn => 0 } );
}
}
@@ -132,6 +159,7 @@
my $command = shift;
my $args_list = shift;
my $content = shift;
+ my $options = shift;
if (!$command) {
$self->log("Command was empty!", 'debug');
@@ -141,6 +169,9 @@
# FIXME: make '__PACKAGE__' go one level deeper properly!
$self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug');
+
+ # 1. make arguments from list of arguments(?)
+
my $args = {};
#print Dumper($args_list);
if ($args_list) {
@@ -152,17 +183,34 @@
$args = $args_list;
}
}
- $command = '_' . $command;
- # determine container
+ # 2. prepare command
+
+ # default setting for internal rap commands
+ my $method_prefix_default = '_';
+ # setting from property database
+ my $method_prefix_setting = $self->get_property('core.method_prefix');
+ #print "setting: ", $method_prefix_setting, "\n";
+ my $prefix = $method_prefix_setting;
+ if (not defined $prefix) {
+ $prefix = $method_prefix_default;
+ }
+ $command = $prefix . $command;
+
+
+ # 3. determine container
my $container; # = $self->getInstance();
+ #$container ||= $self->getInstance();
$container ||= $self;
+ # 4. run method
if ($container->can($command)) {
$container->$command($args, $content);
} else {
- $self->log("Command '$command' not implemented.", "warning");
+ my $level = "debug";
+ $level = "warning" if $options->{warn};
+ $self->log("Command '$command' not implemented.", $level);
}
}
@@ -226,8 +274,11 @@
$self->log("set-name: $name");
+ #print Dumper($name, $value, '.');
+
# fill property slot with given value
- if ($value) {
+ # fix (2003-04-17): always do fill if value is *defined*!!!
+ if (defined $value) {
ref_slot($self, $name, $value, '.');
}
@@ -317,6 +368,7 @@
delete $opts->{caption};
delete $opts->{async};
+ delete $opts->{detach};
#print Dumper($meta);
@@ -377,7 +429,10 @@
# V1.b - enhanced: variable local method
$meta->{caption} ||= '';
$meta->{async} ||= 0;
- my $evalstr = "run_cmd('$cmd', '$meta->{caption}', { async => $meta->{async} });";
+ $meta->{detach} ||= 0;
+ # new of 2003-05-08: USE_PATH!
+ $meta->{USE_PATH} ||= 0;
+ my $evalstr = "run_cmd('$cmd', '$meta->{caption}', { async => $meta->{async}, detach => $meta->{detach}, USE_PATH => $meta->{USE_PATH} });";
eval($evalstr);
#my $res = do "$cmd";
#print $res, "\n" if $res;
@@ -432,6 +487,16 @@
} elsif ($args->{language} eq 'bash') {
$self->log("FIXME: - - - - - -- - - -- BASH - - - - - - - -- - ", 'error');
+
+ } elsif ($args->{language} eq 'perl') {
+
+ # reporting
+ #$self->log("Executing some arbitrary unsigned code (probably unsafe). [language=$args->{language}]", 'info');
+ #$self->log("\n\n$code\n
", 'info');
+
+ # do it
+ #eval($code);
+ #$self->log("\n\n$code\n
", 'error') if $@;
} else {
$self->log("FIXME: Script language '$args->{language}' not implemented.", 'error');