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

Diff of /nfo/perl/libs/Data/Rap/Command.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by joko, Fri Feb 21 07:39:13 2003 UTC revision 1.9 by joko, Sat Jun 19 01:50:24 2004 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.9  2004/06/19 01:50:24  joko
6    ##  disabled debugging statement
7    ##
8    ##  Revision 1.8  2004/06/07 16:45:56  joko
9    ##  now propagates args to "rapcall method"
10    ##
11    ##  Revision 1.7  2003/05/13 07:52:14  joko
12    ##  enhanced: *hierarchical* containers for context handling
13    ##  making methods from foreign context(s) available
14    ##  started: import of targets from foreign topics
15    ##
16    ##  Revision 1.6  2003/03/29 07:10:42  joko
17    ##  + sub _script:
18    ##    new rap-command: '<script language="msdos/bat|bash|...">...</script>'
19    ##
20    ##  Revision 1.5  2003/03/27 15:31:04  joko
21    ##  fixes to modules regarding new namespace(s) below Data::Mungle::*
22    ##
23    ##  Revision 1.4  2003/02/22 16:48:58  joko
24    ##  modified rapcall behaviour
25    ##
26  ##  Revision 1.3  2003/02/21 07:39:13  joko  ##  Revision 1.3  2003/02/21 07:39:13  joko
27  ##  modified 'rapcall' processing  ##  modified 'rapcall' processing
28  ##  modified merging of options/arguments in there  ##  modified merging of options/arguments in there
# Line 30  use Data::Dumper; Line 51  use Data::Dumper;
51  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
52    
53  use DesignPattern::Object;  use DesignPattern::Object;
54  use Data::Transform::Deep qw( merge_to );  use Data::Mungle::Transform::Deep qw( merge_to );
55  use shortcuts qw( run_cmd );  use shortcuts qw( run_cmd );
56    
57    
# Line 60  sub _echo { Line 81  sub _echo {
81  sub _context {  sub _context {
82    my $self = shift;    my $self = shift;
83    my $args = shift;    my $args = shift;
84    print Dumper($args);    print "_context-args: ", Dumper($args);
85    foreach my $task_command (keys %$args) {    foreach my $task_command (keys %$args) {
86      my $bunch = $args->{$task_command};      my $bunch = $args->{$task_command};
87      foreach my $task_args (@$bunch) {      foreach my $task_args (@$bunch) {
# Line 76  sub _id {} Line 97  sub _id {}
97  # FIXME  # FIXME
98  sub _description {}  sub _description {}
99    
100    # NEW [2003-05-08]: Hierarchical handling (stack push/pop instead of set/get).
101    # TODO: Named Containers.
102  sub _container {  sub _container {
103    my $self = shift;    my $self = shift;
104    my $args = shift;    my $args = shift;
105    $self->setContainer($args);    $self->pushContainer($args);
106    }
107    
108    sub _container_end {
109      my $self = shift;
110      my $args = shift;
111      $self->popContainer();
112  }  }
113    
114  sub _sync {  sub _sync {
# Line 117  sub _dump { Line 146  sub _dump {
146  sub _plugin {  sub _plugin {
147    my $self = shift;    my $self = shift;
148    my $args = shift;    my $args = shift;
149      my $content = shift;
150    
151    if (my $instance = $args->{instance}) {    if (my $instance = $args->{instance}) {
152      #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});      #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
# Line 188  sub _plugin { Line 218  sub _plugin {
218        $container->load($name);        $container->load($name);
219    
220      # 3. methods - run object methods          # 3. methods - run object methods    
221    
222          # payload inside $content is the $args to the $method
223          # convert xml-style payload inside $content to trivial (not-nested) perl hash
224          # using just encapsulated text of the nodes as hash values
225          my $method_args;
226          foreach (@$content) {
227            my $key = $_->{name};
228            my $value = $_->{content}->[0]->{content};
229            $method_args->{$key} = $value;
230          }
231          # convert hashref to arrayref
232          $method_args = [ %$method_args ] if ref $method_args eq 'HASH';
233    
234        if (my $methods = $args->{methods}) {        if (my $methods = $args->{methods}) {
235          my @methods = split(/,|,\s/, $methods);          my @methods = split(/,|,\s/, $methods);
236          foreach (@methods) {          foreach (@methods) {
237            $self->log("Running method '$_'.", 'info');            $self->log("Running method '$_'.", 'info');
238            $container->$_() if $container->can($_);            #print Dumper($method_args);
239              # check for existance of method
240              if ($container->can($_)) {
241                # dispatch call by being with or without arguments
242                #print "method_args: ", Dumper($method_args);
243                if ($method_args) {
244                  $container->$_(@$method_args);
245                } else {
246                  $container->$_();
247                }
248              }
249          }          }
250        }        }
251                
# Line 213  sub _rapcall { Line 266  sub _rapcall {
266    my $self = shift;    my $self = shift;
267    my $args = shift;    my $args = shift;
268    
269      # merge container arguments to local ones if desired/requested/forced
270    if (my $container = $self->getContainer()) {    if (my $container = $self->getContainer()) {
271      #my $opts = merge($container, $args);      #my $opts = merge($container, $args);
272      #print Dumper($opts);      #print Dumper($container);
273      merge_to($args, $container);      merge_to($args, $container, { init => 1 });
274    }    }
275        
276      # trace
277    #print Dumper($args);    #print Dumper($args);
278    
279      # action dispatcher, either do:
280      #   - run an executable program [ext]
281      #   - call a command (?) [rap]
282      #   - a rap target [rap]
283      #   - a code method [ext]
284      
285      if ($args->{executable}) {
286        $self->run_executable($args);
287        return;
288      }
289    
290    if (my $command = $args->{command}) {    if (my $command = $args->{command}) {
291      $self->perform_command($command, $args);      $self->perform_command($command, $args);
292      return;      return;
# Line 237  sub _rapcall { Line 303  sub _rapcall {
303        #eval($namespace . '::' . $method . '();');        #eval($namespace . '::' . $method . '();');
304        #die($@) if $@;        #die($@) if $@;
305        #print Dumper($self);        #print Dumper($self);
306        $self->{$refkey}->$method();        
307          #if ($args->{args} && lc $args->{args} eq 'array') {
308            #print Dumper($args);
309            #print Dumper($self);
310          #}
311          
312          # V1 - no arguments were being propagated
313          #$self->{$refkey}->$method();
314          # V2 - trying this....
315          $self->{$refkey}->$method($args->{args});
316    
317      } elsif (my $ref = $self->getInstance()) {      } elsif (my $ref = $self->getInstance()) {
318        $ref->$method();        $ref->$method($args->{args});
319      }      }
320            
321      return;      return;
322    
323    }    }
   
   if ($args->{executable}) {  
     $self->run_executable($args);  
     return;  
   }  
     
324        
325  }  }
326    
# Line 262  sub _exit { Line 331  sub _exit {
331  sub _use {  sub _use {
332    my $self = shift;    my $self = shift;
333    my $args = shift;    my $args = shift;
334    my $name = $args->{name};    
335    $self->log("Switching to '$name'.", 'info');    # new of ~2003-04-15: making methods from foreign context(s) available
336    $self->setInstance($self->{$name}) if $args->{type} eq 'instance';    if (my $name = $args->{name}) {
337        $args->{type} ||= '';
338        $self->log("Switching to $args->{type} '$name'.", 'info');
339        $self->setInstance($self->{$name}) if $args->{type} eq 'instance';
340      }
341      
342      # new of ~2003-04-15: making methods from foreign context(s) available
343      if (exists $args->{method_prefix}) {
344        #print "YAI", "\n";
345        #print Dumper($args);
346        $self->set_property( { name => 'core.method_prefix', value => $args->{method_prefix} } );
347      }
348      
349      # TODO: (possible feature)
350      # check for $args->{export_rap_commands} to export core rap-commands
351      # from rap engine's scope to the worker's
352      
353  }  }
354    
355    sub _script {
356      my $self = shift;
357      my $args = shift;
358      my $content = shift;
359      
360      # trace
361      #print Dumper($args);
362      #print Dumper($content);
363    
364      my $code = $content->[0]->{content};
365      $code ||= '';
366    
367      $self->run_script($args, $code);
368      
369    }
370    
371    sub _import {
372      my $self = shift;
373      my $args = shift;
374      #my $content = shift;
375    
376      if (!$args->{topic}) {
377        $self->log("Please specify topic.", 'warning');
378        return;
379      }
380    
381      $self->log("Importing all targets from topic '$args->{topic}'.", 'info');
382      
383      #print Dumper($self);
384      # FIXME: This was started off, but not finished!
385      print "registry: ", Dumper($Data::Rap::registry);
386      
387    }
388    
389  1;  1;
390  __END__  __END__
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed