File Coverage

blib/lib/Enbld/Target.pm
Criterion Covered Total %
statement 260 301 86.3
branch 64 96 66.6
condition 4 6 66.6
subroutine 47 49 95.9
pod 0 11 0.0
total 375 463 80.9


line stmt bran cond sub pod time code
1             package Enbld::Target;
2              
3 2     2   1099 use strict;
  2         3  
  2         77  
4 2     2   10 use warnings;
  2         3  
  2         152  
5              
6 2     2   9 use Carp;
  2         4  
  2         151  
7              
8 2     2   2044 use version;
  2         5068  
  2         12  
9              
10 2     2   156 use File::Spec;
  2         4  
  2         64  
11 2     2   11 use File::Path qw/make_path remove_tree/;
  2         4  
  2         245  
12 2     2   24 use File::Find;
  2         5  
  2         130  
13 2     2   4383 use File::Copy::Recursive qw/rcopy/;
  2         12179  
  2         183  
14 2     2   15830 use autodie;
  2         37365  
  2         16  
15 2     2   11442 use List::Util qw/first/;
  2         5  
  2         10598  
16              
17             require Enbld::Definition;
18             require Enbld::Feature;
19             require Enbld::Condition;
20             require Enbld::Message;
21             require Enbld::Home;
22             require Enbld::HTTP;
23             require Enbld::Target::Symlink;
24             require Enbld::Error;
25             require Enbld::Deployed;
26              
27             sub new {
28 47     47 0 3172 my ( $class, $name, $config ) = @_;
29              
30 47         656 my $self = {
31             name => $name,
32             config => $config,
33             attributes => undef,
34             build => undef,
35             install => undef,
36             PATH => undef,
37             conditions => undef,
38             };
39              
40 47         159 bless $self, $class;
41              
42 47         373 $self->_set_config;
43 47         175 $self->_set_attributes;
44 46         676 $self->_set_PATH;
45              
46 46         511 return $self;
47             }
48              
49             sub install {
50 14     14 0 47 my $self = shift;
51 14         30 my $version = shift;
52            
53 14 100       87 if ( ! $self->_is_install_ok ) {
54 1         31 Enbld::Error->throw( "'$self->{name}' is already installed." );
55             }
56              
57 13 50       150 my $condition = $version ? Enbld::Condition->new( version => $version ) :
58             Enbld::Condition->new;
59              
60 13         85 $self->{attributes}->add( 'VersionCondition', $condition->version );
61              
62 13         58 $self->_build( $condition );
63              
64 12         271 return $self->{config};
65             }
66              
67             sub _is_install_ok {
68 14     14   57 my $self = shift;
69              
70 14 100       85 return 1 if Enbld::Feature->is_force_install;
71 13 100       84 return if $self->is_installed;
72 12         54 return 1;
73             }
74              
75             sub deploy {
76 1     1 0 7 my $self = shift;
77              
78 1         12 my $condition = Enbld::Condition->new;
79              
80 1         10 $self->{attributes}->add( 'VersionCondition', $condition->version );
81              
82 1         141 $self->_build_to_deploy( $condition );
83              
84 1         17 return $self->{config};
85             }
86              
87             sub install_declared {
88 14     14 0 74 my ( $self, $declared_conditions ) = @_;
89              
90 14         96 $self->{attributes}->add(
91             'VersionCondition',
92             $declared_conditions->{$self->{name}}{version}
93             );
94              
95 14 100       93 return unless $self->_is_install_declared_ok(
96             $declared_conditions->{$self->{name}}
97             );
98              
99 13         46 $self->{conditions} = $declared_conditions;
100              
101 13         111 $self->_build( $declared_conditions->{$self->{name}} );
102              
103 13         191 return $self->{config};
104             }
105              
106             sub deploy_declared {
107 1     1 0 7 my ( $self, $declared_conditions ) = @_;
108              
109 1         14 $self->{attributes}->add(
110             'VersionCondition',
111             $declared_conditions->{$self->{name}}{version}
112             );
113              
114 1         5 $self->{conditions} = $declared_conditions;
115              
116 1         11 $self->_build_to_deploy( $declared_conditions->{$self->{name}} );
117              
118 1         20 return $self->{config};
119             }
120              
121             sub _is_install_declared_ok {
122 14     14   37 my ( $self, $condition ) = @_;
123              
124 14 100       68 return 1 if Enbld::Feature->is_force_install;
125 13 100       103 return 1 unless $self->{config}->enabled;
126 3 100       37 return 1 unless $condition->is_equal_to( $self->{config}->condition );
127 1 50       9 return if $self->{config}->enabled eq $self->{attributes}->Version;
128              
129 0         0 return 1;
130             }
131              
132             sub upgrade {
133 3     3 0 13 my $self = shift;
134              
135 3 100       32 if ( ! $self->is_installed ) {
136 1         21 Enbld::Error->throw( "'$self->{name}' is not installed yet." );
137             }
138              
139 2         42 $self->{attributes}->add(
140             'VersionCondition',
141             $self->{config}->condition->version
142             );
143              
144 2         41 my $current = $self->{attributes}->Version;
145 2         17 my $enabled = $self->{config}->enabled;
146              
147 2         17 my $VersionList = $self->{attributes}->SortedVersionList;
148              
149             my $index_current =
150 2     4   36 first { ${ $VersionList }[$_] eq $current } 0..$#{ $VersionList };
  4         14  
  4         15  
  2         30  
151              
152             my $index_enabled =
153 2     3   19 first { ${ $VersionList }[$_] eq $enabled } 0..$#{ $VersionList };
  3         7  
  3         14  
  2         8  
154              
155 2 100       23 if ( $index_current <= $index_enabled ) {
156 1         20 Enbld::Error->throw( "'$self->{name}' is up to date." );
157             }
158              
159 1         22 $self->_build( $self->{config}->condition );
160              
161 1         54 return $self->{config};
162             }
163              
164             sub off {
165 2     2 0 8 my $self = shift;
166              
167 2 100       26 if ( ! $self->is_installed ) {
168 1         19 Enbld::Error->throw( "'$self->{name}' is not installed yet." );
169             }
170              
171 1         14 $self->_drop;
172              
173 1         14 $self->{config}->drop_enabled;
174              
175 1         9 return $self->{config};
176             }
177              
178             sub rehash {
179 0     0 0 0 my $self = shift;
180              
181 0 0       0 if ( ! $self->is_installed ) {
182 0         0 Enbld::Error->throw( "'$self->{name}' isn't installed yet." );
183             }
184              
185 0         0 $self->_switch( $self->{config}->enabled );
186              
187 0         0 return $self->{config};
188             }
189              
190             sub use {
191 4     4 0 28 my ( $self, $version ) = @_;
192              
193 4 50       43 if ( ! $self->{config}->installed ) {
194 0         0 Enbld::Error->throw( "'$self->{name}' isn't installed yet." );
195             }
196              
197 4         39 my $form = $self->{attributes}->VersionForm;
198 4 100       75 if ( $version !~ /^$form$/ ) {
199 1         20 Enbld::Error->throw( "'$version' is not valid version form." );
200             }
201              
202 3 100 66     25 if ( $self->{config}->enabled && $self->{config}->enabled eq $version ) {
203 1         9 Enbld::Error->throw( "'$version' is current enabled version." );
204             }
205              
206 2 100       14 if ( ! $self->{config}->is_installed_version( $version ) ) {
207 1         11 Enbld::Error->throw( "'$version' isn't installed yet" );
208             }
209              
210 1         103 $self->_switch( $version );
211              
212 1         14 return $self->{config};
213             }
214              
215             sub is_installed {
216 22     22 0 60 my $self = shift;
217              
218 22         150 return $self->{config}->enabled;
219             }
220              
221             sub is_outdated {
222 3     3 0 24 my $self = shift;
223              
224 3 100       32 return unless ( $self->{config}->enabled );
225              
226 2         38 $self->{attributes}->add(
227             'VersionCondition', $self->{config}->condition->version
228             );
229              
230 2         42 my $current = $self->{attributes}->Version;
231 2         17 my $enabled = $self->{config}->enabled;
232              
233 2         21 my $VersionList = $self->{attributes}->SortedVersionList;
234              
235             my $index_current =
236 2     4   27 first { ${ $VersionList }[$_] eq $current } 0..$#{ $VersionList };
  4         8  
  4         17  
  2         25  
237              
238             my $index_enabled =
239 2     3   14 first { ${ $VersionList }[$_] eq $enabled } 0..$#{ $VersionList };
  3         10  
  3         8  
  2         15  
240              
241 2 100       19 if ( $index_current > $index_enabled ) {
242 1         22 return $current;
243             }
244              
245 1         33 return;
246             }
247              
248             sub _set_config {
249 47     47   86 my $self = shift;
250              
251 47 100       260 if ( ! $self->{config} ) {
252 27         924 require Enbld::Config;
253 27         1032 $self->{config} = Enbld::Config->new( name => $self->{name} );
254             }
255             }
256              
257             sub _set_attributes {
258 47     47   99 my $self = shift;
259              
260 47         794 $self->{attributes} = Enbld::Definition->new( $self->{name} )->parse;
261             }
262              
263             sub _set_PATH {
264 46     46   181 my $self = shift;
265              
266 46         528 my $path = File::Spec->catdir( Enbld::Home->install_path, 'bin' );
267              
268 46         338 $self->{PATH} = $path . ':' . $ENV{PATH};
269             }
270              
271             sub _switch {
272 1     1   8 my ( $self, $version ) = @_;
273              
274 1         13 my $path = File::Spec->catdir(
275             Enbld::Home->depository,
276             $self->{attributes}->DistName
277             );
278              
279 1         14 my $new = File::Spec->catdir( $path, $version );
280              
281 1         16 Enbld::Target::Symlink->delete_symlink( $path );
282 1         21 Enbld::Target::Symlink->create_symlink( $new );
283              
284 1         31 $self->{config}->set_enabled(
285             $version,
286             $self->{config}->condition( $version ),
287             );
288             }
289              
290             sub _drop {
291 1     1   4 my $self = shift;
292              
293 1         13 my $path = File::Spec->catdir(
294             Enbld::Home->depository,
295             $self->{attributes}->DistName,
296             );
297              
298 1         20 Enbld::Target::Symlink->delete_symlink( $path );
299              
300 1         11 $self->{config}->drop_enabled;
301             }
302              
303             sub _build {
304 27     27   80 my ( $self, $condition ) = @_;
305              
306 27         356 Enbld::Message->notify( "=====> Start building target '$self->{name}'." );
307              
308 27         240 local $ENV{PATH} = $self->{PATH};
309              
310 27         235 $self->_solve_dependencies;
311              
312 27         199 $self->_setup_install_directory;
313 27         161 $self->_exec_build_command( $condition );
314              
315 26 50       1472 if ( $condition->module_file ) {
316 0         0 $self->_install_module( $condition );
317             }
318              
319 26         256 $self->_postbuild;
320              
321 26         173 my $finish_msg = "=====> Finish building target '$self->{name}'.";
322 26         469 Enbld::Message->notify( $finish_msg );
323              
324 26         293 $self->{config}->set_enabled( $self->{attributes}->Version, $condition );
325             }
326              
327             sub _build_to_deploy {
328 2     2   9 my ( $self, $condition ) = @_;
329              
330 2         24 Enbld::Message->notify( "=====> Start building target '$self->{name}'." );
331              
332 2         20 local $ENV{PATH} = $self->{PATH};
333              
334 2         19 $self->_solve_dependencies_to_deploy;
335              
336 2         17 $self->{install} = Enbld::Home->deploy_path;
337              
338 2         11 $self->_exec_build_command( $condition );
339              
340 2 50       205 if ( $condition->module_file ) {
341 0         0 $self->_install_module( $condition );
342             }
343              
344 2         56 my $finish_msg = "=====> Finish building target '$self->{name}'.";
345 2         283 Enbld::Message->notify( $finish_msg );
346              
347 2         80 $self->{config}->set_enabled( $self->{attributes}->Version, $condition );
348             }
349              
350             sub _exec_build_command {
351 29     29   55 my $self = shift;
352 29         46 my $condition = shift;
353              
354 29         110 $self->_setup_build_directory;
355 29         394 chdir $self->{build};
356              
357 29         4885 $self->_prebuild;
358              
359 29 50       1941 $self->_configure( $condition ) if $self->{attributes}->CommandConfigure;
360 28 50       2605 $self->_make if $self->{attributes}->CommandMake;
361              
362 28 100 66     1637 if ( $condition->make_test or Enbld::Feature->is_make_test_all ) {
363 1         41 $self->_test;
364             }
365              
366 28 50       1351 $self->_install if $self->{attributes}->CommandInstall;
367             }
368              
369             sub _solve_dependencies {
370 27     27   69 my $self = shift;
371              
372 27 100       43 return if ( ! @{ $self->{attributes}->Dependencies } );
  27         241  
373              
374 3         27 Enbld::Message->notify( "=====> Found dependencies." );
375              
376 3         19 require Enbld::App::Configuration;
377              
378 3         12 foreach my $dependency ( @{ $self->{attributes}->Dependencies } ) {
  3         35  
379              
380 3         24 Enbld::Message->notify( "--> Dependency '$dependency'." );
381              
382 3         39 my $config = Enbld::App::Configuration->search_config( $dependency );
383 3         27 my $target = Enbld::Target->new( $dependency, $config );
384              
385 3 100       25 if ( $target->is_installed ) {
386 1         11 my $installed_msg = "--> $dependency is already installed.";
387 1         17 Enbld::Message->notify( $installed_msg );
388 1         10 next;
389             }
390              
391 2         31 Enbld::Message->notify( "--> $dependency is not installed yet." );
392              
393 2 100       12 my $condition = $self->{conditions}{$dependency} ?
394             $self->{conditions}{$dependency} : undef;
395              
396 2         4 my $installed;
397 2 100       11 if ( $condition ) {
398 1         16 $installed = $target->install_declared( $self->{conditions} );
399             } else {
400 1         11 $installed = $target->install;
401             }
402            
403 2         60 Enbld::App::Configuration->set_config( $installed );
404             }
405             }
406              
407             sub _solve_dependencies_to_deploy {
408 2     2   9 my $self = shift;
409              
410 2 50       5 return if ( ! @{ $self->{attributes}->Dependencies } );
  2         17  
411              
412 0         0 Enbld::Message->notify( "=====> Found dependencies." );
413              
414 0         0 foreach my $dependency ( @{ $self->{attributes}->Dependencies } ) {
  0         0  
415              
416 0 0       0 next if ( Enbld::Deployed->is_deployed( $dependency ));
417              
418 0         0 Enbld::Message->notify( "--> Dependency '$dependency'." );
419 0         0 Enbld::Message->notify( "--> $dependency is not installed yet." );
420            
421 0         0 my $target = Enbld::Target->new( $dependency );
422              
423 0 0       0 my $condition = $self->{conditions}{$dependency} ?
424             $self->{conditions}{$dependency} : undef;
425              
426 0         0 my $installed;
427 0 0       0 if ( $condition ) {
428 0         0 $installed = $target->deploy_declared( $self->{conditions} );
429             } else {
430 0         0 $installed = $target->deploy;
431             }
432              
433 0         0 Enbld::Deployed->add( $installed );
434             }
435             }
436              
437             sub _prebuild {
438 29     29   78 my $self = shift;
439              
440 29 50       362 $self->_apply_patchfiles if $self->{attributes}->PatchFiles;
441             }
442              
443             sub _configure {
444 29     29   84 my $self = shift;
445 29         120 my $condition = shift;
446              
447 29 50       218 return $self unless $self->{attributes}->CommandConfigure;
448              
449 29         86 my $configure;
450              
451 29         194 $configure = $self->{attributes}->CommandConfigure . ' ';
452 29         226 $configure .= $self->{attributes}->Prefix . $self->{install};
453              
454 29 50       283 if( $self->{attributes}->AdditionalArgument ) {
455 0         0 $configure .= ' ' . $self->{attributes}->AdditionalArgument;
456             }
457              
458 29 50       893 if ( $condition->arguments ) {
459 0         0 $configure .= ' ' . $condition->arguments;
460             }
461              
462 29         763 $self->_exec( $configure );
463             }
464              
465             sub _make {
466 28     28   66 my $self = shift;
467              
468 28 50       390 if ( $self->{attributes}->CommandConfigure ) {
469 28         202 $self->_exec( $self->{attributes}->CommandMake );
470 28         954 return $self;
471             }
472              
473             # this code for tree command...tree don't has configure
474 0         0 my $args = $self->{attributes}->Prefix . $self->{install};
475              
476 0 0       0 if ( $self->{attributes}->AdditionalArgument ) {
477 0         0 $args .= ' ' . $self->{attributes}->AdditionalArgument;
478             }
479              
480 0         0 $self->_exec( $self->{attributes}->CommandMake . ' ' . $args );
481              
482 0         0 return $self;
483             }
484              
485             sub _test {
486 1     1   14 my $self = shift;
487              
488 1 50       74 return $self unless $self->{attributes}->CommandTest;
489              
490 1         13 $self->_exec( $self->{attributes}->CommandTest );
491             }
492              
493             sub _install {
494 28     28   72 my $self = shift;
495              
496 28 50       236 if ( $self->{attributes}->CommandConfigure ) {
497 28         182 $self->_exec( $self->{attributes}->CommandInstall );
498 28         1654 return $self;
499             }
500              
501 0         0 my $args = $self->{attributes}->Prefix . $self->{install};
502              
503 0 0       0 if ( $self->{attributes}->AdditionalArgument ) {
504 0         0 $args .= ' ' . $self->{attributes}->AdditionalArgument;
505             }
506              
507 0         0 $self->_exec( $self->{attributes}->CommandInstall . ' ' . $args );
508              
509 0         0 return $self;
510             }
511              
512             sub _install_module {
513 0     0   0 my ( $self, $condition ) = @_;
514              
515 0         0 require Enbld::Module;
516 0         0 my $module = Enbld::Module->new(
517             name => $self->{name},
518             path => $self->{install},
519             module_file => $condition->module_file,
520             );
521              
522 0         0 $module->install;
523             }
524              
525             sub _postbuild {
526 26     26   85 my $self = shift;
527              
528 26         431 $self->_copy_files;
529              
530 26         2016 my $path = File::Spec->catdir(
531             Enbld::Home->depository,
532             $self->{attributes}->DistName,
533             );
534              
535 26         1322 Enbld::Target::Symlink->delete_symlink( $path );
536 26         325 Enbld::Target::Symlink->create_symlink( $self->{install} );
537             }
538              
539             sub _copy_files {
540 26     26   62 my $self = shift;
541              
542 26 50       1104 return $self unless ( my $dirs = $self->{attributes}->CopyFiles );
543              
544 26         153 for my $dir ( @{ $dirs } ) {
  26         1810  
545 0         0 rcopy(
546             File::Spec->catdir( $self->{build}, $dir ),
547             File::Spec->catdir( $self->{install}, $dir )
548             );
549             }
550              
551             }
552              
553             sub _exec {
554 86     86   279 my ( $self, $cmd ) = @_;
555              
556 86         3249 require Enbld::Logger;
557 86         6524 my $logfile = Enbld::Logger->logfile;
558              
559 86         2686 Enbld::Message->notify( "--> $cmd" );
560              
561 86         67820554 system( "LANG=C;$cmd >> $logfile 2>&1" );
562              
563 86 100       7394 return $self unless $?;
564              
565 1 50       99 if ( $? == -1 ) {
    50          
566 0         0 Enbld::Error->throw( "Failed to execute:$cmd" );
567             } elsif ( $? & 127 ) {
568 0         0 Enbld::Error->new( "Child died with signal:$cmd" );
569             } else {
570 1         100 Enbld::Error->throw(
571             "Build fail.Command:$cmd return code:" . ( $? >> 8 )
572             );
573             }
574             }
575              
576             sub _apply_patchfiles {
577 29     29   55 my $self = shift;
578              
579 29         173 my $patchfiles = $self->{attributes}->PatchFiles;
580              
581 29         346 require Enbld::HTTP;
582 29         156 require Enbld::Message;
583 29         135 require Enbld::Logger;
584 29         315 my $logfile = Enbld::Logger->logfile;
585 29         56 foreach my $patchfile ( @{ $patchfiles } ) {
  29         170  
586 25         137 my @parse = split( /\//, $patchfile );
587 25         344 my $path = File::Spec->catfile( $self->{build}, $parse[-1] );
588              
589 25         303 Enbld::HTTP->download( $patchfile, $path );
590 25         383 Enbld::Message->notify( "--> Apply patch $parse[-1]." );
591              
592 25         465151 system( "patch -p0 < $path >> $logfile 2>&1" );
593             }
594             }
595              
596             sub _setup_build_directory {
597 29     29   42 my $self = shift;
598            
599 29         242 my $path = File::Spec->catfile(
600             Enbld::Home->dists,
601             $self->{attributes}->Filename
602             );
603              
604 29         223 my $archivefile =
605             Enbld::HTTP->download_archivefile( $self->{attributes}->URL, $path );
606              
607 29         287 my $build = $archivefile->extract( Enbld::Home->build );
608              
609 29         511 return ( $self->{build} = $build );
610             }
611              
612             sub _setup_install_directory {
613 27     27   39 my $self = shift;
614            
615 27         263 my $depository = File::Spec->catdir(
616             Enbld::Home->depository,
617             $self->{attributes}->DistName,
618             $self->{attributes}->Version,
619             );
620              
621 27 50       1219 remove_tree( $depository ) if ( -d $depository );
622              
623 27         90 return ( $self->{install} = $depository );
624             }
625              
626             1;