--- nfo/perl/libs/Data/Rap/Engine.pm 2003/02/22 16:51:21 1.4
+++ nfo/perl/libs/Data/Rap/Engine.pm 2003/06/23 17:54:32 1.11
@@ -1,7 +1,31 @@
## ----------------------------------------------------------------------
-## $Id: Engine.pm,v 1.4 2003/02/22 16:51:21 joko Exp $
+## $Id: Engine.pm,v 1.11 2003/06/23 17:54:32 joko Exp $
## ----------------------------------------------------------------------
## $Log: Engine.pm,v $
+## 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'
+##
+## Revision 1.6 2003/03/27 15:31:05 joko
+## fixes to modules regarding new namespace(s) below Data::Mungle::*
+##
+## Revision 1.5 2003/03/27 15:03:03 joko
+## enhanced 'sub run_executable'
+##
## Revision 1.4 2003/02/22 16:51:21 joko
## + enhanced run_executable
## modified logging output
@@ -31,8 +55,9 @@
use Iterate;
use shortcuts qw( run_cmd );
-use Data::Code::Ref qw( ref_slot );
-use Data::Transform::Deep qw( expand );
+use Data::Mungle::Code::Ref qw( ref_slot );
+use Data::Mungle::Transform::Deep qw( expand deep_copy );
+use File::Temp qw/ tempfile tempdir /;
sub performTarget {
@@ -45,12 +70,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;
@@ -62,6 +99,8 @@
$self->perform_dependencies($target);
$self->perform_details($target);
+
+ return 1;
}
@@ -93,11 +132,16 @@
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 (2004-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
+ $self->perform_command($command . '_end', undef, undef, { warn => 0 } );
}
}
@@ -109,6 +153,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');
@@ -118,7 +165,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) {
@@ -130,17 +179,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);
}
}
@@ -204,8 +270,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, '.');
}
@@ -291,11 +360,28 @@
my $self = shift;
my $opts = shift;
+ my $meta = deep_copy($opts);
+
+ delete $opts->{caption};
+ delete $opts->{async};
+
+ #print Dumper($meta);
+
if ($opts->{executable}) {
my $program = $opts->{executable};
delete $opts->{executable};
+ # determine execution method
+ my $wrapper_program = '';
+
+ # check if program is a namespace-string (contains '::') - use 'do' in this case!
+ if ($program =~ /::/) {
+ #$wrapper_program = 'rap.pl';
+ $wrapper_program = $0;
+ }
+
+ # prepare arguments
my @buf;
foreach (keys %$opts) {
my $value = $opts->{$_};
@@ -314,8 +400,9 @@
}
push @buf, "--$_=$value";
}
-
- my $cmd = $program . ' ' . join(' ', @buf);
+
+ # build {program} & {arguments}
+ my $cmd = ($wrapper_program ? $wrapper_program . ' ' : '') . $program . ' ' . join(' ', @buf);
# trace
#print "command: $cmd", "\n";
@@ -328,15 +415,89 @@
$ENV{PERL5LIB} = $INC[0];
#print Dumper(%ENV);
- run_cmd($cmd);
+
+ #print "command: '$cmd'", "\n";
+
+ # V1 - basic
+ #run_cmd($cmd);
+
+ # V1.b - enhanced: variable local method
+ $meta->{caption} ||= '';
+ $meta->{async} ||= 0;
+ # new of 2003-05-08: USE_PATH!
+ $meta->{USE_PATH} ||= 0;
+ my $evalstr = "run_cmd('$cmd', '$meta->{caption}', { async => $meta->{async}, USE_PATH => $meta->{USE_PATH} });";
+ eval($evalstr);
+ #my $res = do "$cmd";
+ #print $res, "\n" if $res;
+
+ #$self->log("run_executable: $evalstr", 'info');
+ $self->raiseException("run_executable: $evalstr\n$@") if $@;
+
# V2: via IPC::Run
# .... (TODO)
-
+
}
}
+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__