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

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

Parent Directory | Revision Log | View Patch Patch

-revision 1.1 by joko,
Tue Feb 18 15:35:06 2003 UTC
+revision 1.8 by joko,
Mon Jun  7 16:45:56 2004 UTC
 Line 2
  ##  $Id$
  ## ----------------------------------------------------------------------
  ##  $Log$
+ ##  Revision 1.8  2004/06/07 16:45:56  joko
+ ##  now propagates args to "rapcall method"
+ ##
+ ##  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
  ##
-Line 16 
 use warnings;
+Line 46 
 use warnings;
  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;
-Line 65 
 sub _echo {
+Line 78 
 sub _echo {
  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);
      }
    }
  }
-Line 81 
 sub _id {}
+Line 94 
 sub _id {}
  # 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});
+   my $args = shift;
+   $self->popContainer();
-   $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');
+ }
-   my $dbcfg;
+ sub _sync {
-   my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');
+   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 {
-Line 129 
 sub _dump {
+Line 135 
 sub _dump {
    my $self = shift;
    my $args = shift;
    my $name = $args->{name};
-   my $message = Dumper($self->{$name});
+   my $message = Dumper($self->get_property($name));
-   $self->rc('echo', $message, $args->{level});
+   $self->rc('echo', "\n" . $message, $args->{level});
  }
  sub _plugin {
    my $self = shift;
    my $args = shift;
-   if (my $name = $args->{name}) {
+   my $content = shift;
-     $self->load($name);
+   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 );
+;
+         };
+         $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($args->{args});
+     } elsif (my $ref = $self->getInstance()) {
+       $ref->$method($args->{args});
+     }
+     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);
+ }
 ;
  __END__

 Legend:



Removed from v.1.1
 


changed lines


 
Added in v.1.8
 Legend:



Removed from v.1.1
 


changed lines


 
Added in v.1.8
-Removed from v.1.1
+Added in v.1.8

MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26