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   55755 use strict;
  1         3  
  1         38  
4 1     1   7 use warnings;
  1         3  
  1         36  
5              
6 1     1   6 use Carp;
  1         3  
  1         81  
7 1     1   1193 use Data::Dumper;
  1         11157  
  1         96  
8              
9 1     1   1454 use Log::Log4perl qw(:easy);
  1         69135  
  1         7  
10 1     1   1902 use File::Slurp qw/read_file write_file/;
  1         19127  
  1         102  
11 1     1   11 use Path::Tiny;
  1         2  
  1         55  
12 1     1   6 use Digest::MD5 qw/md5_hex/;
  1         2  
  1         53  
13 1     1   1128 use List::MoreUtils qw(any);
  1         14794  
  1         11  
14              
15 1     1   1286 use CSS::Watcher::Parser;
  1         5  
  1         46  
16 1     1   627 use CSS::Watcher::ParserLess;
  1         3  
  1         36  
17 1     1   562 use CSS::Watcher::Monitor;
  1         4  
  1         49  
18              
19             our $VERSION = '0.4.8';
20              
21 1     1   7 use constant DEFAULT_HTML_STUFF_DIR => '~/.emacs.d/ac-html-csswatcher/completion/';
  1         2  
  1         2431  
22              
23             sub new {
24 5     5 0 32287 my $class= shift;
25 5         10 my $options = shift;
26              
27             return bless ({
28 5   100     71 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 19 my $self = shift;
36 7         15 my $obj = shift;
37              
38             # check what is the monobj. file? dir?
39 7 100 66     188 if (-f $obj || -d $obj) {
40 5         25 my $proj_dir = $self->get_project_dir ($obj);
41 5 50       20 return unless (defined $proj_dir);
42              
43 5         22 INFO "Update project: $proj_dir";
44              
45 5         94 my $prj = $self->_get_project ($proj_dir);
46 5         27 $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         14 my $cfg = path($proj_dir)->child('.csswatcher');
52              
53             # clear project cache if .csswatcher changed
54 5 100       189 if ($prj->{monitor}->is_changed($cfg)) {
55 4         379 INFO ('.csswatcher changed, resetting');
56 4         37 $prj->{monitor}->make_dirty();
57 4         8 delete $prj->{parsed};
58 4         9 $changes++;
59             }
60              
61 5 100       30 if (-f $cfg) {
62 1 50   1   57 if (open (CFG, '<:encoding(UTF-8)', $cfg)) {
  1         2  
  1         7  
  4         69  
63 4         14339 while () {
64 11         65 chomp;
65 11 100       160 (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   25 my $file = shift;
77              
78 16 50       50 return if (any {$_ eq $file} @{$prj->{parsed_files}});
  9         23  
  16         53  
79              
80 16         45 my $allow = 0;
81 16         33 foreach (@allow) {
82 18 100       236 if ($file =~ m/$_/) {
83 4         6 $allow = 1;
84 4         6 last;
85             }
86             }
87 16 100       39 unless ($allow) {
88 12         22 foreach (@ignore) {
89 10 100       133 if ($file =~ m/$_/) {
90 2         14 INFO " Ignored $file =~\"$_\"";
91 2         24 return;
92             }
93             }
94             }
95 14 50       69 ($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         62 }, \@skip_dirs);
99 5         44 INFO "Update done.";
100 5         51 return ($changes, $proj_dir);
101             }
102 2         9 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         59 my $data = read_file ($file);
110 6         462 my ($classes, $ids) = $self->{parser_css}->parse_css ($data);
111 6         30 $project->{parsed}{$file} = {CLASSES => $classes,
112             IDS => $ids};
113 6         7 push @{$project->{parsed_files}}, $file;
  6         17  
114 6         19 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 1299 my $self = shift;
161 4         7 my $proj_dir = shift;
162              
163 4         10 my $prj = $self->_get_project ($proj_dir);
164              
165             # build unique tag - class,id
166 4         16 my (%classes, %ids);
167 4         9 my ($total_classes, $total_ids) = (0, 0);
168 4         6 while ( my ( $file, $completions ) = each %{$prj->{parsed}} ) {
  10         35  
169 6         9 while ( my ( $tag, $classes ) = each %{$completions->{CLASSES}} ) {
  15         58  
170 9         11 foreach (keys %{$classes}) {
  9         23  
171 9         34 $classes{$tag}{$_} .= 'Defined in ' . path( $file )->relative( $proj_dir ) . '\n';
172 9         989 $total_classes++;
173             }
174             }
175             }
176 4         9 while ( my ( $file, $completions ) = each %{$prj->{parsed}} ) {
  10         63  
177 6         9 while ( my ( $tag, $ids ) = each %{$completions->{IDS}} ) {
  9         38  
178 3         4 foreach (keys %{$ids}) {
  3         9  
179 3         13 $ids{$tag}{$_} .= 'Defined in ' . path( $file )->relative( $proj_dir ) . '\n';
180 3         299 $total_ids++;
181             }
182             }
183             }
184 4         14 INFO "Total for $proj_dir:";
185 4         56 INFO " Classes: $total_classes, ids: $total_ids";
186              
187 4         31 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 1907 my $self = shift;
193 3         5 my $proj_dir = shift;
194              
195 3         11 my ($classes, $ids) = $self->project_stuff ($proj_dir);
196              
197 3         11 my $ac_html_stuff_dir = path ($self->{outputdir})->child (md5_hex( ''.$proj_dir ));
198 3         161 my $attrib_dir = path ($ac_html_stuff_dir)->child ('html-attributes-complete');
199              
200 3         110 $attrib_dir->remove_tree({safe => 0});
201 3         121 $attrib_dir->mkpath;
202              
203 3         1114 while ( my ( $tag, $class ) = each %{$classes} ) {
  7         802  
204 4         40 my $fname = File::Spec->catfile ($attrib_dir, $tag . '-class');
205 4         46 DEBUG "Write $fname";
206             write_file ($fname, join "\n", map {
207 4         32 $_ . ' ' . $class->{$_} } sort keys %{$class});
  4         24  
  4         14  
208             }
209 3         16 while ( my ( $tag, $id ) = each %${ids} ) {
210 2         20 my $fname = File::Spec->catfile ($attrib_dir, $tag . '-id');
211 2         24 DEBUG "Write $fname";
212             write_file ($fname, join "\n", map {
213 2         15 $_ . ' ' . $id->{$_} } sort keys %{$id});
  2         10  
  2         6  
214             }
215 3         327 DEBUG "Done writing. Reply to client.";
216 3         31 return $ac_html_stuff_dir;
217             }
218              
219             sub get_html_stuff {
220 4     4 0 2453 my $self = shift;
221 4         8 my $obj = shift;
222              
223 4         15 my ($changes, $project_dir) = $self->update ($obj);
224 4 100       17 return unless defined $changes;
225              
226 3         8 my $prj = $self->_get_project ($project_dir);
227              
228 3         11 my $ac_html_stuff_dir;
229              
230 3 100       10 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         4 $ac_html_stuff_dir = $prj->{'ac_html_stuff'};
235             }
236 3         9 return ($project_dir, $ac_html_stuff_dir);
237             }
238              
239             sub _get_project {
240 12     12   19 my $self = shift;
241 12         17 my $dir = shift;
242 12 50       26 return unless defined $dir;
243              
244 12 100       44 unless (exists $self->{PROJECTS}{$dir}) {
245 4         69 $self->{PROJECTS}{$dir} =
246             bless ( {monitor => CSS::Watcher::Monitor->new({dir => $dir})}, 'CSS::Watcher::Project' );
247             }
248 12         74 return $self->{PROJECTS}{$dir};
249             }
250              
251             # Lookup for project dir similar to projectile.el
252             sub get_project_dir {
253 12     12 0 1705 my $self = shift;
254 12         17 my $obj = shift;
255            
256 12 50       202 my $pdir = ! defined ($obj) ? undef:
    100          
    50          
257             (-f $obj) ? path ($obj)->parent :
258             (-d $obj) ? $obj : undef;
259 12 50       361 return unless (defined $pdir);
260              
261 12         39 $pdir = path( $pdir );
262              
263 12         221 foreach (qw/.projectile .csswatcher .git .hg .fslckout .bzr _darcs/) {
264 50 100       1676 if (-e ($pdir->child( $_ ))) {
265 7         292 return $pdir;
266             }
267             }
268 5 50       207 return if ($pdir->is_rootdir());
269             #parent dir
270 5         138 return $self->get_project_dir ($pdir->parent);
271             }
272              
273             1;
274              
275             __END__