--- nfo/perl/libs/Data/Rap/Command.pm	2003/02/18 15:35:06	1.1
+++ nfo/perl/libs/Data/Rap/Command.pm	2003/05/13 07:52:14	1.7
@@ -1,7 +1,34 @@
 ## ----------------------------------------------------------------------
-##  $Id: Command.pm,v 1.1 2003/02/18 15:35:06 joko Exp $
+##  $Id: Command.pm,v 1.7 2003/05/13 07:52:14 joko Exp $
 ## ----------------------------------------------------------------------
 ##  $Log: Command.pm,v $
+##  Revision 1.7  2003/05/13 07:52:14  joko
+##  enhanced: *hierarchical* containers for context handling
+##  making methods from foreign context(s) available
+##  started: import of targets from foreign topics
+##
+##  Revision 1.6  2003/03/29 07:10:42  joko
+##  + sub _script:
+##    new rap-command: '<script language="msdos/bat|bash|...">...</script>'
+##
+##  Revision 1.5  2003/03/27 15:31:04  joko
+##  fixes to modules regarding new namespace(s) below Data::Mungle::*
+##
+##  Revision 1.4  2003/02/22 16:48:58  joko
+##  modified rapcall behaviour
+##
+##  Revision 1.3  2003/02/21 07:39:13  joko
+##  modified 'rapcall' processing
+##  modified merging of options/arguments in there
+##
+##  Revision 1.2  2003/02/20 19:37:09  joko
+##  renamed modules
+##  - removed command 'exec'
+##  + enhanced command 'rapcall' - now handles various different modes and behaviours
+##  renamed methods
+##  + command 'exit'
+##  + command 'use' - switch to foreign namespaces using contexts
+##
 ##  Revision 1.1  2003/02/18 15:35:06  joko
 ##  + initial commit
 ##
@@ -16,28 +43,11 @@
 
 use Data::Dumper;
 use Hash::Merge qw( merge );
-use shortcuts qw( run_cmd );
-use DesignPattern::Object;
 
+use DesignPattern::Object;
+use Data::Mungle::Transform::Deep qw( merge_to );
+use shortcuts qw( run_cmd );
 
-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);
-    }
-}
 
 sub _echo {
   my $self = shift;
@@ -65,12 +75,12 @@
 sub _context {
   my $self = shift;
   my $args = shift;
-  #print Dumper($args);
+  print "_context-args: ", Dumper($args);
   foreach my $task_command (keys %$args) {
     my $bunch = $args->{$task_command};
     foreach my $task_args (@$bunch) {
       #print Dumper($task_args);
-      $self->run_command($task_command, $task_args);
+      $self->perform_command($task_command, $task_args);
     }
   }
 }
@@ -81,41 +91,34 @@
 # FIXME
 sub _description {}
 
-sub _feed {
+# NEW [2003-05-08]: Hierarchical handling (stack push/pop instead of set/get).
+# TODO: Named Containers.
+sub _container {
   my $self = shift;
-  
+  my $args = shift;
+  $self->pushContainer($args);
 }
 
-sub _bootDatabases {
+sub _container_end {
   my $self = shift;
-#print Dumper($self->{config}->{databases});
-
-  $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');
+  my $args = shift;
+  $self->popContainer();
+}
 
-  my $dbcfg;
-  my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');
+sub _sync {
+  my $self = shift;
+  my $args = shift;
+  
+  #print Dumper($args);
+  
+  # V1
+  #$bizProcess->runSync($task);
+  
+  #V2
+  my $container = $self->getInstance();
+  $container ||= $self;
+  $container->runSync($args);
   
-  # 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}->{$_};
-  }
 }
 
 sub _depends_old {
@@ -129,27 +132,253 @@
   my $self = shift;
   my $args = shift;
   my $name = $args->{name}; 
-  my $message = Dumper($self->{$name});
-  $self->rc('echo', $message, $args->{level});
+  my $message = Dumper($self->get_property($name));
+  $self->rc('echo', "\n" . $message, $args->{level});
 }
 
+
 sub _plugin {
   my $self = shift;
   my $args = shift;
-  if (my $name = $args->{name}) {
-    $self->load($name);
+  my $content = shift;
+
+  if (my $instance = $args->{instance}) {
+    #$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
+    my $object = DesignPattern::Object->fromPackage($args->{module});
+    #$self->{$instance}
+    #print Dumper($object);
+    #$object->constructor() if $object->can('constructor');
+  
+  } elsif (my $name = $args->{name}) {
+    
+    # 1. namespaces - load module into current scope or foreign namespace?
+      my $container;
+      if (my $namespace = $args->{namespace}) {
+        
+        $self->log("Loading plugin '$name' into foreign namespace '$namespace'.", 'info');
+        
+        eval qq{
+
+          # 0. pre-flight check|trace
+            #print "YAI";
+            #$self->log('YAIYAI', 'info');    # FIXME!
+          
+          # 1. work in foreign namespace
+            package $namespace;
+            use strict;
+            use warnings;
+          # 2. mungle with/the
+            #   - package namespace (llp)
+            #   - object (lloo)
+            #   - inheritance (lloo)
+            #   - plugin (hlf)
+            # symbols for scopes:
+            #   - llp = low-level perl
+            #   - lloo = low-level oo
+            #   - hlf = high-level framework
+            # bless larry for perl having this implemented in an orthogonal way
+          # 2.1: behaviour=coerce
+            #use base qw( $name );
+          # 2.2: behaviour=plugin
+            use base qw( DesignPattern::Bridge );
+          1;
+        };
+        $self->checkExceptions();
+        $container = $namespace->new();
+
+      } elsif (my $instance = $self->getInstance()) {
+        $self->log("Loading plugin '$name' into foreign namespace of instance '" . (ref $instance) . "'.", 'info');
+        $container = $instance;
+
+      } else {
+        #$self->log("Loading plugin '$name' into local scope's namespace (ref \$self='" . (ref $self) . "').", 'info');
+        $self->log("Loading plugin '$name' into local namespace '" . (ref $self) . "'.", 'info');
+        $container = $self;
+      }
+
+    # 1.b. intermediate checks
+      if (!$container) {
+        $self->log("No container to load '$name' into!", 'warning');
+        return;
+      }
+      
+    # 1.c. inheritance of (e.g.) properties
+      if (my $inherit = $args->{inherit}) {
+        my $properties = $self->get_property($inherit);
+        merge_to($container, { $inherit => $properties }, { init => 1 } );
+      }
+
+    # 2. plugin - load module into container
+      $container->load($name);
+
+    # 3. methods - run object methods    
+
+      # payload inside $content is the $args to the $method
+      # convert xml-style payload inside $content to trivial (not-nested) perl hash
+      # using just encapsulated text of the nodes as hash values
+      my $method_args;
+      foreach (@$content) {
+        my $key = $_->{name};
+        my $value = $_->{content}->[0]->{content};
+        $method_args->{$key} = $value;
+      }
+      # convert hashref to arrayref
+      $method_args = [ %$method_args ] if ref $method_args eq 'HASH';
+
+      if (my $methods = $args->{methods}) {
+        my @methods = split(/,|,\s/, $methods);
+        foreach (@methods) {
+          $self->log("Running method '$_'.", 'info');
+          #print Dumper($method_args);
+          # check for existance of method
+          if ($container->can($_)) {
+            # dispatch call by being with or without arguments
+            print "method_args: ", Dumper($method_args);
+            if ($method_args) {
+              $container->$_(@$method_args);
+            } else {
+              $container->$_();
+            }
+          }
+        }
+      }
+      
+    # 4. instances - create references in local scope
+      if (my $instances = $args->{instances}) {
+        my @instances = split(/,|,\s/, $instances);
+        foreach (@instances) {
+          $self->log("Creating instance '$_'.", 'info');
+          $self->{$_} = $container;
+        }
+      }
+    
+    
   }
 }
 
 sub _rapcall {
   my $self = shift;
   my $args = shift;
+
+  # merge container arguments to local ones if desired/requested/forced
+  if (my $container = $self->getContainer()) {
+    #my $opts = merge($container, $args);
+    #print Dumper($container);
+    merge_to($args, $container, { init => 1 });
+  }
+  
+  # trace
+  #print Dumper($args);
+
+  # action dispatcher, either do:
+  #   - run an executable program [ext]
+  #   - call a command (?) [rap]
+  #   - a rap target [rap]
+  #   - a code method [ext]
+  
+  if ($args->{executable}) {
+    $self->run_executable($args);
+    return;
+  }
+
   if (my $command = $args->{command}) {
-    $self->run_command($command, $args);
+    $self->perform_command($command, $args);
+    return;
+  }
+
+  if (my $target = $args->{target}) {
+    $self->performTarget($target, $args);
+    return;
+  }
+
+  if (my $method = $args->{method}) {
+    #$self->performTarget($target, $args);
+    if (my $refkey = $args->{base}) {
+      #eval($namespace . '::' . $method . '();');
+      #die($@) if $@;
+      #print Dumper($self);
+      
+      #if ($args->{args} && lc $args->{args} eq 'array') {
+        #print Dumper($args);
+        #print Dumper($self);
+      #}
+      
+      # V1 - no arguments were being propagated
+      #$self->{$refkey}->$method();
+      # V2 - trying this....
+      $self->{$refkey}->$method();
+
+    } elsif (my $ref = $self->getInstance()) {
+      $ref->$method();
+    }
+    
+    return;
+
+  }
+  
+}
+
+sub _exit {
+  exit;
+}
+
+sub _use {
+  my $self = shift;
+  my $args = shift;
+  
+  # new of ~2003-04-15: making methods from foreign context(s) available
+  if (my $name = $args->{name}) {
+    $args->{type} ||= '';
+    $self->log("Switching to $args->{type} '$name'.", 'info');
+    $self->setInstance($self->{$name}) if $args->{type} eq 'instance';
+  }
+  
+  # new of ~2003-04-15: making methods from foreign context(s) available
+  if (exists $args->{method_prefix}) {
+    #print "YAI", "\n";
+    #print Dumper($args);
+    $self->set_property( { name => 'core.method_prefix', value => $args->{method_prefix} } );
   }
   
+  # TODO: (possible feature)
+  # check for $args->{export_rap_commands} to export core rap-commands
+  # from rap engine's scope to the worker's
+  
 }
 
+sub _script {
+  my $self = shift;
+  my $args = shift;
+  my $content = shift;
+  
+  # trace
+  #print Dumper($args);
+  #print Dumper($content);
+
+  my $code = $content->[0]->{content};
+  $code ||= '';
+
+  $self->run_script($args, $code);
+  
+}
+
+sub _import {
+  my $self = shift;
+  my $args = shift;
+  #my $content = shift;
+
+  if (!$args->{topic}) { 
+    $self->log("Please specify topic.", 'warning');
+    return; 
+  }
+
+  $self->log("Importing all targets from topic '$args->{topic}'.", 'info');
+  
+  #print Dumper($self);
+  # FIXME: This was started off, but not finished!
+  print "registry: ", Dumper($Data::Rap::registry);
+  
+}
 
 1;
 __END__