File Coverage

blib/lib/File/Assets/Filter.pm
Criterion Covered Total %
statement 104 115 90.4
branch 23 34 67.6
condition 4 5 80.0
subroutine 22 25 88.0
pod 0 16 0.0
total 153 195 78.4


line stmt bran cond sub pod time code
1             package File::Assets::Filter;
2              
3 23     23   142 use strict;
  23         51  
  23         755  
4 23     23   136 use warnings;
  23         48  
  23         671  
5              
6 23     23   156 use Object::Tiny qw/cfg where signature/;
  23         48  
  23         388  
7 23     23   5788 use File::Assets::Carp;
  23         51  
  23         279  
8              
9 23     23   3985 use Digest;
  23         46  
  23         524  
10 23     23   127 use Scalar::Util qw/weaken/;
  23         136  
  23         1653  
11              
12             for my $ii (qw/matched mtime assets bucket slice/) {
13 23     23   118 no strict 'refs';
  23         58  
  23         27845  
14             *$ii = sub {
15 989     989   1271 my $self = shift;
16 989 100       2857 return $self->stash->{$ii} unless @_;
17 166         335 return $self->stash->{$ii} = shift;
18             };
19             }
20              
21             my %default = (qw/
22             /,
23             output => undef,
24             );
25              
26             sub new_parse {
27 300     300 0 431 my $class = shift;
28 300 50       683 return unless my $filter = shift;
29              
30 300         406 $filter =~ s/^yui-compressor\b/yuicompressor/; # A special case
31 300         658 my $kind = lc $class;
32 300         909 $kind =~ s/^File::Assets::Filter:://i;
33 300         719 $kind =~ s/::/-/g;
34              
35 300         365 my %cfg;
36 300 100       3918 if (ref $filter eq "") {
    50          
37 282         374 my $cfg = $filter;
38 282 100       8653 return unless $cfg =~ s/^\s*$kind(?:\s*$|:([^:]))//i;
39 24 50       143 $cfg = "$1$cfg" if defined $1;
40 24         166 %cfg = $class->new_parse_cfg($cfg);
41 24 100       169 if (ref $_[0] eq "HASH") {
    50          
42 2         9 %cfg = (%cfg, %{ $_[0] });
  2         11  
43 2         7 shift;
44             }
45             elsif (ref $_[0] eq "ARRAY") {
46 0         0 %cfg = (%cfg, @{ $_[0] });
  0         0  
47 0         0 shift;
48             }
49             }
50             elsif (ref $filter eq "ARRAY") {
51             # TODO? Get rid of this?
52 18 100 66     570 return unless $filter->[0] && $filter->[0] =~ m/^\s*$kind\s*$/i;
53 3         12 my @cfg = @$filter;
54 3         7 shift @cfg;
55 3         9 %cfg = @cfg;
56             }
57              
58 27         224 return $class->new(%cfg, @_);
59             }
60              
61             sub new_parse_cfg {
62 24     24 0 55 my $class = shift;
63 24         49 my $cfg = shift;
64 24 50       86 $cfg = "" unless defined $cfg;
65 24         49 my %cfg;
66 24         91 %cfg = map { my @itm = split m/=/, $_, 2; $itm[0], $itm[1] } split m/;/, $cfg;
  0         0  
  0         0  
67 24         111 $cfg{__cfg__} = $cfg;
68 24         123 return %cfg;
69             }
70              
71             sub new {
72 28     28 0 62 my $class = shift;
73 28         459 my $self = $class->SUPER::new;
74 28         300 local %_ = @_;
75              
76             # $self->{assets} = $_{assets};
77             # weaken $self->{assets};
78              
79 28         211 $self->{cfg} = {};
80              
81 28         209 while (my ($setting, $value) = each %default) {
82 28 50       1091 $self->cfg->{$setting} = exists $_{$setting} ? $_{$setting} : $value;
83             }
84              
85 28         318 return $self;
86             }
87              
88             sub fit {
89 0     0 0 0 my $self = shift;
90 0         0 my $bucket = shift;
91              
92 0 0       0 return 1 unless $self->{fit};
93 0 0       0 return 1 if $bucket->kind->is_better_than_or_equal($self->{fit});
94             }
95              
96             sub stash {
97 1716   100 1716 0 21500 return shift->{stash} ||= {};
98             }
99              
100             sub type {
101 0     0 0 0 return shift->where->{type};
102             }
103              
104             sub output {
105 0     0 0 0 return shift->cfg->{output};
106             }
107              
108             sub begin {
109 56     56 0 93 my $self = shift;
110 56         92 my $slice = shift;
111 56         79 my $bucket = shift;
112 56         1419 my $assets = shift;
113              
114 56         253 $self->stash->{slice} = $slice;
115 56         164 $self->stash->{bucket} = $bucket;
116 56         149 $self->stash->{assets} = $assets;
117 56         209 $self->stash->{mtime} = 0;
118             }
119              
120             sub end {
121 56     56 0 100 my $self = shift;
122 56         823 delete $self->{stash};
123             }
124              
125             sub filter {
126 56     56 0 469 my $self = shift;
127 56         101 my $slice = shift;
128 56         88 my $bucket = shift;
129 56         85 my $assets = shift;
130              
131 56         298 $self->begin($slice, $bucket, $assets);
132              
133 56 50       290 return unless $self->pre;
134              
135 56         97 my @matched;
136 56         249 $self->matched(\@matched);
137              
138 56         95 my $count = 0;
139 56         297 for (my $rank = 0; $rank < @$slice; $rank++) {
140 121         225 my $asset = $slice->[$rank];
141              
142 121 100       370 next unless $self->_match($asset);
143              
144 115         206 $count = $count + 1;
145 115         454 push @matched, { asset => $asset, rank => $rank, count => $count };
146              
147 115         439 my $asset_file_mtime = $asset->file_mtime;
148 115 100       7693 $self->mtime($asset_file_mtime) if $asset_file_mtime >= $self->mtime;
149              
150 115         573 $self->process($asset, $rank, $count, scalar @$slice, $slice);
151             }
152 56         296 $self->post;
153              
154 56         410 $self->end;
155             }
156              
157             sub _match {
158 121     121   180 my $self = shift;
159 121         156 my $asset = shift;
160              
161 121         481 return $self->match($asset, 1);
162             }
163              
164             sub match {
165 121     121 0 853 my $self = shift;
166 121         180 my $asset = shift;
167 121         178 my $match = shift;
168              
169 121 100       705 return $match ? 1 : 0;
170             }
171              
172             sub pre {
173 56     56 0 136 return 1;
174             }
175              
176 115     115 0 221 sub process {
177             }
178              
179             sub post {
180 56     56 0 127 return 1;
181             }
182              
183             sub remove {
184 1     1 0 3 my $self = shift;
185 1         7 carp __PACKAGE__, "::remove() is deprecated, nothing happens";
186 1         591 return;
187             }
188              
189             sub kind {
190 342     342 0 4605 my $self = shift;
191 342         701 return $self->bucket->kind;
192             }
193              
194             1;
195              
196             __END__