File Coverage

blib/lib/Daiku/File.pm
Criterion Covered Total %
statement 52 53 98.1
branch 11 14 78.5
condition 3 3 100.0
subroutine 12 12 100.0
pod 2 2 100.0
total 80 84 95.2


line stmt bran cond sub pod time code
1 19     19   97 use strict;
  19         40  
  19         972  
2 19     19   102 use warnings FATAL => 'recursion';
  19         28  
  19         961  
3 19     19   94 use utf8;
  19         24  
  19         135  
4              
5             package Daiku::File;
6 19     19   615 use File::stat;
  19         32  
  19         161  
7 19     19   1271 use Mouse;
  19         35  
  19         107  
8 19     19   17166 use Time::HiRes 1.9701 ();
  19         27255  
  19         9714  
9              
10             with 'Daiku::Role';
11              
12             has dst => (
13             is => 'rw',
14             isa => 'Str',
15             required => 1,
16             );
17              
18             has deps => (
19             is => 'rw',
20             isa => 'ArrayRef[Str]',
21             default => sub { +[] },
22             );
23              
24             has code => (
25             is => 'rw',
26             isa => 'CodeRef',
27             default => sub {
28             sub { }
29             },
30             );
31              
32             sub build {
33 108     108 1 125 my ($self) = @_;
34              
35 108         388 $self->log("Processing file: $self->{dst}");
36 108         282 my ($built, $need_rebuild) = $self->_build_deps();
37 108 100 100     1154 if ($need_rebuild || (!-f $self->dst)) {
38 23         123 $self->log(" Building file: $self->{dst}($need_rebuild)");
39 23         30 $built++;
40 23         122 $self->code->($self);
41             } else {
42 85         312 $self->debug("There is no reason to regenerate $self->{dst}");
43             }
44 108         6076 return $built;
45             }
46              
47             sub match {
48 198     198 1 2336 my ($self, $target) = @_;
49 198 100       641 return 1 if $self->dst eq $target;
50 159         403 return 0;
51             }
52              
53             # @return need rebuild
54             sub _build_deps {
55 108     108   132 my ($self) = @_;
56              
57 108         110 my $built = 0;
58 108         103 my $need_rebuild = 0;
59 108 50       99 for my $target (@{$self->deps || []}) {
  108         618  
60 57         203 my $task = $self->registry->find_task($target);
61 57 50       208 if ($task) {
62 57         142 $built += $task->build($target);
63 57 50       430 if (-f $target) {
64 57         137 $need_rebuild += $self->_check_need_rebuild($target);
65             }
66             } else {
67 0         0 die "I don't know to build '$target' depended by '$self->{dst}'\n";
68             }
69             }
70 108         193 return ($built, $need_rebuild);
71             }
72              
73             sub _check_need_rebuild {
74 57     57   75 my ($self, $target) = @_;
75              
76 57         99 my $m1 = _mtime($target);
77 57 100       520 return 0 unless -f $self->dst;
78              
79 34         109 my $m2 = _mtime($self->dst);
80              
81 34 100       127 return 1 if $m2 < $m1;
82 24         105 return 0;
83             }
84              
85             sub _mtime {
86 91     91   102 my $fname = shift;
87 91         768 (Time::HiRes::stat($fname))[9];
88             }
89              
90 19     19   154 no Mouse; __PACKAGE__->meta->make_immutable;
  19         30  
  19         197  
91              
92             1;
93             __END__