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

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

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

revision 1.1 by joko, Tue Feb 18 15:35:25 2003 UTC revision 1.2 by joko, Thu Feb 20 19:46:33 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ----------------------------------------------------------------------  ## ----------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.2  2003/02/20 19:46:33  joko
6    ##  renamed and revamped some of modules
7    ##  renamed methods
8    ##  + sub run_executable
9    ##
10  ##  Revision 1.1  2003/02/18 15:35:25  joko  ##  Revision 1.1  2003/02/18 15:35:25  joko
11  ##  + initial commit  ##  + initial commit
12  ##  ##
# Line 15  use warnings; Line 20  use warnings;
20    
21    
22  use Data::Dumper;  use Data::Dumper;
 use Data::Transform::Deep qw( refexpr2perlref );  
 use Iterate;  
23  use Hash::Merge qw( merge );  use Hash::Merge qw( merge );
24    use Iterate;
25    
26    use shortcuts qw( run_cmd );
27    use Data::Code::Ref qw( ref_slot );
28    use Data::Transform::Deep qw( expand );
29    
30    
31  sub performTarget {  sub performTarget {
32    my $self = shift;    my $self = shift;
33    my $targetname = shift;    my $targetname = shift;
34    my $target = $self->getTargetMetadata($targetname);    $self->perform_target($targetname);
35    }
36    
37    sub perform_target {
38      my $self = shift;
39      my $targetname = shift;
40    
41      $self->log("Performing Target '$targetname'.", 'notice');
42    
43      #exit;
44    
45      my $target = $self->getTargetDetails($targetname);
46    
47    # trace    # trace
48      #print Dumper($target);      #print Dumper($target);
49      #exit;      #exit;
50            
51      $self->perform_dependencies($target);
52      $self->perform_details($target);
53    
54    }
55    
56    sub perform_dependencies {
57      my $self = shift;
58      my $target = shift;
59    # resolve dependencies (just run prior)    # resolve dependencies (just run prior)
60    if (my $targetname_dep = $target->{attrib}->{depends}) {    if (my $targetname_dep = $target->{attrib}->{depends}) {
61      $self->performTarget($targetname_dep);      my @targets = split(/,\s|,/, $targetname_dep);
62        #print Dumper(@targets);
63        #$self->perform($targetname_dep);
64        #delete $target->{attrib}->{depends};
65        foreach (@targets) {
66          if (!$self->{__rap}->{dependencies}->{resolved}->{$_}++) {
67            $self->perform_target($_);
68          }
69        }
70      delete $target->{attrib}->{depends};      delete $target->{attrib}->{depends};
71    }    }
72    }
73    
74    sub perform_details {
75      my $self = shift;
76      my $target = shift;
77      
78      #print Dumper($target);
79      #exit;
80      
81    foreach my $entry (@{$target->{content}}) {    foreach my $entry (@{$target->{content}}) {
82      my $command = $entry->{name};      my $command = $entry->{name};
83      my $args = $entry->{attrib};      my $args = $entry->{attrib};
84      $self->run_command($command, $args);      $self->perform_command($command, $args);
85        # check recursiveness
86        if ($entry->{content} && ref $entry->{content}) {
87          $self->perform_details($entry);
88        }
89    }    }
90  }  }
91    
92  sub rc {  sub rc {
93    my $self = shift;    my $self = shift;
94    return $self->run_command(@_);    return $self->perform_command(@_);
95  }  }
96    
97  sub run_command {  sub perform_command {
98    my $self = shift;    my $self = shift;
99    my $command = shift;    my $command = shift;
100      
101    if (!$command) {    if (!$command) {
102      $self->log("Command was empty!", 'warning');      $self->log("Command was empty!", 'warning');
103      return;      return;
104    }    }
105    
106      # FIXME: make '__PACKAGE__' go one level deeper properly!
107      $self->log( __PACKAGE__ . "->perform_command: " . $command, 'debug');
108        
109    my $args_list = shift;    my $args_list = shift;
110    my $args = {};    my $args = {};
# Line 69  sub run_command { Line 119  sub run_command {
119      }      }
120    }    }
121    $command = '_' . $command;    $command = '_' . $command;
122    if ($self->can($command)) {    
123      $self->$command($args);    
124      # determine container
125      my $container; # = $self->getInstance();
126      $container ||= $self;
127      
128      if ($container->can($command)) {
129        $container->$command($args);
130    } else {    } else {
131      $self->log("Command \"$command\" not implemented.", "warning");      $self->log("Command '$command' not implemented.", "warning");
132    }    }
133      
134  }  }
135    
 sub set_property {  
   my $self = shift;  
   my $args = shift;  
136    
137    my $name;  sub merge_properties {
138    my $value;    my $self = shift;
139        my $name = shift;
140    if (ref $args) {    my $data = shift;
     $self->interpolate($args) ;  
     $name = $args->{name};  
     $value = $args->{value};  
141    
142    } else {    $self->log("merge-name: $name");
143      $name = $args;    #print "name: $name", "\n";
144      $value = shift;    #print Dumper($data);
145    }    #exit;
146    
147    # check if slot (or childs of it) is/are already occupied    # check if slot (or childs of it) is/are already occupied
148    if (my $oldvalue = refexpr2perlref($self, $name, undef, '.')) {    #if (my $data_old = ref_slot($self, $name, undef, '.')) {
149      if (my $data_old = $self->get_property($name)) {
150        #print "old:", "\n";
151        #print Dumper($data_old);
152        
153      # FIXME: review - any options for 'merge' here?      # FIXME: review - any options for 'merge' here?
154      $value = merge($oldvalue, $value);      my $data_new = merge($data_old, $data);
155        #print "DATA NEE! - MERGE!", "\n";
156        #print Dumper($data_new);
157        #exit;
158        #hash2object($self, $data_new);
159        $self->set_property( { name => $name, value => $data_new } );
160        
161      } else {
162    
163    =pod    
164        # make up a dummy hash matching the structure of the destination one
165          my $dummy = {};
166          ref_slot($dummy, $name, $data, '.');
167          print Dumper($dummy);
168        
169        # mix into destination
170          mixin($self, $dummy, { init => 1 });
171    =cut
172    
173          ref_slot($self, $name, $data, '.');
174    
175    }    }
176      
177      
178      #print Dumper($self);
179      #exit;
180      #$self->
181    
182    }
183    
184    sub set_property {
185      my $self = shift;
186      my $args = shift;
187    
188      $self->interpolate($args) ;
189      my $name = $args->{name};
190      my $value = $args->{value};
191      $name = '__rap.properties.' . $name;
192    
193      $self->log("set-name: $name");
194    
195    # fill property slot with given value    # fill property slot with given value
196    if ($value) {    if ($value) {
197      refexpr2perlref($self, $name, $value, '.');      ref_slot($self, $name, $value, '.');
198    }    }
199        
200      #print Dumper($self);
201      
202    # FIXME!!!    # FIXME!!!
203    return if ! ref $args;    #return if ! ref $args;
204    
205    # fill property slot with (probably bigger) data structure from property-/configuration-style - file    # fill property slot with (probably bigger) data structure from property-/configuration-style - file
206    if (my $file = $args->{file}) {    if (my $file = $args->{file}) {
# Line 123  sub set_property { Line 218  sub set_property {
218      }      }
219    
220    } elsif (my $command = $args->{command}) {    } elsif (my $command = $args->{command}) {
221      $self->run_command($command, $args);      $self->perform_command($command, $args);
222        
223    }    }
224    
# Line 137  sub get_property { Line 232  sub get_property {
232    #$self->interpolate($args);    #$self->interpolate($args);
233    
234    #my $name = $args->{name};    #my $name = $args->{name};
235      my $result;
236    
237      if (!$name) {
238        $self->log( __PACKAGE__ . ": no name!", 'critical');
239        
240      } elsif ($name eq '/') {
241        $result = expand($self);
242    
243    # get property slot and return value    } elsif ($name eq '.') {
244    return refexpr2perlref($self, $name, undef, '.');      if (my $instance = $self->getInstance()) {
245          $result = expand($instance);
246        } else {
247          $result = ref_slot($self, '__rap.properties', undef, '.');
248          
249        }
250    
251      } else {
252    
253        $name = '__rap.properties.' . $name;
254        
255        $self->log("get-name: $name");
256        
257        # get property slot and return value
258        $result = ref_slot($self, $name, undef, '.');
259        
260        # FIXME: Is this okay? It's provided for now in order not
261        # to deliver an 'undef' to the regex below inside 'interpolate'.
262        # revamp this, maybe!
263        #$result ||= '';    # NO!!!
264      }
265        
266      return $result;
267  }  }
268    
269  sub interpolate {  sub interpolate {
# Line 152  sub interpolate { Line 275  sub interpolate {
275    }    }
276  }  }
277    
278    sub run_executable {
279      my $self = shift;
280      my $opts = shift;
281    
282      if ($opts->{executable}) {
283    
284        my $program = $opts->{executable};
285        delete $opts->{executable};
286    
287        my @buf;
288        foreach (keys %$opts) {
289          my $value = $opts->{$_};
290          if ($value =~ /\s/) {
291            $value = "\"$value\"";
292          }
293          push @buf, "--$_=$value";
294        }
295      
296        my $cmd = $program . ' ' . join(' ', @buf);
297        
298        # trace
299          #print "command: $cmd", "\n";
300        
301        # start process
302          # V1: via shortcut
303          #$ENV{PERL5LIB} = join(' ', @INC);
304          
305          # FIXME!!! what about the other slots of @INC?
306          $ENV{PERL5LIB} = $INC[0];
307          
308          #print Dumper(%ENV);
309          run_cmd($cmd);
310          # V2: via IPC::Run
311          # ....  (TODO)
312        
313        
314      }
315      
316    }
317    
318    
319  1;  1;
320  __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