/[cvs]/nfo/perl/libs/Data/Rap/Engine.pm
ViewVC logotype

Annotation of /nfo/perl/libs/Data/Rap/Engine.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations)
Fri Apr 4 17:23:11 2003 UTC (21 years, 3 months ago) by joko
Branch: MAIN
Changes since 1.8: +6 -2 lines
minor update: debugging output

1 joko 1.1 ## ----------------------------------------------------------------------
2 joko 1.9 ## $Id: Engine.pm,v 1.8 2003/03/29 07:11:54 joko Exp $
3 joko 1.1 ## ----------------------------------------------------------------------
4 joko 1.2 ## $Log: Engine.pm,v $
5 joko 1.9 ## Revision 1.8 2003/03/29 07:11:54 joko
6     ## modified: sub run_executable
7     ## new: sub run_script
8     ##
9 joko 1.8 ## Revision 1.7 2003/03/28 07:02:56 joko
10     ## modified structure around '$wrapper_program'
11     ##
12 joko 1.7 ## Revision 1.6 2003/03/27 15:31:05 joko
13     ## fixes to modules regarding new namespace(s) below Data::Mungle::*
14     ##
15 joko 1.6 ## Revision 1.5 2003/03/27 15:03:03 joko
16     ## enhanced 'sub run_executable'
17     ##
18 joko 1.5 ## Revision 1.4 2003/02/22 16:51:21 joko
19     ## + enhanced run_executable
20     ## modified logging output
21     ##
22 joko 1.4 ## Revision 1.3 2003/02/21 01:46:17 joko
23     ## renamed core function
24     ##
25 joko 1.3 ## Revision 1.2 2003/02/20 19:46:33 joko
26     ## renamed and revamped some of modules
27     ## renamed methods
28     ## + sub run_executable
29     ##
30 joko 1.2 ## Revision 1.1 2003/02/18 15:35:25 joko
31     ## + initial commit
32     ##
33 joko 1.1 ## ----------------------------------------------------------------------
34    
35    
36     package Data::Rap::Engine;
37    
38     use strict;
39     use warnings;
40    
41    
42     use Data::Dumper;
43 joko 1.2 use Hash::Merge qw( merge );
44 joko 1.1 use Iterate;
45 joko 1.2
46     use shortcuts qw( run_cmd );
47 joko 1.6 use Data::Mungle::Code::Ref qw( ref_slot );
48 joko 1.8 use Data::Mungle::Transform::Deep qw( expand deep_copy );
49     use File::Temp qw/ tempfile tempdir /;
50 joko 1.1
51    
52     sub performTarget {
53     my $self = shift;
54     my $targetname = shift;
55 joko 1.2 $self->perform_target($targetname);
56     }
57    
58     sub perform_target {
59     my $self = shift;
60     my $targetname = shift;
61    
62 joko 1.4 my $header = ("- " x 12) . " " . $targetname . " " . ("- " x 6);
63    
64 joko 1.8 # V1
65 joko 1.4 #$self->log("- " x 35, 'notice');
66     #$self->log("Performing Target '$targetname'.", 'notice');
67    
68 joko 1.8 # V2
69     #$self->log($header, 'notice');
70    
71     # V3
72 joko 1.9 $self->log("- " x 20, 'info');
73 joko 1.8 $self->log("Performing Target '$targetname'.", 'notice');
74 joko 1.2
75     #exit;
76    
77     my $target = $self->getTargetDetails($targetname);
78 joko 1.1
79     # trace
80     #print Dumper($target);
81     #exit;
82    
83 joko 1.2 $self->perform_dependencies($target);
84     $self->perform_details($target);
85    
86     }
87    
88     sub perform_dependencies {
89     my $self = shift;
90     my $target = shift;
91 joko 1.1 # resolve dependencies (just run prior)
92     if (my $targetname_dep = $target->{attrib}->{depends}) {
93 joko 1.2 my @targets = split(/,\s|,/, $targetname_dep);
94     #print Dumper(@targets);
95     #$self->perform($targetname_dep);
96     #delete $target->{attrib}->{depends};
97     foreach (@targets) {
98     if (!$self->{__rap}->{dependencies}->{resolved}->{$_}++) {
99     $self->perform_target($_);
100     }
101     }
102 joko 1.1 delete $target->{attrib}->{depends};
103     }
104 joko 1.2 }
105 joko 1.1
106 joko 1.2 sub perform_details {
107     my $self = shift;
108     my $target = shift;
109    
110     #print Dumper($target);
111     #exit;
112    
113 joko 1.1 foreach my $entry (@{$target->{content}}) {
114     my $command = $entry->{name};
115     my $args = $entry->{attrib};
116 joko 1.8 my $content = $entry->{content};
117     $self->perform_command($command, $args, $content);
118 joko 1.2 # check recursiveness
119     if ($entry->{content} && ref $entry->{content}) {
120     $self->perform_details($entry);
121     }
122 joko 1.1 }
123     }
124    
125     sub rc {
126     my $self = shift;
127 joko 1.2 return $self->perform_command(@_);
128 joko 1.1 }
129    
130 joko 1.2 sub perform_command {
131 joko 1.1 my $self = shift;
132     my $command = shift;
133 joko 1.8 my $args_list = shift;
134     my $content = shift;
135 joko 1.2
136 joko 1.1 if (!$command) {
137 joko 1.4 $self->log("Command was empty!", 'debug');
138 joko 1.1 return;
139     }
140 joko 1.2
141     # FIXME: make '__PACKAGE__' go one level deeper properly!
142     $self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug');
143 joko 1.1
144     my $args = {};
145     #print Dumper($args_list);
146     if ($args_list) {
147     if (ref $args_list eq 'ARRAY') {
148     foreach (@$args_list) {
149     $args = merge($args, $_);
150     }
151     } else {
152     $args = $args_list;
153     }
154     }
155     $command = '_' . $command;
156 joko 1.2
157    
158     # determine container
159     my $container; # = $self->getInstance();
160     $container ||= $self;
161    
162     if ($container->can($command)) {
163 joko 1.8 $container->$command($args, $content);
164 joko 1.1 } else {
165 joko 1.2 $self->log("Command '$command' not implemented.", "warning");
166 joko 1.1 }
167 joko 1.2
168 joko 1.1 }
169    
170 joko 1.2
171     sub merge_properties {
172 joko 1.1 my $self = shift;
173 joko 1.2 my $name = shift;
174     my $data = shift;
175 joko 1.1
176 joko 1.2 $self->log("merge-name: $name");
177     #print "name: $name", "\n";
178     #print Dumper($data);
179     #exit;
180 joko 1.1
181 joko 1.2 # check if slot (or childs of it) is/are already occupied
182     #if (my $data_old = ref_slot($self, $name, undef, '.')) {
183     if (my $data_old = $self->get_property($name)) {
184     #print "old:", "\n";
185     #print Dumper($data_old);
186    
187     # FIXME: review - any options for 'merge' here?
188     my $data_new = merge($data_old, $data);
189     #print "DATA NEE! - MERGE!", "\n";
190     #print Dumper($data_new);
191     #exit;
192 joko 1.3 #merge_to($self, $data_new);
193 joko 1.2 $self->set_property( { name => $name, value => $data_new } );
194    
195 joko 1.1 } else {
196 joko 1.2
197     =pod
198     # make up a dummy hash matching the structure of the destination one
199     my $dummy = {};
200     ref_slot($dummy, $name, $data, '.');
201     print Dumper($dummy);
202    
203     # mix into destination
204     mixin($self, $dummy, { init => 1 });
205     =cut
206    
207     ref_slot($self, $name, $data, '.');
208    
209 joko 1.1 }
210 joko 1.2
211    
212     #print Dumper($self);
213     #exit;
214     #$self->
215    
216     }
217 joko 1.1
218 joko 1.2 sub set_property {
219     my $self = shift;
220     my $args = shift;
221    
222     $self->interpolate($args) ;
223     my $name = $args->{name};
224     my $value = $args->{value};
225     $name = '__rap.properties.' . $name;
226    
227     $self->log("set-name: $name");
228 joko 1.1
229     # fill property slot with given value
230     if ($value) {
231 joko 1.2 ref_slot($self, $name, $value, '.');
232 joko 1.1 }
233    
234 joko 1.2 #print Dumper($self);
235    
236 joko 1.1 # FIXME!!!
237 joko 1.2 #return if ! ref $args;
238 joko 1.1
239     # fill property slot with (probably bigger) data structure from property-/configuration-style - file
240     if (my $file = $args->{file}) {
241     my $type = $args->{type};
242     if (!$type) {
243     die("default file (no type specified) is not implemented yet!");
244    
245     } elsif ($type eq 'perl-eval') {
246     #die($type);
247     $self->loadFromPerlFile($file, $name, $args->{'varnames'});
248    
249     } elsif ($type eq 'App::Config') {
250     die("not implemented: $type");
251    
252     }
253    
254     } elsif (my $command = $args->{command}) {
255 joko 1.2 $self->perform_command($command, $args);
256 joko 1.1
257     }
258    
259     }
260    
261     sub get_property {
262     my $self = shift;
263     #my $args = shift;
264     my $name = shift;
265    
266     #$self->interpolate($args);
267    
268     #my $name = $args->{name};
269 joko 1.2 my $result;
270    
271     if (!$name) {
272     $self->log( __PACKAGE__ . ": no name!", 'critical');
273    
274     } elsif ($name eq '/') {
275     $result = expand($self);
276    
277     } elsif ($name eq '.') {
278     if (my $instance = $self->getInstance()) {
279     $result = expand($instance);
280     } else {
281     $result = ref_slot($self, '__rap.properties', undef, '.');
282    
283     }
284 joko 1.1
285 joko 1.2 } else {
286    
287     $name = '__rap.properties.' . $name;
288    
289     $self->log("get-name: $name");
290    
291     # get property slot and return value
292     $result = ref_slot($self, $name, undef, '.');
293    
294     # FIXME: Is this okay? It's provided for now in order not
295     # to deliver an 'undef' to the regex below inside 'interpolate'.
296     # revamp this, maybe!
297     #$result ||= ''; # NO!!!
298     }
299 joko 1.1
300 joko 1.2 return $result;
301 joko 1.1 }
302    
303     sub interpolate {
304     my $self = shift;
305     my $ref = shift;
306     IterHash %$ref, sub {
307     #print $_[1], "\n";
308     $_[1] =~ s/\${(.+)}/$self->get_property($1)/e;
309     }
310     }
311 joko 1.2
312     sub run_executable {
313     my $self = shift;
314     my $opts = shift;
315    
316 joko 1.8 my $meta = deep_copy($opts);
317    
318     delete $opts->{caption};
319     delete $opts->{async};
320    
321     #print Dumper($meta);
322    
323 joko 1.2 if ($opts->{executable}) {
324    
325     my $program = $opts->{executable};
326     delete $opts->{executable};
327    
328 joko 1.5 # determine execution method
329     my $wrapper_program = '';
330    
331     # check if program is a namespace-string (contains '::') - use 'do' in this case!
332     if ($program =~ /::/) {
333 joko 1.7 #$wrapper_program = 'rap.pl';
334     $wrapper_program = $0;
335 joko 1.5 }
336    
337     # prepare arguments
338 joko 1.2 my @buf;
339     foreach (keys %$opts) {
340     my $value = $opts->{$_};
341 joko 1.4 if (m/^_/) {
342     if ($_ eq '_switches') {
343     my @switches = split(/,\s|,/, $value);
344     foreach my $switch (@switches) {
345     push @buf, '--' . $switch;
346     }
347     }
348     next;
349     }
350    
351 joko 1.2 if ($value =~ /\s/) {
352     $value = "\"$value\"";
353     }
354     push @buf, "--$_=$value";
355     }
356 joko 1.5
357     # build {program} & {arguments}
358 joko 1.7 my $cmd = ($wrapper_program ? $wrapper_program . ' ' : '') . $program . ' ' . join(' ', @buf);
359 joko 1.2
360     # trace
361     #print "command: $cmd", "\n";
362    
363     # start process
364     # V1: via shortcut
365     #$ENV{PERL5LIB} = join(' ', @INC);
366    
367     # FIXME!!! what about the other slots of @INC?
368     $ENV{PERL5LIB} = $INC[0];
369    
370     #print Dumper(%ENV);
371 joko 1.5
372 joko 1.7 #print "command: '$cmd'", "\n";
373 joko 1.5
374     # V1 - basic
375     #run_cmd($cmd);
376    
377     # V1.b - enhanced: variable local method
378 joko 1.8 $meta->{caption} ||= '';
379     $meta->{async} ||= 0;
380     my $evalstr = "run_cmd('$cmd', '$meta->{caption}', { async => $meta->{async} });";
381 joko 1.5 eval($evalstr);
382     #my $res = do "$cmd";
383     #print $res, "\n" if $res;
384    
385     #$self->log("run_executable: $evalstr", 'info');
386     $self->raiseException("run_executable: $evalstr\n$@") if $@;
387    
388 joko 1.2 # V2: via IPC::Run
389     # .... (TODO)
390 joko 1.7
391 joko 1.2
392     }
393    
394     }
395    
396 joko 1.8
397     sub run_script {
398    
399     my $self = shift;
400     my $args = shift;
401     my $code = shift;
402    
403     if ($args->{language} eq 'msdos/bat') {
404    
405     #print "code: $code", "\n";
406    
407     # reporting
408     $self->log("Executing some arbitrary unsigned code (probably unsafe). [language=$args->{language}]", 'info');
409     $self->log("\n<code>\n$code\n</code>", 'info');
410    
411     # create temporary intermediate file to execute code
412     my $tmpdir = '/tmp/rap';
413     mkdir $tmpdir;
414     (my $fh, my $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.bat' );
415     print $fh $code, "\n";
416     run_cmd( $filename, '', { async => 1 } );
417    
418     # FIXME: DELETE code inside temp-files as soon as possible!
419     #print $fh '';
420    
421     # TODO: delete FILE completely!
422     # required for this: wait until execution has finished, then unlink....
423     # but: "how to wait until execution is finished"?
424     # i believe the best is to spawn *another* process directly from here,
425     # let's call it 'watcher-agent'.
426     # This one should monitor a certain running process and delete its
427     # executable file after it has finished execution.
428     # Possible extensions could be:
429     # keep track of all stuff sent to STDOUT or STDERR and
430     # send that stuff to the task-owner indirectly (not via shell/console)
431     # (e.g. via email, by posting report to a newsgroup or publishing on a specified web-page: use mod-dav!)
432    
433     } elsif ($args->{language} eq 'bash') {
434     $self->log("FIXME: - - - - - -- - - -- BASH - - - - - - - -- - ", 'error');
435    
436     } else {
437     $self->log("FIXME: Script language '$args->{language}' not implemented.", 'error');
438    
439     }
440    
441     }
442 joko 1.1
443     1;
444     __END__

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed