/[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.6 by joko, Sat Mar 29 07:10:42 2003 UTC revision 1.7 by joko, Tue May 13 07:52:14 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.7  2003/05/13 07:52:14  joko
6    ##  enhanced: *hierarchical* containers for context handling
7    ##  making methods from foreign context(s) available
8    ##  started: import of targets from foreign topics
9    ##
10  ##  Revision 1.6  2003/03/29 07:10:42  joko  ##  Revision 1.6  2003/03/29 07:10:42  joko
11  ##  + sub _script:  ##  + sub _script:
12  ##    new rap-command: '<script language="msdos/bat|bash|...">...</script>'  ##    new rap-command: '<script language="msdos/bat|bash|...">...</script>'
# Line 70  sub _echo { Line 75  sub _echo {
75  sub _context {  sub _context {
76    my $self = shift;    my $self = shift;
77    my $args = shift;    my $args = shift;
78    print Dumper($args);    print "_context-args: ", Dumper($args);
79    foreach my $task_command (keys %$args) {    foreach my $task_command (keys %$args) {
80      my $bunch = $args->{$task_command};      my $bunch = $args->{$task_command};
81      foreach my $task_args (@$bunch) {      foreach my $task_args (@$bunch) {
# Line 86  sub _id {} Line 91  sub _id {}
91  # FIXME  # FIXME
92  sub _description {}  sub _description {}
93    
94    # NEW [2003-05-08]: Hierarchical handling (stack push/pop instead of set/get).
95    # TODO: Named Containers.
96  sub _container {  sub _container {
97    my $self = shift;    my $self = shift;
98    my $args = shift;    my $args = shift;
99    $self->setContainer($args);    $self->pushContainer($args);
100    }
101    
102    sub _container_end {
103      my $self = shift;
104      my $args = shift;
105      $self->popContainer();
106  }  }
107    
108  sub _sync {  sub _sync {
# Line 127  sub _dump { Line 140  sub _dump {
140  sub _plugin {  sub _plugin {
141    my $self = shift;    my $self = shift;
142    my $args = shift;    my $args = shift;
143      my $content = shift;
144    
145    if (my $instance = $args->{instance}) {    if (my $instance = $args->{instance}) {
146      #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});      #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
# Line 198  sub _plugin { Line 212  sub _plugin {
212        $container->load($name);        $container->load($name);
213    
214      # 3. methods - run object methods          # 3. methods - run object methods    
215    
216          # payload inside $content is the $args to the $method
217          # convert xml-style payload inside $content to trivial (not-nested) perl hash
218          # using just encapsulated text of the nodes as hash values
219          my $method_args;
220          foreach (@$content) {
221            my $key = $_->{name};
222            my $value = $_->{content}->[0]->{content};
223            $method_args->{$key} = $value;
224          }
225          # convert hashref to arrayref
226          $method_args = [ %$method_args ] if ref $method_args eq 'HASH';
227    
228        if (my $methods = $args->{methods}) {        if (my $methods = $args->{methods}) {
229          my @methods = split(/,|,\s/, $methods);          my @methods = split(/,|,\s/, $methods);
230          foreach (@methods) {          foreach (@methods) {
231            $self->log("Running method '$_'.", 'info');            $self->log("Running method '$_'.", 'info');
232            $container->$_() if $container->can($_);            #print Dumper($method_args);
233              # check for existance of method
234              if ($container->can($_)) {
235                # dispatch call by being with or without arguments
236                print "method_args: ", Dumper($method_args);
237                if ($method_args) {
238                  $container->$_(@$method_args);
239                } else {
240                  $container->$_();
241                }
242              }
243          }          }
244        }        }
245                
# Line 223  sub _rapcall { Line 260  sub _rapcall {
260    my $self = shift;    my $self = shift;
261    my $args = shift;    my $args = shift;
262    
263      # merge container arguments to local ones if desired/requested/forced
264    if (my $container = $self->getContainer()) {    if (my $container = $self->getContainer()) {
265      #my $opts = merge($container, $args);      #my $opts = merge($container, $args);
266      #print Dumper($container);      #print Dumper($container);
# Line 230  sub _rapcall { Line 268  sub _rapcall {
268    }    }
269        
270    # trace    # trace
271      #print Dumper($args);    #print Dumper($args);
272    
273      # action dispatcher, either do:
274      #   - run an executable program [ext]
275      #   - call a command (?) [rap]
276      #   - a rap target [rap]
277      #   - a code method [ext]
278      
279    if ($args->{executable}) {    if ($args->{executable}) {
280      $self->run_executable($args);      $self->run_executable($args);
281      return;      return;
# Line 253  sub _rapcall { Line 297  sub _rapcall {
297        #eval($namespace . '::' . $method . '();');        #eval($namespace . '::' . $method . '();');
298        #die($@) if $@;        #die($@) if $@;
299        #print Dumper($self);        #print Dumper($self);
300          
301          #if ($args->{args} && lc $args->{args} eq 'array') {
302            #print Dumper($args);
303            #print Dumper($self);
304          #}
305          
306          # V1 - no arguments were being propagated
307          #$self->{$refkey}->$method();
308          # V2 - trying this....
309        $self->{$refkey}->$method();        $self->{$refkey}->$method();
310    
311      } elsif (my $ref = $self->getInstance()) {      } elsif (my $ref = $self->getInstance()) {
# Line 272  sub _exit { Line 325  sub _exit {
325  sub _use {  sub _use {
326    my $self = shift;    my $self = shift;
327    my $args = shift;    my $args = shift;
328    my $name = $args->{name};    
329    $self->log("Switching to '$name'.", 'info');    # new of ~2003-04-15: making methods from foreign context(s) available
330    $self->setInstance($self->{$name}) if $args->{type} eq 'instance';    if (my $name = $args->{name}) {
331        $args->{type} ||= '';
332        $self->log("Switching to $args->{type} '$name'.", 'info');
333        $self->setInstance($self->{$name}) if $args->{type} eq 'instance';
334      }
335      
336      # new of ~2003-04-15: making methods from foreign context(s) available
337      if (exists $args->{method_prefix}) {
338        #print "YAI", "\n";
339        #print Dumper($args);
340        $self->set_property( { name => 'core.method_prefix', value => $args->{method_prefix} } );
341      }
342      
343      # TODO: (possible feature)
344      # check for $args->{export_rap_commands} to export core rap-commands
345      # from rap engine's scope to the worker's
346      
347  }  }
348    
349  sub _script {  sub _script {
# Line 293  sub _script { Line 362  sub _script {
362        
363  }  }
364    
365    sub _import {
366      my $self = shift;
367      my $args = shift;
368      #my $content = shift;
369    
370      if (!$args->{topic}) {
371        $self->log("Please specify topic.", 'warning');
372        return;
373      }
374    
375      $self->log("Importing all targets from topic '$args->{topic}'.", 'info');
376      
377      #print Dumper($self);
378      # FIXME: This was started off, but not finished!
379      print "registry: ", Dumper($Data::Rap::registry);
380      
381    }
382    
383  1;  1;
384  __END__  __END__
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed