File Coverage

blib/lib/HTML/Latemp/GenMakeHelpers.pm
Criterion Covered Total %
statement 172 182 94.5
branch 14 16 87.5
condition 12 16 75.0
subroutine 30 33 90.9
pod 8 8 100.0
total 236 255 92.5


line stmt bran cond sub pod time code
1             package HTML::Latemp::GenMakeHelpers;
2             $HTML::Latemp::GenMakeHelpers::VERSION = '0.10.1';
3 1     1   91938 use strict;
  1         13  
  1         28  
4 1     1   15 use warnings;
  1         3  
  1         25  
5 1     1   468 use autodie;
  1         15784  
  1         5  
6 1     1   7329 use 5.014;
  1         7  
7              
8             package HTML::Latemp::GenMakeHelpers::Base;
9             $HTML::Latemp::GenMakeHelpers::Base::VERSION = '0.10.1';
10             sub new
11             {
12 13     13   8785 my $class = shift;
13 13         26 my $self = {};
14 13         28 bless $self, $class;
15 13         40 $self->initialize(@_);
16 13         40 return $self;
17             }
18              
19             package HTML::Latemp::GenMakeHelpers::HostEntry;
20             $HTML::Latemp::GenMakeHelpers::HostEntry::VERSION = '0.10.1';
21             our @ISA = (qw(HTML::Latemp::GenMakeHelpers::Base));
22              
23 1         9 use Class::XSAccessor accessors =>
24 1     1   500 { 'dest_dir' => 'dest_dir', 'id' => 'id', 'source_dir' => 'source_dir', };
  1         2317  
25              
26             sub initialize
27             {
28 7     7   13 my $self = shift;
29 7         19 my %args = (@_);
30              
31 7         21 $self->id( $args{'id'} );
32 7         16 $self->source_dir( $args{'source_dir'} );
33 7         21 $self->dest_dir( $args{'dest_dir'} );
34             }
35              
36             package HTML::Latemp::GenMakeHelpers::Error;
37             $HTML::Latemp::GenMakeHelpers::Error::VERSION = '0.10.1';
38             our @ISA = (qw(HTML::Latemp::GenMakeHelpers::Base));
39              
40             package HTML::Latemp::GenMakeHelpers::Error::UncategorizedFile;
41             $HTML::Latemp::GenMakeHelpers::Error::UncategorizedFile::VERSION = '0.10.1';
42             our @ISA = (qw(HTML::Latemp::GenMakeHelpers::Error));
43              
44 1     1   419 use Class::XSAccessor accessors => { 'file' => 'file', 'host' => 'host', };
  1         3  
  1         12  
45              
46             sub initialize
47             {
48 0     0   0 my $self = shift;
49 0         0 my $args = shift;
50              
51 0         0 $self->file( $args->{'file'} );
52 0         0 $self->host( $args->{'host'} );
53              
54 0         0 return 0;
55             }
56              
57             package HTML::Latemp::GenMakeHelpers;
58              
59              
60             our @ISA = (qw(HTML::Latemp::GenMakeHelpers::Base));
61              
62 1     1   847 use File::Find::Rule ();
  1         8407  
  1         43  
63 1     1   16 use File::Basename qw/ basename /;
  1         4  
  1         127  
64              
65 1         11 use Class::XSAccessor accessors => {
66             '_common_buckets' => '_common_buckets',
67             '_base_dir' => 'base_dir',
68             '_filename_lists_post_filter' => '_filename_lists_post_filter',
69             'hosts' => 'hosts',
70             '_hosts_id_map' => 'hosts_id_map',
71             '_out_dir' => '_out_dir',
72             '_out_docs_ext' => '_out_docs_ext',
73             '_docs_build_command_cb' => '_docs_build_command_cb',
74             '_images_dest_varname_cb' => '_images_dest_varname_cb',
75 1     1   7 };
  1         2  
76              
77              
78             sub initialize
79             {
80 6     6 1 7 my $self = shift;
81 6         22 my (%args) = (@_);
82              
83 6         24 $self->_base_dir("src");
84             $self->_filename_lists_post_filter(
85             $args{filename_lists_post_filter} || sub {
86 12     12   22 my ($params) = @_;
87 12         32 return $params->{filenames};
88             }
89 6   100     32 );
90             $self->hosts(
91             [
92 7         43 map { HTML::Latemp::GenMakeHelpers::HostEntry->new(%$_), }
93 6         11 @{ $args{'hosts'} }
  6         15  
94             ]
95             );
96 6         13 $self->_hosts_id_map( +{ map { $_->{'id'} => $_ } @{ $self->hosts() } } );
  7         29  
  6         14  
97 6         15 $self->_common_buckets( {} );
98 6         24 $self->_out_dir( $args{'out_dir'} );
99 6   100     49 $self->_out_docs_ext( $args{'out_docs_ext'} // '.wml' );
100 6         26 $self->_docs_build_command_cb( $args{'docs_build_command_cb'} );
101 6         20 $self->_images_dest_varname_cb( $args{'images_dest_varname_cb'} );
102              
103 6         17 return;
104             }
105              
106             sub _calc_out_path
107             {
108 2     2   6 my ( $self, $bn ) = @_;
109              
110 2         5 my $out_dir = $self->_out_dir;
111              
112 2 50       35 return $out_dir ? File::Spec->catfile( $out_dir, $bn ) : $bn;
113             }
114              
115             sub process_all
116             {
117 1     1 1 6 my $self = shift;
118 1         3 my $dir = $self->_base_dir();
119              
120 1         2 my @hosts = @{ $self->hosts() };
  1         4  
121              
122 1         4 open my $file_lists_fh, ">", $self->_calc_out_path("include.mak");
123 1         2706 open my $rules_fh, ">", $self->_calc_out_path("rules.mak");
124              
125 1         34 print {$rules_fh} "COMMON_SRC_DIR = "
126 1         121 . $self->_hosts_id_map()->{'common'}->{'source_dir'} . "\n\n";
127              
128 1         5 foreach my $host (@hosts)
129             {
130 2         6 my $host_outputs = $self->process_host($host);
131 2         4 print {$file_lists_fh} $host_outputs->{'file_lists'};
  2         10  
132 2         4 print {$rules_fh} $host_outputs->{'rules'};
  2         7  
133             }
134              
135 1         3 print {$rules_fh} "latemp_targets: "
136             . join( " ",
137 1         6 map { '$(' . uc( $_->{'id'} ) . "_TARGETS)" }
138 1         3 grep { $_->{'id'} ne "common" } @hosts )
  2         6  
139             . "\n\n";
140              
141 1         6 close($rules_fh);
142 1         989 close($file_lists_fh);
143             }
144              
145             sub _make_path
146             {
147 283     283   405 my $self = shift;
148              
149 283         371 my $host = shift;
150 283         401 my $path = shift;
151              
152 283         4431 return $host->source_dir() . "/" . $path;
153             }
154              
155              
156             sub get_initial_buckets
157             {
158 7     7 1 12 my $self = shift;
159 7         12 my $host = shift;
160              
161             return [
162             {
163             'name' => "IMAGES",
164             'filter' => sub {
165 235     235   365 my $fn = shift;
166 235   100     938 return ( $fn !~ /\.(?:tt|w)ml\z/ )
167             && ( -f $self->_make_path( $host, $fn ) );
168             },
169             },
170             {
171             'name' => "DIRS",
172             'filter' => sub {
173 132     132   292 return ( -d $self->_make_path( $host, shift ) );
174             },
175             filter_out_common => 1,
176             },
177             {
178             'name' => "DOCS",
179             'filter' => sub {
180 84     84   376 return shift =~ /\.x?html\.wml\z/;
181             },
182             'map' => sub {
183 84     84   145 my $fn = shift;
184 84         284 $fn =~ s{\.wml\z}{};
185 84         220 return $fn;
186             },
187             },
188             {
189             'name' => "TTMLS",
190             'filter' => sub {
191 0     0   0 return shift =~ /\.ttml\z/;
192             },
193             'map' => sub {
194 0     0   0 my $fn = shift;
195 0         0 $fn =~ s{\.ttml\z}{};
196 0         0 return $fn;
197             },
198             },
199 7         92 ];
200             }
201              
202             sub _identity
203             {
204 151     151   360 return shift;
205             }
206              
207             sub _process_bucket
208             {
209 28     28   47 my ( $self, $bucket ) = @_;
210             return {
211             %$bucket,
212             'results' => [],
213             (
214 28 100       154 ( !exists( $bucket->{'map'} ) )
215             ? ( 'map' => \&_identity )
216             : ()
217             ),
218             };
219             }
220              
221              
222             sub get_buckets
223             {
224 7     7 1 14 my ( $self, $host ) = @_;
225              
226 28         57 return [ map { $self->_process_bucket($_) }
227 7         12 @{ $self->get_initial_buckets($host) } ];
  7         17  
228             }
229              
230             sub _filter_out_special_files
231             {
232 7     7   19 my ( $self, $host, $files_ref ) = @_;
233              
234 7         36 my @files = @$files_ref;
235              
236 7         14 @files = ( grep { !m{(\A|/)\.svn(/|\z)} } @files );
  235         502  
237 7         15 @files = ( grep { !/~\z/ } @files );
  235         447  
238             @files = (
239             grep {
240 7         12 my $bn = basename($_);
  235         3999  
241 235   33     794 not( ( $bn =~ /\A\./ ) && ( $bn =~ /\.swp\z/ ) )
242             } @files
243             );
244              
245 7         29 return \@files;
246             }
247              
248             sub _sort_files
249             {
250 7     7   15 my ( $self, $host, $files_ref ) = @_;
251              
252 7         29 return [ sort { $a cmp $b } @$files_ref ];
  900         1253  
253             }
254              
255              
256             sub get_non_bucketed_files
257             {
258 7     7 1 14 my ( $self, $host ) = @_;
259              
260 7         15 my $source_dir_path = $host->source_dir();
261              
262 7         40 my $files = [ File::Find::Rule->in($source_dir_path) ];
263              
264 7         15443 s!^$source_dir_path/!! for @$files;
265 7         21 $files = [ grep { $_ ne $source_dir_path } @$files ];
  242         421  
266              
267 7         23 $files = $self->_filter_out_special_files( $host, $files );
268              
269 7         21 return $self->_sort_files( $host, $files );
270             }
271              
272              
273             sub place_files_into_buckets
274             {
275 7     7 1 15 my ( $self, $host, $files, $buckets ) = @_;
276              
277             FILE_LOOP:
278 7         15 foreach my $f (@$files)
279             {
280 235         463 foreach my $bucket (@$buckets)
281             {
282 451 100       935 if ( $bucket->{'filter'}->($f) )
283             {
284 235 100       715 if ( $host->{'id'} eq "common" )
285             {
286 1         8 $self->_common_buckets->{ $bucket->{name} }->{$f} = 1;
287             }
288              
289 235 50 66     932 if (
      66        
290             ( $host->{'id'} eq "common" )
291             || (
292             !(
293             $bucket->{'filter_out_common'} && exists(
294             $self->_common_buckets->{ $bucket->{name} }
295             ->{$f}
296             )
297             )
298             )
299             )
300             {
301 235         385 push @{ $bucket->{'results'} }, $bucket->{'map'}->($f);
  235         547  
302             }
303              
304 235         546 next FILE_LOOP;
305             }
306             }
307 0         0 die HTML::Latemp::GenMakeHelpers::Error::UncategorizedFile->new(
308             {
309             'file' => $f,
310             'host' => $host->id(),
311             }
312             );
313             }
314             }
315              
316              
317             sub get_rules_template
318             {
319 6     6 1 13 my ( $self, $host ) = @_;
320              
321 6         11 my $h_dest_star = "\$(X8X_DEST)/%";
322 6         8 my $wml_path =
323             qq{WML_LATEMP_PATH="\$\$(perl -MFile::Spec -e 'print File::Spec->rel2abs(shift)' '\$\@')"};
324 6         14 my $dest_dir = $host->dest_dir();
325 6         12 my $source_dir_path = $host->source_dir();
326 6         13 my $out_docs_ext = $self->_out_docs_ext;
327              
328 6         10 my ( $common_cmd, $no_common_cmd );
329 6 100       16 if ( my $cb = $self->_docs_build_command_cb )
330             {
331 2         11 $common_cmd = $cb->( $self, { host => $host, is_common => 1, } );
332 2         28 $no_common_cmd = $cb->( $self, { host => $host, is_common => '', } );
333             }
334             else
335             {
336 4         11 $common_cmd =
337             qq#$wml_path ; ( cd \$(COMMON_SRC_DIR) && wml -o "\$\${WML_LATEMP_PATH}" \$(X8X_WML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %${out_docs_ext},%,\$@)) \$(patsubst \$(COMMON_SRC_DIR)/%,%,\$<) )#;
338 4         12 $no_common_cmd =
339             qq#$wml_path ; ( cd \$(X8X_SRC_DIR) && wml -o "\$\${WML_LATEMP_PATH}" \$(X8X_WML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %${out_docs_ext},%,\$@)) \$(patsubst \$(X8X_SRC_DIR)/%,%,\$<) )#;
340             }
341 6         19 my ( $common_images_dest, $no_common_images_dest );
342 6 100       19 if ( my $cb = $self->_images_dest_varname_cb )
343             {
344 1         3 $common_images_dest =
345             $cb->( $self, { host => $host, is_common => 1, } );
346 1         10 $no_common_images_dest =
347             $cb->( $self, { host => $host, is_common => '', } );
348             }
349             else
350             {
351 5         8 $no_common_images_dest = $common_images_dest = 'X8X_DEST';
352             }
353 6         17 my $ci_h_dest_star = "\$($common_images_dest)/%";
354 6         12 my $nci_h_dest_star = "\$($no_common_images_dest)/%";
355 6         60 return <<"EOF";
356              
357             X8X_SRC_DIR := $source_dir_path
358              
359             X8X_DEST := $dest_dir
360              
361             X8X_WML_FLAGS := \$(WML_FLAGS) -DLATEMP_SERVER=x8x
362              
363             X8X_TTML_FLAGS := \$(TTML_FLAGS) -DLATEMP_SERVER=x8x
364              
365             X8X_DOCS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_DOCS))
366              
367             X8X_DIRS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_DIRS))
368              
369             X8X_IMAGES_DEST := \$(patsubst %,\$($no_common_images_dest)/%,\$(X8X_IMAGES))
370              
371             X8X_TTMLS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_TTMLS))
372              
373             X8X_COMMON_IMAGES_DEST := \$(patsubst %,\$($common_images_dest)/%,\$(COMMON_IMAGES))
374              
375             X8X_COMMON_DIRS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_DIRS))
376              
377             X8X_COMMON_TTMLS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_TTMLS))
378              
379             X8X_COMMON_DOCS_DEST := \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_DOCS))
380              
381             X8X_TARGETS := \$(X8X_DEST) \$(X8X_DIRS_DEST) \$(X8X_COMMON_DIRS_DEST) \$(X8X_COMMON_IMAGES_DEST) \$(X8X_COMMON_DOCS_DEST) \$(X8X_COMMON_TTMLS_DEST) \$(X8X_IMAGES_DEST) \$(X8X_DOCS_DEST) \$(X8X_TTMLS_DEST)
382              
383             \$(X8X_DOCS_DEST) : $h_dest_star : \$(X8X_SRC_DIR)/%${out_docs_ext} \$(DOCS_COMMON_DEPS)
384             $no_common_cmd
385              
386             \$(X8X_TTMLS_DEST) : $h_dest_star : \$(X8X_SRC_DIR)/%.ttml \$(TTMLS_COMMON_DEPS)
387             ttml -o \$@ \$(X8X_TTML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.ttml,%,\$@)) \$<
388              
389             \$(X8X_DIRS_DEST) : $h_dest_star :
390             mkdir -p \$@
391             touch \$@
392              
393             \$(X8X_IMAGES_DEST) : $nci_h_dest_star : \$(X8X_SRC_DIR)/%
394             \$(call LATEMP_COPY)
395              
396             \$(X8X_COMMON_IMAGES_DEST) : $ci_h_dest_star : \$(COMMON_SRC_DIR)/%
397             \$(call LATEMP_COPY)
398              
399             \$(X8X_COMMON_TTMLS_DEST) : $h_dest_star : \$(COMMON_SRC_DIR)/%.ttml \$(TTMLS_COMMON_DEPS)
400             ttml -o \$@ \$(X8X_TTML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.ttml,%,\$@)) \$<
401              
402             \$(X8X_COMMON_DOCS_DEST) : $h_dest_star : \$(COMMON_SRC_DIR)/%${out_docs_ext} \$(DOCS_COMMON_DEPS)
403             $common_cmd
404              
405             \$(X8X_COMMON_DIRS_DEST) : $h_dest_star :
406             mkdir -p \$@
407             touch \$@
408              
409             \$(X8X_DEST):
410             mkdir -p \$@
411             touch \$@
412             EOF
413             }
414              
415              
416             sub process_host
417             {
418 7     7 1 39 my $self = shift;
419 7         12 my $host = shift;
420              
421 7         16 my $dir = $self->_base_dir();
422              
423 7         15 my $source_dir_path = $host->source_dir();
424              
425 7         10 my $file_lists_text = "";
426 7         12 my $rules_text = "";
427              
428 7         16 my $files = $self->get_non_bucketed_files($host);
429              
430 7         19 my $buckets = $self->get_buckets($host);
431              
432 7         21 $self->place_files_into_buckets( $host, $files, $buckets );
433              
434 7         18 my $id = $host->id();
435 7         15 my $host_uc = uc($id);
436 7         16 foreach my $bucket (@$buckets)
437             {
438 28         46 my $name = $bucket->{name};
439             $file_lists_text .=
440             $host_uc . "_"
441             . $name . " :="
442             . join(
443             "",
444 227         663 map { " $_" } @{
445 28         52 $self->_filename_lists_post_filter->(
446             {
447 28         104 filenames => $bucket->{'results'},
448             bucket => $name,
449             host => $id,
450             }
451             )
452             }
453             ) . "\n";
454             }
455              
456 7 100       43 if ( $id ne "common" )
457             {
458 6         13 my $rules = $self->get_rules_template($host);
459              
460 6         123 $rules =~ s!X8X!$host_uc!g;
461 6         26 $rules =~ s!x8x!$id!ge;
  12         44  
462 6         23 $rules_text .= $rules;
463             }
464              
465             return {
466 7         156 'file_lists' => $file_lists_text,
467             'rules' => $rules_text,
468             };
469             }
470              
471             1;
472              
473             __END__