--- nfo/perl/libs/Data/Rap/Engine.pm 2003/05/13 07:56:12 1.10
+++ nfo/perl/libs/Data/Rap/Engine.pm 2004/05/12 14:23:31 1.14
@@ -1,7 +1,19 @@
## ----------------------------------------------------------------------
-## $Id: Engine.pm,v 1.10 2003/05/13 07:56:12 joko Exp $
+## $Id: Engine.pm,v 1.14 2004/05/12 14:23:31 jonen Exp $
## ----------------------------------------------------------------------
## $Log: Engine.pm,v $
+## Revision 1.14 2004/05/12 14:23:31 jonen
+## add comment/code related to PERL5LIB var at different OS's
+##
+## Revision 1.13 2003/12/05 05:02:08 joko
+## + minor update: disabled some unnecessary loggers or changed to debug-level
+##
+## 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
@@ -56,6 +68,7 @@
use Data::Mungle::Transform::Deep qw( expand deep_copy );
use File::Temp qw/ tempfile tempdir /;
+my $DEBUG = 0;
sub performTarget {
my $self = shift;
@@ -83,7 +96,7 @@
#$self->log($header, 'notice');
# V3
- $self->log("- " x 20, 'info');
+ #$self->log("- " x 20, 'info');
$self->log("Performing Target '$targetname'.", 'notice');
#exit;
@@ -132,12 +145,13 @@
my $content = $entry->{content};
$self->perform_command($command, $args, $content, { warn => 1 } );
# check recursiveness
- # new condition: don't recurse if node is flagged to have inline-args (2004-04-17)
+ # 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 } );
}
}
@@ -155,12 +169,12 @@
my $options = shift;
if (!$command) {
- $self->log("Command was empty!", 'debug');
+ $self->log("Command was empty!", 'debug') if $DEBUG;
return;
}
# FIXME: make '__PACKAGE__' go one level deeper properly!
- $self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug');
+ $self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug') if $DEBUG;
# 1. make arguments from list of arguments(?)
@@ -203,7 +217,7 @@
} else {
my $level = "debug";
$level = "warning" if $options->{warn};
- $self->log("Command '$command' not implemented.", $level);
+ $self->log("Command '$command' not implemented.", $level) if $DEBUG;
}
}
@@ -330,7 +344,7 @@
$name = '__rap.properties.' . $name;
- $self->log("get-name: $name");
+ $self->log("get-name: $name") if $DEBUG;
# get property slot and return value
$result = ref_slot($self, $name, undef, '.');
@@ -361,6 +375,7 @@
delete $opts->{caption};
delete $opts->{async};
+ delete $opts->{detach};
#print Dumper($meta);
@@ -405,11 +420,15 @@
#print "command: $cmd", "\n";
# start process
- # V1: via shortcut
- #$ENV{PERL5LIB} = join(' ', @INC);
-
- # FIXME!!! what about the other slots of @INC?
+ # 2004-05-11 - seems like only ONE args is valid at PERL5LIB,
+ # so we use V2!
+ # V1: join all args
+ #$ENV{PERL5LIB} = join(' ', @INC);
+ # V2: insert only FIRST arg
$ENV{PERL5LIB} = $INC[0];
+ # WARNING: at (free)BSD our var is the SECOND, NOT FIRST!!
+ # FIXME!! Do this in an abstract way!!
+ #$ENV{PERL5LIB} = $INC[1];
#print Dumper(%ENV);
@@ -421,9 +440,10 @@
# V1.b - enhanced: variable local method
$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}, USE_PATH => $meta->{USE_PATH} });";
+ 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;
@@ -478,6 +498,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');