/[cvs]/nfo/perl/libs/Data/Rap/Command.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Rap/Command.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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