--- nfo/perl/libs/Data/Rap/Engine.pm 2003/03/28 07:02:56 1.7
+++ nfo/perl/libs/Data/Rap/Engine.pm 2003/06/24 20:59:51 1.12
@@ -1,7 +1,25 @@
## ----------------------------------------------------------------------
-## $Id: Engine.pm,v 1.7 2003/03/28 07:02:56 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
+##
## Revision 1.7 2003/03/28 07:02:56 joko
## modified structure around '$wrapper_program'
##
@@ -41,7 +59,8 @@
use shortcuts qw( run_cmd );
use Data::Mungle::Code::Ref qw( ref_slot );
-use Data::Mungle::Transform::Deep qw( expand );
+use Data::Mungle::Transform::Deep qw( expand deep_copy );
+use File::Temp qw/ tempfile tempdir /;
sub performTarget {
@@ -54,12 +73,24 @@
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
#$self->log("- " x 35, 'notice');
#$self->log("Performing Target '$targetname'.", 'notice');
- $self->log($header, 'notice');
+ # V2
+ #$self->log($header, 'notice');
+
+ # V3
+ $self->log("- " x 20, 'info');
+ $self->log("Performing Target '$targetname'.", 'notice');
#exit;
@@ -71,6 +102,8 @@
$self->perform_dependencies($target);
$self->perform_details($target);
+
+ return 1;
}
@@ -102,11 +135,17 @@
foreach my $entry (@{$target->{content}}) {
my $command = $entry->{name};
my $args = $entry->{attrib};
- $self->perform_command($command, $args);
+ my $content = $entry->{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 } );
}
}
@@ -118,6 +157,9 @@
sub perform_command {
my $self = shift;
my $command = shift;
+ my $args_list = shift;
+ my $content = shift;
+ my $options = shift;
if (!$command) {
$self->log("Command was empty!", 'debug');
@@ -127,7 +169,9 @@
# FIXME: make '__PACKAGE__' go one level deeper properly!
$self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug');
- my $args_list = shift;
+
+ # 1. make arguments from list of arguments(?)
+
my $args = {};
#print Dumper($args_list);
if ($args_list) {
@@ -139,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);
+ $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);
}
}
@@ -213,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, '.');
}
@@ -300,6 +364,14 @@
my $self = shift;
my $opts = shift;
+ my $meta = deep_copy($opts);
+
+ delete $opts->{caption};
+ delete $opts->{async};
+ delete $opts->{detach};
+
+ #print Dumper($meta);
+
if ($opts->{executable}) {
my $program = $opts->{executable};
@@ -355,7 +427,12 @@
#run_cmd($cmd);
# V1.b - enhanced: variable local method
- my $evalstr = "run_cmd('$cmd', 'Some task...', { async => 1 });";
+ $meta->{caption} ||= '';
+ $meta->{async} ||= 0;
+ $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;
@@ -372,5 +449,61 @@
}
+sub run_script {
+
+ my $self = shift;
+ my $args = shift;
+ my $code = shift;
+
+ if ($args->{language} eq 'msdos/bat') {
+
+ #print "code: $code", "\n";
+
+ # reporting
+ $self->log("Executing some arbitrary unsigned code (probably unsafe). [language=$args->{language}]", 'info');
+ $self->log("\n\n$code\n", 'info');
+
+ # create temporary intermediate file to execute code
+ my $tmpdir = '/tmp/rap';
+ mkdir $tmpdir;
+ (my $fh, my $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.bat' );
+ print $fh $code, "\n";
+ run_cmd( $filename, '', { async => 1 } );
+
+ # FIXME: DELETE code inside temp-files as soon as possible!
+ #print $fh '';
+
+ # TODO: delete FILE completely!
+ # required for this: wait until execution has finished, then unlink....
+ # but: "how to wait until execution is finished"?
+ # i believe the best is to spawn *another* process directly from here,
+ # let's call it 'watcher-agent'.
+ # This one should monitor a certain running process and delete its
+ # executable file after it has finished execution.
+ # Possible extensions could be:
+ # keep track of all stuff sent to STDOUT or STDERR and
+ # send that stuff to the task-owner indirectly (not via shell/console)
+ # (e.g. via email, by posting report to a newsgroup or publishing on a specified web-page: use mod-dav!)
+
+ } 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');
+
+ }
+
+}
+
1;
__END__