Data/Rap/Command.pm

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