File Coverage

blib/lib/Daiku/SuffixRule.pm
Criterion Covered Total %
statement 51 52 98.0
branch 11 12 91.6
condition 10 11 90.9
subroutine 11 11 100.0
pod 0 2 0.0
total 83 88 94.3


line stmt bran cond sub pod time code
1 19     19   93 use strict;
  19         27  
  19         879  
2 19     19   107 use warnings FATAL => 'recursion';
  19         26  
  19         993  
3 19     19   97 use utf8;
  19         27  
  19         125  
4              
5             # Suffix Rule, same as Makefile.
6             # like '.c.o' in Makefile.
7             package Daiku::SuffixRule;
8 19     19   1578 use Time::HiRes 1.9701 ();
  19         478  
  19         481  
9 19     19   95 use Mouse;
  19         24  
  19         115  
10             with 'Daiku::Role';
11              
12             has src => (
13             is => 'ro',
14             required => 1,
15             );
16             has dst => (
17             is => 'ro',
18             isa => 'Str',
19             required => 1,
20             );
21             has code => (
22             is => 'ro',
23             isa => 'CodeRef',
24             default => sub {
25             sub { }
26             },
27             );
28              
29             has _dst_regex => (
30             is => 'ro',
31             isa => 'Regexp',
32             default => sub {
33             my $self = shift;
34             my $dst = $self->dst;
35             ref $dst && ref $dst eq 'Regexp' ? $dst : qr/\Q$dst\E$/;
36             },
37             );
38              
39             sub match {
40 141     141 0 648 my ($self, $target) = @_;
41 141         969 $target =~ $self->_dst_regex;
42             }
43              
44             sub build {
45 32     32 0 40 my ($self, $target) = @_;
46 32         130 $self->log("Building SuffixRule: $target");
47 32         91 my ($built, $need_rebuild, $sources) = $self->_build_deps($target);
48              
49 32 100 100     270 if ($need_rebuild || !-f $target) {
50 15         18 $built++;
51 15         79 $self->code->($self, $target, @$sources);
52             } else {
53 17         82 $self->debug("There is no reason to regenerate $target");
54             }
55 32         4986 return $built;
56             }
57              
58             sub _build_deps {
59 32     32   52 my ($self, $target) = @_;
60              
61 32         40 my $built = 0;
62 32         32 my $need_rebuild = 0;
63 32         35 my @sources;
64 32         100 for my $src (_flatten($self->src)) {
65 42 100 100     169 if ( (ref($src) || '') eq 'CODE') {
66 8         21 my @add_sources = _flatten($src->($target));
67 8         25 push @sources, @add_sources;
68             }
69             else {
70 34         43 (my $source = $target) =~ s/@{[$self->_dst_regex]}/$src/;
  34         341  
71 34         117 push @sources, $source;
72             }
73             }
74              
75 32         47 for my $source (@sources) {
76 48         185 my $task = $self->registry->find_task($source);
77 48 50       147 if ($task) {
78 48         123 $built += $task->build($source);
79 48 100 66     708 if (-f $target && -f $source) {
80 30 100       65 $need_rebuild += 1 if _mtime($target) < _mtime($source);
81             }
82             } else {
83 0         0 die "I don't know to build '$source' depended by '$target'\n";
84             }
85             }
86              
87 32         100 return ($built, $need_rebuild, \@sources);
88             }
89              
90             sub _mtime {
91 60     60   72 my $fname = shift;
92 60         760 (Time::HiRes::stat($fname))[9];
93             }
94              
95             sub _flatten {
96 56 100 100 56   143 map { ref $_ && ref $_ eq 'ARRAY' ? _flatten(@{$_}) : $_ } @_;
  72         361  
  16         36  
97             }
98              
99 19     19   19827 no Mouse;
  19         40  
  19         96  
100             __PACKAGE__->meta->make_immutable;
101              
102             1;
103