Data/Rap/Command.pm

## ----------------------------------------------------------------------
##  $Id: Command.pm,v 1.2 2003/02/20 19:37:09 joko Exp $
## ----------------------------------------------------------------------
##  $Log: Command.pm,v $
##  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($opts);
    merge_to($args, $container);
  }
  
  #print Dumper($args);

  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;

  }

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