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   77 use strict;
  19         29  
  19         775  
2 19     19   99 use warnings FATAL => 'recursion';
  19         23  
  19         800  
3 19     19   81 use utf8;
  19         24  
  19         109  
4              
5             package Daiku::File;
6 19     19   493 use File::stat;
  19         29  
  19         131  
7 19     19   990 use Mouse;
  19         30  
  19         82  
8 19     19   13963 use Time::HiRes 1.9701 ();
  19         21683  
  19         7933  
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 118 my ($self) = @_;
34              
35 108         373 $self->log("Processing file: $self->{dst}");
36 108         367 my ($built, $need_rebuild) = $self->_build_deps();
37 108 100 100     1199 if ($need_rebuild || (!-f $self->dst)) {
38 23         117 $self->log(" Building file: $self->{dst}($need_rebuild)");
39 23         41 $built++;
40 23         148 $self->code->($self);
41             } else {
42 85         321 $self->debug("There is no reason to regenerate $self->{dst}");
43             }
44 108         5649 return $built;
45             }
46              
47             sub match {
48 198     198 1 931 my ($self, $target) = @_;
49 198 100       603 return 1 if $self->dst eq $target;
50 159         414 return 0;
51             }
52              
53             # @return need rebuild
54             sub _build_deps {
55 108     108   151 my ($self) = @_;
56              
57 108         107 my $built = 0;
58 108         96 my $need_rebuild = 0;
59 108 50       107 for my $target (@{$self->deps || []}) {
  108         513  
60 57         207 my $task = $self->registry->find_task($target);
61 57 50       182 if ($task) {
62 57         121 $built += $task->build($target);
63 57 50       385 if (-f $target) {
64 57         121 $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         166 return ($built, $need_rebuild);
71             }
72              
73             sub _check_need_rebuild {
74 57     57   71 my ($self, $target) = @_;
75              
76 57         85 my $m1 = _mtime($target);
77 57 100       474 return 0 unless -f $self->dst;
78              
79 34         92 my $m2 = _mtime($self->dst);
80              
81 34 100       146 return 1 if $m2 < $m1;
82 24         100 return 0;
83             }
84              
85             sub _mtime {
86 91     91   91 my $fname = shift;
87 91         654 (Time::HiRes::stat($fname))[9];
88             }
89              
90 19     19   103 no Mouse; __PACKAGE__->meta->make_immutable;
  19         25  
  19         100  
91              
92             1;
93             __END__