/[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.4 by joko, Sat Feb 22 16:48:58 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.4  2003/02/22 16:48:58  joko
6    ##  modified rapcall behaviour
7    ##
8    ##  Revision 1.3  2003/02/21 07:39:13  joko
9    ##  modified 'rapcall' processing
10    ##  modified merging of options/arguments in there
11    ##
12    ##  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  ##  Revision 1.1  2003/02/18 15:35:06  joko  ##  Revision 1.1  2003/02/18 15:35:06  joko
21  ##  + initial commit  ##  + initial commit
22  ##  ##
# Line 16  use warnings; Line 31  use warnings;
31    
32  use Data::Dumper;  use Data::Dumper;
33  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
34  use shortcuts qw( run_cmd );  
35  use DesignPattern::Object;  use DesignPattern::Object;
36    use Data::Transform::Deep qw( merge_to );
37    use shortcuts qw( run_cmd );
38    
39    
 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);  
     }  
 }  
   
40  sub _echo {  sub _echo {
41    my $self = shift;    my $self = shift;
42    my $args = shift;    my $args = shift;
# Line 65  sub _echo { Line 63  sub _echo {
63  sub _context {  sub _context {
64    my $self = shift;    my $self = shift;
65    my $args = shift;    my $args = shift;
66    #print Dumper($args);    print Dumper($args);
67    foreach my $task_command (keys %$args) {    foreach my $task_command (keys %$args) {
68      my $bunch = $args->{$task_command};      my $bunch = $args->{$task_command};
69      foreach my $task_args (@$bunch) {      foreach my $task_args (@$bunch) {
70        #print Dumper($task_args);        #print Dumper($task_args);
71        $self->run_command($task_command, $task_args);        $self->perform_command($task_command, $task_args);
72      }      }
73    }    }
74  }  }
# Line 81  sub _id {} Line 79  sub _id {}
79  # FIXME  # FIXME
80  sub _description {}  sub _description {}
81    
82  sub _feed {  sub _container {
83    my $self = shift;    my $self = shift;
84        my $args = shift;
85      $self->setContainer($args);
86  }  }
87    
88  sub _bootDatabases {  sub _sync {
89    my $self = shift;    my $self = shift;
90  #print Dumper($self->{config}->{databases});    my $args = shift;
91      
92    $self->log("Using Database(s): " . join(', ', @{$self->{use_databases}}), 'info');    #print Dumper($args);
93      
94    my $dbcfg;    # V1
95    my $container = DesignPattern::Object->fromPackage('Data::Storage::Container');    #$bizProcess->runSync($task);
96      
97      #V2
98      my $container = $self->getInstance();
99      $container ||= $self;
100      $container->runSync($args);
101        
   # 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}->{$_};  
   }  
102  }  }
103    
104  sub _depends_old {  sub _depends_old {
# Line 129  sub _dump { Line 112  sub _dump {
112    my $self = shift;    my $self = shift;
113    my $args = shift;    my $args = shift;
114    my $name = $args->{name};    my $name = $args->{name};
115    my $message = Dumper($self->{$name});    my $message = Dumper($self->get_property($name));
116    $self->rc('echo', $message, $args->{level});    $self->rc('echo', "\n" . $message, $args->{level});
117  }  }
118    
119    
120  sub _plugin {  sub _plugin {
121    my $self = shift;    my $self = shift;
122    my $args = shift;    my $args = shift;
123    if (my $name = $args->{name}) {  
124      $self->load($name);    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    }    }
213  }  }
214    
215  sub _rapcall {  sub _rapcall {
216    my $self = shift;    my $self = shift;
217    my $args = shift;    my $args = shift;
218    
219      if (my $container = $self->getContainer()) {
220        #my $opts = merge($container, $args);
221        #print Dumper($container);
222        merge_to($args, $container, { init => 1 });
223      }
224      
225      # trace
226        #print Dumper($args);
227    
228      if ($args->{executable}) {
229        $self->run_executable($args);
230        return;
231      }
232    
233    if (my $command = $args->{command}) {    if (my $command = $args->{command}) {
234      $self->run_command($command, $args);      $self->perform_command($command, $args);
235        return;
236      }
237    
238      if (my $target = $args->{target}) {
239        $self->performTarget($target, $args);
240        return;
241      }
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        
255        return;
256    
257    }    }
258        
259  }  }
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    }
272    
273    
274  1;  1;
275  __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed