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