/[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.3 by joko, Fri Feb 21 07:39:13 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.3  2003/02/21 07:39:13  joko
6    ##  modified 'rapcall' processing
7    ##  modified merging of options/arguments in there
8    ##
9    ##  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  ##  Revision 1.1  2003/02/18 15:35:06  joko  ##  Revision 1.1  2003/02/18 15:35:06  joko
18  ##  + initial commit  ##  + initial commit
19  ##  ##
# Line 16  use warnings; Line 28  use warnings;
28    
29  use Data::Dumper;  use Data::Dumper;
30  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
31  use shortcuts qw( run_cmd );  
32  use DesignPattern::Object;  use DesignPattern::Object;
33    use Data::Transform::Deep qw( merge_to );
34    use shortcuts qw( run_cmd );
35    
36    
 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);  
     }  
 }  
   
37  sub _echo {  sub _echo {
38    my $self = shift;    my $self = shift;
39    my $args = shift;    my $args = shift;
# Line 65  sub _echo { Line 60  sub _echo {
60  sub _context {  sub _context {
61    my $self = shift;    my $self = shift;
62    my $args = shift;    my $args = shift;
63    #print Dumper($args);    print Dumper($args);
64    foreach my $task_command (keys %$args) {    foreach my $task_command (keys %$args) {
65      my $bunch = $args->{$task_command};      my $bunch = $args->{$task_command};
66      foreach my $task_args (@$bunch) {      foreach my $task_args (@$bunch) {
67        #print Dumper($task_args);        #print Dumper($task_args);
68        $self->run_command($task_command, $task_args);        $self->perform_command($task_command, $task_args);
69      }      }
70    }    }
71  }  }
# Line 81  sub _id {} Line 76  sub _id {}
76  # FIXME  # FIXME
77  sub _description {}  sub _description {}
78    
79  sub _feed {  sub _container {
80    my $self = shift;    my $self = shift;
81        my $args = shift;
82      $self->setContainer($args);
83  }  }
84    
85  sub _bootDatabases {  sub _sync {
86    my $self = shift;    my $self = shift;
87  #print Dumper($self->{config}->{databases});    my $args = shift;
88      
89    $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');    #print Dumper($args);
90      
91    my $dbcfg;    # V1
92    my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');    #$bizProcess->runSync($task);
93      
94      #V2
95      my $container = $self->getInstance();
96      $container ||= $self;
97      $container->runSync($args);
98        
   # 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}->{$_};  
   }  
99  }  }
100    
101  sub _depends_old {  sub _depends_old {
# Line 129  sub _dump { Line 109  sub _dump {
109    my $self = shift;    my $self = shift;
110    my $args = shift;    my $args = shift;
111    my $name = $args->{name};    my $name = $args->{name};
112    my $message = Dumper($self->{$name});    my $message = Dumper($self->get_property($name));
113    $self->rc('echo', $message, $args->{level});    $self->rc('echo', "\n" . $message, $args->{level});
114  }  }
115    
116    
117  sub _plugin {  sub _plugin {
118    my $self = shift;    my $self = shift;
119    my $args = shift;    my $args = shift;
120    if (my $name = $args->{name}) {  
121      $self->load($name);    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    }    }
210  }  }
211    
212  sub _rapcall {  sub _rapcall {
213    my $self = shift;    my $self = shift;
214    my $args = shift;    my $args = shift;
215    
216      if (my $container = $self->getContainer()) {
217        #my $opts = merge($container, $args);
218        #print Dumper($opts);
219        merge_to($args, $container);
220      }
221      
222      #print Dumper($args);
223    
224    if (my $command = $args->{command}) {    if (my $command = $args->{command}) {
225      $self->run_command($command, $args);      $self->perform_command($command, $args);
226        return;
227    }    }
228    
229      if (my $target = $args->{target}) {
230        $self->performTarget($target, $args);
231        return;
232      }
233    
234      if (my $method = $args->{method}) {
235        #$self->performTarget($target, $args);
236        if (my $refkey = $args->{base}) {
237          #eval($namespace . '::' . $method . '();');
238          #die($@) if $@;
239          #print Dumper($self);
240          $self->{$refkey}->$method();
241    
242        } elsif (my $ref = $self->getInstance()) {
243          $ref->$method();
244        }
245        
246        return;
247    
248      }
249    
250      if ($args->{executable}) {
251        $self->run_executable($args);
252        return;
253      }
254      
255        
256  }  }
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    }
269    
270    
271  1;  1;
272  __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed