/[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.1 by joko, Tue Feb 18 15:35:06 2003 UTC revision 1.10 by joko, Sun Jun 20 16:10:05 2004 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.10  2004/06/20 16:10:05  joko
6    ##  modification to _rapcall: now has "service" to cache target details
7    ##
8    ##  Revision 1.9  2004/06/19 01:50:24  joko
9    ##  disabled debugging statement
10    ##
11    ##  Revision 1.8  2004/06/07 16:45:56  joko
12    ##  now propagates args to "rapcall method"
13    ##
14    ##  Revision 1.7  2003/05/13 07:52:14  joko
15    ##  enhanced: *hierarchical* containers for context handling
16    ##  making methods from foreign context(s) available
17    ##  started: import of targets from foreign topics
18    ##
19    ##  Revision 1.6  2003/03/29 07:10:42  joko
20    ##  + sub _script:
21    ##    new rap-command: '<script language="msdos/bat|bash|...">...</script>'
22    ##
23    ##  Revision 1.5  2003/03/27 15:31:04  joko
24    ##  fixes to modules regarding new namespace(s) below Data::Mungle::*
25    ##
26    ##  Revision 1.4  2003/02/22 16:48:58  joko
27    ##  modified rapcall behaviour
28    ##
29    ##  Revision 1.3  2003/02/21 07:39:13  joko
30    ##  modified 'rapcall' processing
31    ##  modified merging of options/arguments in there
32    ##
33    ##  Revision 1.2  2003/02/20 19:37:09  joko
34    ##  renamed modules
35    ##  - removed command 'exec'
36    ##  + enhanced command 'rapcall' - now handles various different modes and behaviours
37    ##  renamed methods
38    ##  + command 'exit'
39    ##  + command 'use' - switch to foreign namespaces using contexts
40    ##
41  ##  Revision 1.1  2003/02/18 15:35:06  joko  ##  Revision 1.1  2003/02/18 15:35:06  joko
42  ##  + initial commit  ##  + initial commit
43  ##  ##
# Line 16  use warnings; Line 52  use warnings;
52    
53  use Data::Dumper;  use Data::Dumper;
54  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
55  use shortcuts qw( run_cmd );  
56  use DesignPattern::Object;  use DesignPattern::Object;
57    use Data::Mungle::Transform::Deep qw( merge_to );
58    use shortcuts qw( run_cmd );
59    
60    
 sub _exec {  
   my $script = shift;  
   my $task = shift;  
     if ($script) {  
       my @buf;  
       foreach (keys %$task) {  
         my $value = $task->{$_};  
         if ($value =~ /\s/) {  
           $value = "\"$value\"";  
         }  
         push @buf, "--$_=$value";  
       }  
       my $cmd = $script . ' ' . join(' ', @buf);  
       run_cmd($cmd);  
     } else {  
       #$bizProcess->runSync($task);  
     }  
 }  
   
61  sub _echo {  sub _echo {
62    my $self = shift;    my $self = shift;
63    my $args = shift;    my $args = shift;
# Line 65  sub _echo { Line 84  sub _echo {
84  sub _context {  sub _context {
85    my $self = shift;    my $self = shift;
86    my $args = shift;    my $args = shift;
87    #print Dumper($args);    print "_context-args: ", Dumper($args);
88    foreach my $task_command (keys %$args) {    foreach my $task_command (keys %$args) {
89      my $bunch = $args->{$task_command};      my $bunch = $args->{$task_command};
90      foreach my $task_args (@$bunch) {      foreach my $task_args (@$bunch) {
91        #print Dumper($task_args);        #print Dumper($task_args);
92        $self->run_command($task_command, $task_args);        $self->perform_command($task_command, $task_args);
93      }      }
94    }    }
95  }  }
# Line 81  sub _id {} Line 100  sub _id {}
100  # FIXME  # FIXME
101  sub _description {}  sub _description {}
102    
103  sub _feed {  # NEW [2003-05-08]: Hierarchical handling (stack push/pop instead of set/get).
104    # TODO: Named Containers.
105    sub _container {
106    my $self = shift;    my $self = shift;
107        my $args = shift;
108      $self->pushContainer($args);
109  }  }
110    
111  sub _bootDatabases {  sub _container_end {
112    my $self = shift;    my $self = shift;
113  #print Dumper($self->{config}->{databases});    my $args = shift;
114      $self->popContainer();
115    $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');  }
116    
117    my $dbcfg;  sub _sync {
118    my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');    my $self = shift;
119      my $args = shift;
120      
121      #print Dumper($args);
122      
123      # V1
124      #$bizProcess->runSync($task);
125      
126      #V2
127      my $container = $self->getInstance();
128      $container ||= $self;
129      $container->runSync($args);
130        
   # just boot specified databases  
   if (my $dbkeys = $self->{use_databases}) {  
     foreach (@$dbkeys) {  
       $dbcfg->{$_} = $self->{config}->{databases}->{$_};  
     }  
       
   # boot all databases  
   } else {  
     $dbcfg = $self->{config}->{databases};  
   }  
   
   foreach (keys %$dbcfg) {  
     $container->addConfig($_, $dbcfg->{$_});  
   }  
   
   $container->initLocators();  
   $container->initStorages();  
   
   foreach (keys %{$container->{storage}}) {  
     $self->{storage}->{$_} = $container->{storage}->{$_};  
   }  
131  }  }
132    
133  sub _depends_old {  sub _depends_old {
# Line 129  sub _dump { Line 141  sub _dump {
141    my $self = shift;    my $self = shift;
142    my $args = shift;    my $args = shift;
143    my $name = $args->{name};    my $name = $args->{name};
144    my $message = Dumper($self->{$name});    my $message = Dumper($self->get_property($name));
145    $self->rc('echo', $message, $args->{level});    $self->rc('echo', "\n" . $message, $args->{level});
146  }  }
147    
148    
149  sub _plugin {  sub _plugin {
150    my $self = shift;    my $self = shift;
151    my $args = shift;    my $args = shift;
152    if (my $name = $args->{name}) {    my $content = shift;
153      $self->load($name);  
154      if (my $instance = $args->{instance}) {
155        #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
156        my $object = DesignPattern::Object->fromPackage($args->{module});
157        #$self->{$instance}
158        #print Dumper($object);
159        #$object->constructor() if $object->can('constructor');
160      
161      } elsif (my $name = $args->{name}) {
162        
163        # 1. namespaces - load module into current scope or foreign namespace?
164          my $container;
165          if (my $namespace = $args->{namespace}) {
166            
167            $self->log("Loading plugin '$name' into foreign namespace '$namespace'.", 'info');
168            
169            eval qq{
170    
171              # 0. pre-flight check|trace
172                #print "YAI";
173                #$self->log('YAIYAI', 'info');    # FIXME!
174              
175              # 1. work in foreign namespace
176                package $namespace;
177                use strict;
178                use warnings;
179              # 2. mungle with/the
180                #   - package namespace (llp)
181                #   - object (lloo)
182                #   - inheritance (lloo)
183                #   - plugin (hlf)
184                # symbols for scopes:
185                #   - llp = low-level perl
186                #   - lloo = low-level oo
187                #   - hlf = high-level framework
188                # bless larry for perl having this implemented in an orthogonal way
189              # 2.1: behaviour=coerce
190                #use base qw( $name );
191              # 2.2: behaviour=plugin
192                use base qw( DesignPattern::Bridge );
193              1;
194            };
195            $self->checkExceptions();
196            $container = $namespace->new();
197    
198          } elsif (my $instance = $self->getInstance()) {
199            $self->log("Loading plugin '$name' into foreign namespace of instance '" . (ref $instance) . "'.", 'info');
200            $container = $instance;
201    
202          } else {
203            #$self->log("Loading plugin '$name' into local scope's namespace (ref \$self='" . (ref $self) . "').", 'info');
204            $self->log("Loading plugin '$name' into local namespace '" . (ref $self) . "'.", 'info');
205            $container = $self;
206          }
207    
208        # 1.b. intermediate checks
209          if (!$container) {
210            $self->log("No container to load '$name' into!", 'warning');
211            return;
212          }
213          
214        # 1.c. inheritance of (e.g.) properties
215          if (my $inherit = $args->{inherit}) {
216            my $properties = $self->get_property($inherit);
217            merge_to($container, { $inherit => $properties }, { init => 1 } );
218          }
219    
220        # 2. plugin - load module into container
221          $container->load($name);
222    
223        # 3. methods - run object methods    
224    
225          # payload inside $content is the $args to the $method
226          # convert xml-style payload inside $content to trivial (not-nested) perl hash
227          # using just encapsulated text of the nodes as hash values
228          my $method_args;
229          foreach (@$content) {
230            my $key = $_->{name};
231            my $value = $_->{content}->[0]->{content};
232            $method_args->{$key} = $value;
233          }
234          # convert hashref to arrayref
235          $method_args = [ %$method_args ] if ref $method_args eq 'HASH';
236    
237          if (my $methods = $args->{methods}) {
238            my @methods = split(/,|,\s/, $methods);
239            foreach (@methods) {
240              $self->log("Running method '$_'.", 'info');
241              #print Dumper($method_args);
242              # check for existance of method
243              if ($container->can($_)) {
244                # dispatch call by being with or without arguments
245                #print "method_args: ", Dumper($method_args);
246                if ($method_args) {
247                  $container->$_(@$method_args);
248                } else {
249                  $container->$_();
250                }
251              }
252            }
253          }
254          
255        # 4. instances - create references in local scope
256          if (my $instances = $args->{instances}) {
257            my @instances = split(/,|,\s/, $instances);
258            foreach (@instances) {
259              $self->log("Creating instance '$_'.", 'info');
260              $self->{$_} = $container;
261            }
262          }
263        
264        
265    }    }
266  }  }
267    
268  sub _rapcall {  sub _rapcall {
269    my $self = shift;    my $self = shift;
270    my $args = shift;    my $args = shift;
271    
272      # merge container arguments to local ones if desired/requested/forced
273      if (my $container = $self->getContainer()) {
274        #my $opts = merge($container, $args);
275        #print Dumper($container);
276        merge_to($args, $container, { init => 1 });
277      }
278      
279      # trace
280      #print Dumper($args);
281    
282      # action dispatcher, either do:
283      #   - run an executable program [ext]
284      #   - call a command (?) [rap]
285      #   - a rap target [rap]
286      #   - a code method [ext]
287      
288      if ($args->{executable}) {
289        $self->run_executable($args);
290        return;
291      }
292    
293    if (my $command = $args->{command}) {    if (my $command = $args->{command}) {
294      $self->run_command($command, $args);      $self->perform_command($command, $args);
295        return;
296      }
297    
298      if (my $target = $args->{target}) {
299        $self->performTarget($target, $args);
300        return;
301      }
302    
303      if (my $method = $args->{method}) {
304        #$self->performTarget($target, $args);
305        if (my $refkey = $args->{base}) {
306          #eval($namespace . '::' . $method . '();');
307          #die($@) if $@;
308          #print Dumper($self);
309          
310          #if ($args->{args} && lc $args->{args} eq 'array') {
311            #print Dumper($args);
312            #print Dumper($self);
313          #}
314          
315          # V1 - no arguments were being propagated
316          #$self->{$refkey}->$method();
317          # V2 - trying this....
318          $self->{$refkey}->$method($args->{args});
319    
320        } elsif (my $ref = $self->getInstance()) {
321          $ref->$method($args->{args});
322        }
323        
324        return;
325    
326      }
327    
328      if (my $service = $args->{service}) {
329        if ($service eq 'indexTargets') {
330          $self->indexTargets({ build => 1 });
331        }
332      
333      }
334    
335    }
336    
337    sub _exit {
338      exit;
339    }
340    
341    sub _use {
342      my $self = shift;
343      my $args = shift;
344      
345      # new of ~2003-04-15: making methods from foreign context(s) available
346      if (my $name = $args->{name}) {
347        $args->{type} ||= '';
348        $self->log("Switching to $args->{type} '$name'.", 'info');
349        $self->setInstance($self->{$name}) if $args->{type} eq 'instance';
350    }    }
351        
352      # new of ~2003-04-15: making methods from foreign context(s) available
353      if (exists $args->{method_prefix}) {
354        #print "YAI", "\n";
355        #print Dumper($args);
356        $self->set_property( { name => 'core.method_prefix', value => $args->{method_prefix} } );
357      }
358      
359      # TODO: (possible feature)
360      # check for $args->{export_rap_commands} to export core rap-commands
361      # from rap engine's scope to the worker's
362      
363  }  }
364    
365    sub _script {
366      my $self = shift;
367      my $args = shift;
368      my $content = shift;
369      
370      # trace
371      #print Dumper($args);
372      #print Dumper($content);
373    
374      my $code = $content->[0]->{content};
375      $code ||= '';
376    
377      $self->run_script($args, $code);
378      
379    }
380    
381    sub _import {
382      my $self = shift;
383      my $args = shift;
384      #my $content = shift;
385    
386      if (!$args->{topic}) {
387        $self->log("Please specify topic.", 'warning');
388        return;
389      }
390    
391      $self->log("Importing all targets from topic '$args->{topic}'.", 'info');
392      
393      #print Dumper($self);
394      # FIXME: This was started off, but not finished!
395      print "registry: ", Dumper($Data::Rap::registry);
396      
397    }
398    
399  1;  1;
400  __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.10
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed