/[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.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
27    ##  modified 'rapcall' processing
28    ##  modified merging of options/arguments in there
29    ##
30    ##  Revision 1.2  2003/02/20 19:37:09  joko
31    ##  renamed modules
32    ##  - removed command 'exec'
33    ##  + enhanced command 'rapcall' - now handles various different modes and behaviours
34    ##  renamed methods
35    ##  + command 'exit'
36    ##  + command 'use' - switch to foreign namespaces using contexts
37    ##
38  ##  Revision 1.1  2003/02/18 15:35:06  joko  ##  Revision 1.1  2003/02/18 15:35:06  joko
39  ##  + initial commit  ##  + initial commit
40  ##  ##
# Line 16  use warnings; Line 49  use warnings;
49    
50  use Data::Dumper;  use Data::Dumper;
51  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
 use shortcuts qw( run_cmd );  
 use DesignPattern::Object;  
52    
53    use DesignPattern::Object;
54    use Data::Mungle::Transform::Deep qw( merge_to );
55    use shortcuts qw( run_cmd );
56    
 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);  
     }  
 }  
57    
58  sub _echo {  sub _echo {
59    my $self = shift;    my $self = shift;
# Line 65  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) {
88        #print Dumper($task_args);        #print Dumper($task_args);
89        $self->run_command($task_command, $task_args);        $self->perform_command($task_command, $task_args);
90      }      }
91    }    }
92  }  }
# Line 81  sub _id {} Line 97  sub _id {}
97  # FIXME  # FIXME
98  sub _description {}  sub _description {}
99    
100  sub _feed {  # NEW [2003-05-08]: Hierarchical handling (stack push/pop instead of set/get).
101    # TODO: Named Containers.
102    sub _container {
103    my $self = shift;    my $self = shift;
104        my $args = shift;
105      $self->pushContainer($args);
106  }  }
107    
108  sub _bootDatabases {  sub _container_end {
109    my $self = shift;    my $self = shift;
110  #print Dumper($self->{config}->{databases});    my $args = shift;
111      $self->popContainer();
112    $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');  }
113    
114    my $dbcfg;  sub _sync {
115    my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');    my $self = shift;
116      my $args = shift;
117      
118      #print Dumper($args);
119      
120      # V1
121      #$bizProcess->runSync($task);
122      
123      #V2
124      my $container = $self->getInstance();
125      $container ||= $self;
126      $container->runSync($args);
127        
   # 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}->{$_};  
   }  
128  }  }
129    
130  sub _depends_old {  sub _depends_old {
# Line 129  sub _dump { Line 138  sub _dump {
138    my $self = shift;    my $self = shift;
139    my $args = shift;    my $args = shift;
140    my $name = $args->{name};    my $name = $args->{name};
141    my $message = Dumper($self->{$name});    my $message = Dumper($self->get_property($name));
142    $self->rc('echo', $message, $args->{level});    $self->rc('echo', "\n" . $message, $args->{level});
143  }  }
144    
145    
146  sub _plugin {  sub _plugin {
147    my $self = shift;    my $self = shift;
148    my $args = shift;    my $args = shift;
149    if (my $name = $args->{name}) {    my $content = shift;
150      $self->load($name);  
151      if (my $instance = $args->{instance}) {
152        #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
153        my $object = DesignPattern::Object->fromPackage($args->{module});
154        #$self->{$instance}
155        #print Dumper($object);
156        #$object->constructor() if $object->can('constructor');
157      
158      } elsif (my $name = $args->{name}) {
159        
160        # 1. namespaces - load module into current scope or foreign namespace?
161          my $container;
162          if (my $namespace = $args->{namespace}) {
163            
164            $self->log("Loading plugin '$name' into foreign namespace '$namespace'.", 'info');
165            
166            eval qq{
167    
168              # 0. pre-flight check|trace
169                #print "YAI";
170                #$self->log('YAIYAI', 'info');    # FIXME!
171              
172              # 1. work in foreign namespace
173                package $namespace;
174                use strict;
175                use warnings;
176              # 2. mungle with/the
177                #   - package namespace (llp)
178                #   - object (lloo)
179                #   - inheritance (lloo)
180                #   - plugin (hlf)
181                # symbols for scopes:
182                #   - llp = low-level perl
183                #   - lloo = low-level oo
184                #   - hlf = high-level framework
185                # bless larry for perl having this implemented in an orthogonal way
186              # 2.1: behaviour=coerce
187                #use base qw( $name );
188              # 2.2: behaviour=plugin
189                use base qw( DesignPattern::Bridge );
190              1;
191            };
192            $self->checkExceptions();
193            $container = $namespace->new();
194    
195          } elsif (my $instance = $self->getInstance()) {
196            $self->log("Loading plugin '$name' into foreign namespace of instance '" . (ref $instance) . "'.", 'info');
197            $container = $instance;
198    
199          } else {
200            #$self->log("Loading plugin '$name' into local scope's namespace (ref \$self='" . (ref $self) . "').", 'info');
201            $self->log("Loading plugin '$name' into local namespace '" . (ref $self) . "'.", 'info');
202            $container = $self;
203          }
204    
205        # 1.b. intermediate checks
206          if (!$container) {
207            $self->log("No container to load '$name' into!", 'warning');
208            return;
209          }
210          
211        # 1.c. inheritance of (e.g.) properties
212          if (my $inherit = $args->{inherit}) {
213            my $properties = $self->get_property($inherit);
214            merge_to($container, { $inherit => $properties }, { init => 1 } );
215          }
216    
217        # 2. plugin - load module into container
218          $container->load($name);
219    
220        # 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}) {
235            my @methods = split(/,|,\s/, $methods);
236            foreach (@methods) {
237              $self->log("Running method '$_'.", 'info');
238              #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          
252        # 4. instances - create references in local scope
253          if (my $instances = $args->{instances}) {
254            my @instances = split(/,|,\s/, $instances);
255            foreach (@instances) {
256              $self->log("Creating instance '$_'.", 'info');
257              $self->{$_} = $container;
258            }
259          }
260        
261        
262    }    }
263  }  }
264    
265  sub _rapcall {  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()) {
271        #my $opts = merge($container, $args);
272        #print Dumper($container);
273        merge_to($args, $container, { init => 1 });
274      }
275      
276      # trace
277      #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->run_command($command, $args);      $self->perform_command($command, $args);
292        return;
293      }
294    
295      if (my $target = $args->{target}) {
296        $self->performTarget($target, $args);
297        return;
298      }
299    
300      if (my $method = $args->{method}) {
301        #$self->performTarget($target, $args);
302        if (my $refkey = $args->{base}) {
303          #eval($namespace . '::' . $method . '();');
304          #die($@) if $@;
305          #print Dumper($self);
306          
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()) {
318          $ref->$method($args->{args});
319        }
320        
321        return;
322    
323    }    }
324        
325  }  }
326    
327    sub _exit {
328      exit;
329    }
330    
331    sub _use {
332      my $self = shift;
333      my $args = shift;
334      
335      # new of ~2003-04-15: making methods from foreign context(s) available
336      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.1  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed