Data/Rap/Command.pm

## ----------------------------------------------------------------------
##  $Id: Command.pm,v 1.3 2003/02/21 07:39:13 joko Exp $
## ----------------------------------------------------------------------
##  $Log: Command.pm,v $
##  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::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 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 {}

sub _container {
  my $self = shift;
  my $args = shift;
  $self->setContainer($args);
}

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;

  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    
      if (my $methods = $args->{methods}) {
        my @methods = split(/,|,\s/, $methods);
        foreach (@methods) {
          $self->log("Running method '$_'.", 'info');
          $container->$_() if $container->can($_);
        }
      }
      
    # 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;

  if (my $container = $self->getContainer()) {
    #my $opts = merge($container, $args);
    #print Dumper($container);
    merge_to($args, $container, { init => 1 });
  }
  
  # trace
    #print Dumper($args);

  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);
      $self->{$refkey}->$method();

    } elsif (my $ref = $self->getInstance()) {
      $ref->$method();
    }
    
    return;

  }
  
}

sub _exit {
  exit;
}

sub _use {
  my $self = shift;
  my $args = shift;
  my $name = $args->{name};
  $self->log("Switching to '$name'.", 'info');
  $self->setInstance($self->{$name}) if $args->{type} eq 'instance';
}


1;
__END__
1	joko	1.1	## ----------------------------------------------------------------------
2	joko	1.4	## $Id: Command.pm,v 1.3 2003/02/21 07:39:13 joko Exp $
3	joko	1.1	## ----------------------------------------------------------------------
4	joko	1.2	## $Log: Command.pm,v $
5	joko	1.4	## Revision 1.3 2003/02/21 07:39:13 joko
6			## modified 'rapcall' processing
7			## modified merging of options/arguments in there
8			##
9	joko	1.3	## Revision 1.2 2003/02/20 19:37:09 joko
10			## renamed modules
11			## - removed command 'exec'
12			## + enhanced command 'rapcall' - now handles various different modes and behaviours
13			## renamed methods
14			## + command 'exit'
15			## + command 'use' - switch to foreign namespaces using contexts
16			##
17	joko	1.2	## Revision 1.1 2003/02/18 15:35:06 joko
18			## + initial commit
19			##
20	joko	1.1	## ----------------------------------------------------------------------
21
22
23			package Data::Rap::Command;
24
25			use strict;
26			use warnings;
27
28
29			use Data::Dumper;
30			use Hash::Merge qw( merge );
31	joko	1.2
32			use DesignPattern::Object;
33			use Data::Transform::Deep qw( merge_to );
34	joko	1.1	use shortcuts qw( run_cmd );
35
36
37			sub _echo {
38			my $self = shift;
39			my $args = shift;
40			#print Dumper($args);
41			my $message;
42			my $level;
43
44			if (ref $args eq 'HASH') {
45			$message = $args->{message};
46			$level = $args->{level};
47			} else {
48			my @buf = ();
49			push @buf, $args;
50			push @buf, @_;
51			$message = join(' ', @buf);
52			}
53
54			$message \|\|= 'n/a';
55			$level \|\|= 'info';
56
57			$self->log($message, $level);
58			}
59
60			sub _context {
61			my $self = shift;
62			my $args = shift;
63	joko	1.2	print Dumper($args);
64	joko	1.1	foreach my $task_command (keys %$args) {
65			my $bunch = $args->{$task_command};
66			foreach my $task_args (@$bunch) {
67			#print Dumper($task_args);
68	joko	1.2	$self->perform_command($task_command, $task_args);
69	joko	1.1	}
70			}
71			}
72
73			# FIXME
74			sub _id {}
75
76			# FIXME
77			sub _description {}
78
79	joko	1.2	sub _container {
80	joko	1.1	my $self = shift;
81	joko	1.2	my $args = shift;
82			$self->setContainer($args);
83	joko	1.1	}
84
85	joko	1.2	sub _sync {
86	joko	1.1	my $self = shift;
87	joko	1.2	my $args = shift;
88
89			#print Dumper($args);
90
91			# V1
92			#$bizProcess->runSync($task);
93
94			#V2
95			my $container = $self->getInstance();
96			$container \|\|= $self;
97			$container->runSync($args);
98	joko	1.1
99			}
100
101			sub _depends_old {
102			my $self = shift;
103			my $args = shift;
104			#print Dumper($args);
105			$self->performTarget($args);
106			}
107
108			sub _dump {
109			my $self = shift;
110			my $args = shift;
111			my $name = $args->{name};
112	joko	1.2	my $message = Dumper($self->get_property($name));
113			$self->rc('echo', "\n" . $message, $args->{level});
114	joko	1.1	}
115
116	joko	1.2
117	joko	1.1	sub _plugin {
118			my $self = shift;
119			my $args = shift;
120	joko	1.2
121			if (my $instance = $args->{instance}) {
122			#$self->{$instance} = DesignPattern::Object->fromPackage($args->{module});
123			my $object = DesignPattern::Object->fromPackage($args->{module});
124			#$self->{$instance}
125			#print Dumper($object);
126			#$object->constructor() if $object->can('constructor');
127
128			} elsif (my $name = $args->{name}) {
129
130			# 1. namespaces - load module into current scope or foreign namespace?
131			my $container;
132			if (my $namespace = $args->{namespace}) {
133
134			$self->log("Loading plugin '$name' into foreign namespace '$namespace'.", 'info');
135
136			eval qq{
137
138			# 0. pre-flight check\|trace
139			#print "YAI";
140			#$self->log('YAIYAI', 'info'); # FIXME!
141
142			# 1. work in foreign namespace
143			package $namespace;
144			use strict;
145			use warnings;
146			# 2. mungle with/the
147			# - package namespace (llp)
148			# - object (lloo)
149			# - inheritance (lloo)
150			# - plugin (hlf)
151			# symbols for scopes:
152			# - llp = low-level perl
153			# - lloo = low-level oo
154			# - hlf = high-level framework
155			# bless larry for perl having this implemented in an orthogonal way
156			# 2.1: behaviour=coerce
157			#use base qw( $name );
158			# 2.2: behaviour=plugin
159			use base qw( DesignPattern::Bridge );
160			1;
161			};
162			$self->checkExceptions();
163			$container = $namespace->new();
164
165			} elsif (my $instance = $self->getInstance()) {
166			$self->log("Loading plugin '$name' into foreign namespace of instance '" . (ref $instance) . "'.", 'info');
167			$container = $instance;
168
169			} else {
170			#$self->log("Loading plugin '$name' into local scope's namespace (ref \$self='" . (ref $self) . "').", 'info');
171			$self->log("Loading plugin '$name' into local namespace '" . (ref $self) . "'.", 'info');
172			$container = $self;
173			}
174
175			# 1.b. intermediate checks
176			if (!$container) {
177			$self->log("No container to load '$name' into!", 'warning');
178			return;
179			}
180
181			# 1.c. inheritance of (e.g.) properties
182			if (my $inherit = $args->{inherit}) {
183			my $properties = $self->get_property($inherit);
184			merge_to($container, { $inherit => $properties }, { init => 1 } );
185			}
186
187			# 2. plugin - load module into container
188			$container->load($name);
189
190			# 3. methods - run object methods
191			if (my $methods = $args->{methods}) {
192			my @methods = split(/,\|,\s/, $methods);
193			foreach (@methods) {
194			$self->log("Running method '$_'.", 'info');
195			$container->$_() if $container->can($_);
196			}
197			}
198
199			# 4. instances - create references in local scope
200			if (my $instances = $args->{instances}) {
201			my @instances = split(/,\|,\s/, $instances);
202			foreach (@instances) {
203			$self->log("Creating instance '$_'.", 'info');
204			$self->{$_} = $container;
205			}
206			}
207
208
209	joko	1.1	}
210			}
211
212			sub _rapcall {
213			my $self = shift;
214			my $args = shift;
215	joko	1.2
216			if (my $container = $self->getContainer()) {
217	joko	1.3	#my $opts = merge($container, $args);
218	joko	1.4	#print Dumper($container);
219			merge_to($args, $container, { init => 1 });
220	joko	1.2	}
221	joko	1.3
222	joko	1.4	# trace
223			#print Dumper($args);
224
225			if ($args->{executable}) {
226			$self->run_executable($args);
227			return;
228			}
229	joko	1.2
230	joko	1.1	if (my $command = $args->{command}) {
231	joko	1.2	$self->perform_command($command, $args);
232	joko	1.3	return;
233	joko	1.2	}
234
235			if (my $target = $args->{target}) {
236			$self->performTarget($target, $args);
237	joko	1.3	return;
238	joko	1.2	}
239
240			if (my $method = $args->{method}) {
241			#$self->performTarget($target, $args);
242			if (my $refkey = $args->{base}) {
243			#eval($namespace . '::' . $method . '();');
244			#die($@) if $@;
245			#print Dumper($self);
246			$self->{$refkey}->$method();
247
248			} elsif (my $ref = $self->getInstance()) {
249			$ref->$method();
250			}
251	joko	1.3
252			return;
253
254	joko	1.1	}
255
256	joko	1.2	}
257
258			sub _exit {
259			exit;
260			}
261
262			sub _use {
263			my $self = shift;
264			my $args = shift;
265			my $name = $args->{name};
266			$self->log("Switching to '$name'.", 'info');
267			$self->setInstance($self->{$name}) if $args->{type} eq 'instance';
268	joko	1.1	}
269
270
271			1;
272			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26