Data/Rap/Command.pm

## ----------------------------------------------------------------------
##  $Id: Command.pm,v 1.6 2003/03/29 07:10:42 joko Exp $
## ----------------------------------------------------------------------
##  $Log: Command.pm,v $
##  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
##
## ----------------------------------------------------------------------


package Data::Rap::Command;

use strict;
use warnings;


use Data::Dumper;
use Hash::Merge qw( merge );

use DesignPattern::Object;
use Data::Mungle::Transform::Deep qw( merge_to );
use shortcuts qw( run_cmd );


sub _echo {
  my $self = shift;
  my $args = shift;
  #print Dumper($args);
  my $message;
  my $level;
  
  if (ref $args eq 'HASH') {
    $message = $args->{message};
    $level = $args->{level};
  } else {
    my @buf = ();
    push @buf, $args;
    push @buf, @_;
    $message = join(' ', @buf);
  }

  $message ||= 'n/a';
  $level ||= 'info';
  
  $self->log($message, $level);
}

sub _context {
  my $self = shift;
  my $args = shift;
  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->perform_command($task_command, $task_args);
    }
  }
}

# FIXME
sub _id {}

# FIXME
sub _description {}

# 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 _container_end {
  my $self = shift;
  my $args = shift;
  $self->popContainer();
}

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);
  
}

sub _depends_old {
  my $self = shift;
  my $args = shift;
  #print Dumper($args);
  $self->performTarget($args);
}

sub _dump {
  my $self = shift;
  my $args = shift;
  my $name = $args->{name}; 
  my $message = Dumper($self->get_property($name));
  $self->rc('echo', "\n" . $message, $args->{level});
}


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