Data/Rap/Command.pm

## ----------------------------------------------------------------------
##  $Id: Command.pm,v 1.1 2003/02/18 15:35:06 joko Exp $
## ----------------------------------------------------------------------
##  $Log: Command.pm,v $
##  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);
    if ($opts->{executable}) {
      $self->run_executable($opts);
    }

    #print Dumper($opts);
    return;
  }

  if (my $command = $args->{command}) {
    $self->perform_command($command, $args);
  }

  if (my $target = $args->{target}) {
    $self->performTarget($target, $args);
  }

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

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