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