File Coverage

lib/CSS/Watcher.pm
Criterion Covered Total %
statement 167 192 86.9
branch 39 52 75.0
condition 4 5 80.0
subroutine 23 26 88.4
pod 0 6 0.0
total 233 281 82.9


line stmt bran cond sub pod time code
1             package CSS::Watcher;
2              
3 1     1   44973 use strict;
  1         4  
  1         24  
4 1     1   6 use warnings;
  1         2  
  1         26  
5              
6 1     1   4 use Carp;
  1         2  
  1         73  
7 1     1   1012 use Data::Dumper;
  1         9019  
  1         69  
8              
9 1     1   1359 use Log::Log4perl qw(:easy);
  1         56286  
  1         6  
10 1     1   1601 use File::Slurp qw/read_file write_file/;
  1         16617  
  1         71  
11 1     1   8 use Path::Tiny;
  1         2  
  1         48  
12 1     1   4 use Digest::MD5 qw/md5_hex/;
  1         2  
  1         45  
13 1     1   987 use List::MoreUtils qw(any);
  1         12670  
  1         8  
14              
15 1     1   1107 use CSS::Watcher::Parser;
  1         4  
  1         36  
16 1     1   491 use CSS::Watcher::ParserLess;
  1         4  
  1         37  
17 1     1   447 use CSS::Watcher::Monitor;
  1         3  
  1         49  
18              
19             our $VERSION = '0.4.9';
20              
21 1     1   7 use constant DEFAULT_HTML_STUFF_DIR => '~/.emacs.d/ac-html-csswatcher/completion/';
  1         2  
  1         2087  
22              
23             sub new {
24 5     5 0 33122 my $class= shift;
25 5         11 my $options = shift;
26              
27             return bless ({
28 5   100     62 outputdir => $options->{'outputdir'} // DEFAULT_HTML_STUFF_DIR,
29             parser_css => CSS::Watcher::Parser->new(),
30             parser_less => CSS::Watcher::ParserLess->new(),
31             }, $class);
32             }
33              
34             sub update {
35 7     7 0 20 my $self = shift;
36 7         12 my $obj = shift;
37              
38             # check what is the monobj. file? dir?
39 7 100 66     187 if (-f $obj || -d $obj) {
40 5         17 my $proj_dir = $self->get_project_dir ($obj);
41 5 50       21 return unless (defined $proj_dir);
42              
43 5         17 INFO "Update project: $proj_dir";
44              
45 5         82 my $prj = $self->_get_project ($proj_dir);
46 5         22 $prj->{parsed_files} = []; # clean old parsed file list
47              
48 5         10 my $changes = 0;
49              
50 5         6 my (@ignore, @allow, @skip_dirs);
51 5         15 my $cfg = path($proj_dir)->child('.csswatcher');
52              
53             # clear project cache if .csswatcher changed
54 5 100       179 if ($prj->{monitor}->is_changed($cfg)) {
55 4         339 INFO ('.csswatcher changed, resetting');
56 4         36 $prj->{monitor}->make_dirty();
57 4         10 delete $prj->{parsed};
58 4         6 $changes++;
59             }
60              
61 5 100       30 if (-f $cfg) {
62 1 50   1   64 if (open (CFG, '<:encoding(UTF-8)', $cfg)) {
  1         3  
  1         7  
  4         69  
63 4         23837 while () {
64 11         60 chomp;
65 11 100       190 (m/^\s*ignore:\s*(.*?)\s*$/i) ? push @ignore, $1 :
    100          
    100          
66             (m/^\s*skip:\s*(.*?)\s*$/i) ? push @skip_dirs, $1 :
67             (m/^\s*use:\s*(.*?)\s*$/i) ? push @allow, $1 : 1;
68             }
69 4         44 close CFG;
70             }
71             }
72              
73             # scan new or changed files, cache them
74             $prj->{monitor}->scan (
75             sub {
76 16     16   22 my $file = shift;
77              
78 16 50       47 return if (any {$_ eq $file} @{$prj->{parsed_files}});
  9         25  
  16         56  
79              
80 16         45 my $allow = 0;
81 16         37 foreach (@allow) {
82 18 100       227 if ($file =~ m/$_/) {
83 4         9 $allow = 1;
84 4         5 last;
85             }
86             }
87 16 100       41 unless ($allow) {
88 12         22 foreach (@ignore) {
89 10 100       121 if ($file =~ m/$_/) {
90 2         12 INFO " Ignored $file =~\"$_\"";
91 2         18 return;
92             }
93             }
94             }
95 14 50       67 ($file =~ m/\.css$/) ? $changes += 1 && $self->_parse_css ($prj, $file) :
    100          
96             ($file =~ m/\.less$/) ? $changes += 1 && $self->_parse_less_and_imports ($prj, $file) : 1;
97              
98 5         58 }, \@skip_dirs);
99 5         46 INFO "Update done.";
100 5         50 return ($changes, $proj_dir);
101             }
102 2         10 return;
103             }
104              
105             sub _parse_css {
106 6     6   11 my ($self, $project, $file) = @_;
107              
108 6         25 INFO " (Re)parse css: $file";
109 6         88 my $data = read_file ($file);
110 6         441 my ($classes, $ids) = $self->{parser_css}->parse_css ($data);
111 6         25 $project->{parsed}{$file} = {CLASSES => $classes,
112             IDS => $ids};
113 6         8 push @{$project->{parsed_files}}, $file;
  6         15  
114 6         20 return 1;
115             }
116              
117             sub _parse_less {
118 0     0   0 my ($self, $project, $file) = @_;
119              
120 0         0 INFO " (Re)parse less: $file";
121 0         0 my ($classes, $ids, $requiries) = $self->{parser_less}->parse_less ($file);
122 0         0 $project->{parsed}{$file} = {CLASSES => $classes,
123             IDS => $ids};
124 0         0 push @{$project->{parsed_files}}, $file;
  0         0  
125              
126             # normilize path of requiried files, they may have .././
127             # eval {
128             # $project->{imports_less}{$file} =
129             # [ map {path($file)->parent->child($_)->realpath()->stringify} @{$requiries} ];
130             # };
131             # if ($@) {
132             # WARN $@;
133             # }
134             $project->{imports_less}{$file} =
135 0         0 [ map {path($file)->parent->child($_)->realpath()->stringify} @{$requiries} ];
  0         0  
  0         0  
136 0         0 return 1;
137             }
138              
139             sub _parse_less_and_imports {
140 0     0   0 my ($self, $project, $file) = @_;
141              
142 0         0 my $parsed_files = 1; # 1, cause we parse $file for sure., ++ if dependencies parsed too
143              
144 0         0 $self->_parse_less ($project, $file);
145              
146 0         0 while (my ($less_fname, $imports) = each %{$project->{imports_less}}) {
  0         0  
147 0         0 foreach (@{$imports}) {
  0         0  
148 0 0       0 if ($file eq $_) {
149 0 0   0   0 next if (any {$_ eq $less_fname} @{$project->{parsed_files}});
  0         0  
  0         0  
150 0         0 INFO sprintf " %s required by %s, parse them too.", path($file)->basename, path($less_fname)->basename;
151 0         0 $self->_parse_less($project, $less_fname);
152 0         0 $parsed_files++;
153             }
154             }
155             }
156 0         0 return $parsed_files;
157             }
158              
159             sub project_stuff {
160 4     4 0 1231 my $self = shift;
161 4         6 my $proj_dir = shift;
162              
163 4         11 my $prj = $self->_get_project ($proj_dir);
164              
165             # build unique tag - class,id
166 4         17 my (%classes, %ids);
167 4         7 my ($total_classes, $total_ids) = (0, 0);
168 4         8 while ( my ( $file, $completions ) = each %{$prj->{parsed}} ) {
  10         41  
169 6         9 while ( my ( $tag, $classes ) = each %{$completions->{CLASSES}} ) {
  15         68  
170 9         11 foreach (keys %{$classes}) {
  9         25  
171 9         39 $classes{$tag}{$_} .= 'Defined in ' . path( $file )->relative( $proj_dir ) . '\n';
172 9         1085 $total_classes++;
173             }
174             }
175             }
176 4         8 while ( my ( $file, $completions ) = each %{$prj->{parsed}} ) {
  10         35  
177 6         8 while ( my ( $tag, $ids ) = each %{$completions->{IDS}} ) {
  9         35  
178 3         5 foreach (keys %{$ids}) {
  3         9  
179 3         16 $ids{$tag}{$_} .= 'Defined in ' . path( $file )->relative( $proj_dir ) . '\n';
180 3         288 $total_ids++;
181             }
182             }
183             }
184 4         11 INFO "Total for $proj_dir:";
185 4         52 INFO " Classes: $total_classes, ids: $total_ids";
186              
187 4         27 return (\%classes, \%ids);
188             }
189              
190             # clean old output html complete stuff and build new
191             sub build_ac_html_stuff {
192 3     3 0 1933 my $self = shift;
193 3         6 my $proj_dir = shift;
194              
195 3         11 my ($classes, $ids) = $self->project_stuff ($proj_dir);
196              
197 3         13 my $ac_html_stuff_dir = path ($self->{outputdir})->child (md5_hex( ''.$proj_dir ));
198 3         157 my $attrib_dir = path ($ac_html_stuff_dir)->child ('html-attributes-complete');
199              
200 3         111 $attrib_dir->remove_tree({safe => 0});
201 3         111 $attrib_dir->mkpath;
202              
203 3         1043 while ( my ( $tag, $class ) = each %{$classes} ) {
  7         752  
204 4         41 my $fname = File::Spec->catfile ($attrib_dir, $tag . '-class');
205 4         43 DEBUG "Write $fname";
206             write_file ($fname, join "\n", map {
207 4         31 $_ . ' ' . $class->{$_} } sort keys %{$class});
  4         25  
  4         31  
208             }
209 3         14 while ( my ( $tag, $id ) = each %${ids} ) {
210 2         19 my $fname = File::Spec->catfile ($attrib_dir, $tag . '-id');
211 2         21 DEBUG "Write $fname";
212             write_file ($fname, join "\n", map {
213 2         14 $_ . ' ' . $id->{$_} } sort keys %{$id});
  2         11  
  2         6  
214             }
215 3         323 DEBUG "Done writing. Reply to client.";
216 3         29 return $ac_html_stuff_dir;
217             }
218              
219             sub get_html_stuff {
220 4     4 0 2427 my $self = shift;
221 4         7 my $obj = shift;
222              
223 4         14 my ($changes, $project_dir) = $self->update ($obj);
224 4 100       18 return unless defined $changes;
225              
226 3         9 my $prj = $self->_get_project ($project_dir);
227              
228 3         12 my $ac_html_stuff_dir;
229              
230 3 100       9 if ($changes) {
231 2         7 $ac_html_stuff_dir = $self->build_ac_html_stuff ($project_dir);
232 2         6 $prj->{'ac_html_stuff'} = $ac_html_stuff_dir;
233             } else {
234 1         2 $ac_html_stuff_dir = $prj->{'ac_html_stuff'};
235             }
236 3         12 return ($project_dir, $ac_html_stuff_dir);
237             }
238              
239             sub _get_project {
240 12     12   19 my $self = shift;
241 12         138 my $dir = shift;
242 12 50       31 return unless defined $dir;
243              
244 12 100       38 unless (exists $self->{PROJECTS}{$dir}) {
245 4         50 $self->{PROJECTS}{$dir} =
246             bless ( {monitor => CSS::Watcher::Monitor->new({dir => $dir})}, 'CSS::Watcher::Project' );
247             }
248 12         76 return $self->{PROJECTS}{$dir};
249             }
250              
251             # Lookup for project dir similar to projectile.el
252             sub get_project_dir {
253 12     12 0 1685 my $self = shift;
254 12         18 my $obj = shift;
255            
256 12 50       294 my $pdir = ! defined ($obj) ? undef:
    100          
    50          
257             (-f $obj) ? path ($obj)->parent :
258             (-d $obj) ? $obj : undef;
259 12 50       352 return unless (defined $pdir);
260              
261 12         34 $pdir = path( $pdir );
262              
263 12         232 foreach (qw/.projectile .csswatcher .git .hg .fslckout .bzr _darcs/) {
264 50 100       1751 if (-e ($pdir->child( $_ ))) {
265 7         303 return $pdir;
266             }
267             }
268 5 50       212 return if ($pdir->is_rootdir());
269             #parent dir
270 5         131 return $self->get_project_dir ($pdir->parent);
271             }
272              
273             1;
274              
275             __END__