File Coverage

blib/lib/App/XML/DocBook/Docmake.pm
Criterion Covered Total %
statement 152 189 80.4
branch 37 56 66.0
condition 14 20 70.0
subroutine 33 41 80.4
pod 2 2 100.0
total 238 308 77.2


line stmt bran cond sub pod time code
1             package App::XML::DocBook::Docmake;
2             $App::XML::DocBook::Docmake::VERSION = '0.1004';
3 1     1   102380 use 5.014;
  1         13  
4 1     1   7 use strict;
  1         1  
  1         32  
5 1     1   6 use warnings;
  1         2  
  1         44  
6              
7 1     1   630 use Getopt::Long qw/ GetOptionsFromArray /;
  1         9073  
  1         4  
8 1     1   186 use File::Path qw/ mkpath /;
  1         2  
  1         67  
9 1     1   610 use Pod::Usage qw/ pod2usage /;
  1         42923  
  1         107  
10              
11 1     1   633 use File::ShouldUpdate v0.2.0 qw/ should_update_multi /;
  1         2264  
  1         61  
12              
13 1     1   432 use App::XML::DocBook::Docmake::CmdComponent ();
  1         3  
  1         39  
14              
15              
16             use Class::XSAccessor {
17 1         7 accessors => [
18             qw(
19             _base_path
20             _has_output
21             _input_path
22             _make_like
23             _mode
24             _output_path
25             _stylesheet
26             _trailing_slash
27             _verbose
28             _real_mode
29             _xslt_mode
30             _xslt_stringparams
31             )
32             ]
33 1     1   8 };
  1         1  
34              
35             use Test::Trap
36 1     1   529 qw( trap $trap :flow:stderr(systemsafe):stdout(systemsafe):warn );
  1         2  
  1         10  
37              
38              
39             my %modes = (
40             'fo' => {},
41             'help' => {
42             standalone => 1,
43             },
44             'manpages' => {},
45             'xhtml' => {},
46             'xhtml-1_1' => {
47             real_mode => "xhtml",
48             },
49             'xhtml5' => {
50             real_mode => "xhtml",
51             },
52             'rtf' => {
53             xslt_mode => "fo",
54             },
55             'pdf' => {
56             xslt_mode => "fo",
57             },
58             );
59              
60             sub new
61             {
62 12     12 1 10545 my $class = shift;
63 12         17 my $self = {};
64              
65 12         26 bless $self, $class;
66              
67 12         41 $self->_init(@_);
68              
69 12         33 return $self;
70             }
71              
72             sub _calc_modes_hash
73             {
74 12     12   23 my ( $self, ) = @_;
75              
76 12         34 return \%modes;
77             }
78              
79             sub _lookup_mode_struct
80             {
81 12     12   27 my ( $self, $mode ) = @_;
82              
83 12         37 return $self->_calc_modes_hash()->{$mode};
84             }
85              
86             sub _init
87             {
88 12     12   25 my ( $self, $args ) = @_;
89              
90 12         18 my $argv = $args->{'argv'};
91              
92 12         16 my $output_path;
93 12         20 my $verbose = 0;
94 12         26 my $stylesheet;
95             my @in_stringparams;
96 12         0 my $base_path;
97 12         15 my $make_like = 0;
98 12         16 my ( $help, $man );
99 12         16 my $trailing_slash = 1;
100              
101 12         53 my $ret = GetOptionsFromArray(
102             $argv,
103             "o=s" => \$output_path,
104             "v|verbose" => \$verbose,
105             "x|stylesheet=s" => \$stylesheet,
106             "stringparam=s" => \@in_stringparams,
107             "basepath=s" => \$base_path,
108             "make" => \$make_like,
109             'help|h' => \$help,
110             'man' => \$man,
111             'trailing-slash=i' => \$trailing_slash,
112             );
113              
114 12 50       9571 if ( !$ret )
115             {
116 0         0 pod2usage(2);
117             }
118 12 50       28 if ($help)
119             {
120 0         0 pod2usage(1);
121             }
122 12 50       26 if ($man)
123             {
124 0         0 pod2usage( -exitstatus => 0, -verbose => 2 );
125             }
126              
127 12         14 my @stringparams;
128 12         27 foreach my $param (@in_stringparams)
129             {
130 6 50       31 if ( $param =~ m{\A([^=]+)=(.*)\z}ms )
131             {
132 6         27 push @stringparams, [ $1, $2 ];
133             }
134             else
135             {
136 0         0 die "Wrong stringparam argument '$param'! Does not contain a '='!";
137             }
138             }
139              
140 12 100       72 $self->_has_output( $self->_output_path($output_path) ? 1 : 0 );
141              
142 12         26 $self->_verbose($verbose);
143 12         21 $self->_stylesheet($stylesheet);
144 12         31 $self->_xslt_stringparams( \@stringparams );
145 12         29 $self->_make_like($make_like);
146 12         25 $self->_base_path($base_path);
147 12         33 $self->_trailing_slash($trailing_slash);
148              
149 12         21 my $mode = shift(@$argv);
150              
151 12         33 my $mode_struct = $self->_lookup_mode_struct($mode);
152              
153 12 50       26 if ($mode_struct)
154             {
155 12         28 $self->_mode($mode);
156              
157             my $assign_secondary_mode = sub {
158 24     24   34 my ( $struct_field, $attr ) = @_;
159 24   66     197 $self->$attr( $mode_struct->{$struct_field} || $mode );
160 12         43 };
161              
162 12         31 $assign_secondary_mode->( 'real_mode', '_real_mode' );
163 12         27 $assign_secondary_mode->( 'xslt_mode', '_xslt_mode' );
164             }
165             else
166             {
167 0         0 die "Unknown mode \"$mode\"";
168             }
169              
170 12         24 my $input_path = shift(@$argv);
171              
172 12 50 66     39 if ( !( defined($input_path) || $mode_struct->{standalone} ) )
173             {
174 0         0 die "Input path not specified on command line";
175             }
176             else
177             {
178 12         30 $self->_input_path($input_path);
179             }
180              
181 12         25 return;
182             }
183              
184              
185             sub _exec_command
186             {
187 0     0   0 my ( $self, $args ) = @_;
188              
189 0         0 my $cmd = $args->{cmd};
190              
191 0 0       0 if ( $self->_verbose() )
192             {
193 0         0 print( join( " ", @$cmd ), "\n" );
194             }
195              
196 0         0 my $exit_code;
197             trap
198             {
199 0     0   0 local $ENV{LC_ALL} = "C.utf-8";
200 0         0 $exit_code = system(@$cmd);
201 0         0 };
202              
203 0         0 my $stderr = $trap->stderr();
204              
205 0 0 0     0 if ( not( defined($exit_code) and ( !$exit_code ) ) )
206             {
207 0 0       0 if ( $stderr =~ m#Attempt to load network entity# )
208             {
209 0 0       0 if ( $args->{xsltproc} )
210             {
211 0         0 die <<"EOF";
212             Running xsltproc failed due to lacking local DocBook 5/XSL stylesheets and data.
213             See: https://github.com/shlomif/fortune-mod/issues/45 and
214             https://github.com/docbook/wiki/wiki/DocBookXslStylesheets
215              
216             Command was <<@$cmd>>;
217             EOF
218             }
219             }
220 0         0 die qq/$stderr\n<<@$cmd>> failed./;
221             }
222              
223 0         0 return 0;
224             }
225              
226             sub run
227             {
228 11     11 1 5865 my $self = shift;
229              
230 11         33 my $real_mode = $self->_real_mode();
231              
232 11         32 my $mode_func = '_run_mode_' . $self->_real_mode;
233              
234 11         47 return $self->$mode_func(@_);
235             }
236              
237             sub _run_mode_help
238             {
239 1     1   2 my $self = shift;
240              
241 1         73 print <<"EOF";
242             Docmake version $App::XML::DocBook::Docmake::VERSION
243             A tool to convert DocBook/XML to other formats
244              
245             Available commands:
246              
247             help - this help screen.
248              
249             fo - convert to XSL-FO.
250             manpages - convert to Unix manpage (nroff)
251             rtf - convert to RTF (MS Word).
252             pdf - convert to PDF (Adobe Acrobat).
253             xhtml - convert to XHTML.
254             xhtml-1_1 - convert to XHTML-1.1.
255             xhtml5 - convert to XHTML5
256             EOF
257             }
258              
259             sub _is_older
260             {
261 0     0   0 my ( $self, $result_fn, $source_fn ) = @_;
262              
263 0         0 return should_update_multi( [ $result_fn, ], ':', [ $source_fn, ] );
264             }
265              
266             sub _should_update_output
267             {
268 0     0   0 my ( $self, $args ) = @_;
269              
270 0         0 return $self->_is_older( $args->{output}, $args->{input} );
271             }
272              
273             sub _run_mode_fo
274             {
275 0     0   0 my $self = shift;
276 0         0 return $self->_run_xslt();
277             }
278              
279             sub _mkdir
280             {
281 0     0   0 my ( $self, $dir ) = @_;
282              
283 0         0 mkpath($dir);
284              
285 0         0 return;
286             }
287              
288             sub _run_mode_manpages
289             {
290 0     0   0 my $self = shift;
291              
292             # Create the directory, because xsltproc requires it.
293 0 0       0 if ( $self->_trailing_slash )
294             {
295             # die "don't add trailing_slash";
296              
297             # $self->_mkdir( $self->_output_path() );
298             }
299              
300 0         0 return $self->_run_xslt();
301             }
302              
303             sub _run_mode_xhtml
304             {
305 6     6   11 my $self = shift;
306              
307             # Create the directory, because xsltproc requires it.
308 6 100       20 if ( $self->_trailing_slash )
309             {
310 5         16 $self->_mkdir( $self->_output_path() );
311             }
312              
313 6         22 return $self->_run_xslt();
314             }
315              
316             sub _calc_default_xslt_stylesheet
317             {
318 9     9   17 my $self = shift;
319              
320 9         22 my $mode = $self->_xslt_mode();
321              
322             return
323 9         28 "http://docbook.sourceforge.net/release/xsl/current/${mode}/docbook.xsl";
324             }
325              
326             sub _is_xhtml
327             {
328 24     24   30 my $self = shift;
329              
330 24   100     114 return ( ( $self->_mode() eq "xhtml" )
331             || ( $self->_mode() eq "xhtml-1_1" )
332             || ( $self->_mode() eq "xhtml5" ) );
333             }
334              
335             sub _calc_output_param_for_xslt
336             {
337 16     16   25 my ( $self, $args ) = @_;
338              
339 16         35 my $output_path = $self->_output_path();
340 16 100       35 if ( defined( $args->{output_path} ) )
341             {
342 6         11 $output_path = $args->{output_path};
343             }
344              
345 16 50       30 if ( !defined($output_path) )
346             {
347 0         0 die "Output path not specified!";
348             }
349              
350             # If it's XHTML, then it's a directory and xsltproc requires that
351             # it will have a trailing slash.
352 16 100       32 if ( $self->_is_xhtml )
353             {
354 10 100       22 if ( $self->_trailing_slash )
355             {
356 8 50       20 if ( $output_path !~ m{/\z} )
357             {
358 8         12 $output_path .= "/";
359             }
360             }
361             }
362              
363 16         57 return $output_path;
364             }
365              
366             sub _calc_make_output_param_for_xslt
367             {
368 8     8   15 my ( $self, $args ) = @_;
369              
370 8         12 my $output_path = $self->_calc_output_param_for_xslt($args);
371              
372             # If it's XHTML, then we need to compare against the index.html
373             # because the directory is freshly made.
374 8 100       14 if ( $self->_is_xhtml )
375             {
376 5         10 $output_path .= "index.html";
377             }
378              
379 8         26 return $output_path;
380             }
381              
382             sub _pre_proc_command
383             {
384 10     10   332 my ( $self, $args ) = @_;
385              
386 10         18 my $input_fn = $args->{input};
387 10         17 my $output_fn = $args->{output};
388 10         14 my $template = $args->{template};
389 10   50     21 my $xsltproc = ( $args->{xsltproc} // ( die "no xsltproc key" ) );
390              
391             return +{
392             xsltproc => $xsltproc,
393             cmd => [
394             map {
395 10         14 ( ref($_) eq '' ) ? $_
396             : $_->is_output() ? $output_fn
397             : $_->is_input() ? $input_fn
398              
399             # Not supposed to happen
400 74 50       195 : do { die "Unknown Argument in Command Template."; }
  0 100       0  
    100          
401             } @$template
402             ]
403             };
404             }
405              
406             sub _run_input_output_cmd
407             {
408 12     12   22 my ( $self, $args ) = @_;
409              
410 12         23 my $input_fn = $args->{input};
411 12         14 my $output_fn = $args->{output};
412 12   100     30 my $make_output_fn = $args->{make_output} // $output_fn;
413              
414 12 100 100     45 if (
415             ( !$self->_make_like() )
416             || $self->_should_update_output(
417             {
418             input => $input_fn,
419             output => $make_output_fn,
420             }
421             )
422             )
423             {
424 10         56 $self->_exec_command( $self->_pre_proc_command($args), );
425             }
426             }
427              
428             sub _on_output
429             {
430 18     18   35 my ( $self, $meth, $args ) = @_;
431              
432 18 100       59 return $self->_has_output() ? $self->$meth($args) : ();
433             }
434              
435             sub _calc_output_params
436             {
437 8     8   16 my ( $self, $args ) = @_;
438              
439             return (
440 8         21 output => $self->_calc_output_param_for_xslt($args),
441             make_output => $self->_calc_make_output_param_for_xslt($args),
442             );
443             }
444              
445             sub _calc_template_o_flag
446             {
447 8     8   12 my ( $self, $args ) = @_;
448              
449 8         26 return ( "-o", $self->_output_cmd_comp() );
450             }
451              
452             sub _calc_template_string_params
453             {
454 9     9   18 my ($self) = @_;
455              
456 6         41 return [ map { ( "--stringparam", @$_ ) }
457 9         13 @{ $self->_xslt_stringparams() } ];
  9         28  
458             }
459              
460             sub _run_xslt
461             {
462 9     9   22 my ( $self, $args ) = @_;
463              
464 9         25 my @stylesheet_params = ( $self->_calc_default_xslt_stylesheet() );
465              
466 9 100       41 if ( defined( $self->_stylesheet() ) )
467             {
468 1         43 @stylesheet_params = ( $self->_stylesheet() );
469             }
470              
471 9         15 my @base_path_params;
472              
473 9 100       24 if ( defined( $self->_base_path() ) )
474             {
475 1         7 @base_path_params =
476             ( "--path", ( $self->_base_path() . '/' . $self->_xslt_mode() ), );
477             }
478              
479             return $self->_run_input_output_cmd(
480             {
481             input => $self->_input_path(),
482             $self->_on_output( '_calc_output_params', $args ),
483             xsltproc => 1,
484             template => [
485             "xsltproc",
486             "--nonet",
487             $self->_on_output( '_calc_template_o_flag', $args ),
488 9         35 @{ $self->_calc_template_string_params() },
  9         18  
489             @base_path_params,
490             @stylesheet_params,
491             $self->_input_cmd_comp(),
492             ],
493             },
494             );
495             }
496              
497             sub _run_xslt_and_from_fo
498             {
499 4     4   8 my ( $self, $args ) = @_;
500              
501 4         10 my $xslt_output_path = $self->_output_path();
502              
503 4 100       11 if ( !defined($xslt_output_path) )
504             {
505 1         10 die "No -o flag was specified. See the help.";
506             }
507              
508             # TODO : do something meaningful if a period (".") is not present
509 3 100       11 if ( $xslt_output_path !~ m{\.}ms )
510             {
511 1         4 $xslt_output_path .= ".fo";
512             }
513             else
514             {
515 2         39 $xslt_output_path =~ s{\.([^\.]*)\z}{\.fo}ms;
516             }
517              
518 3         25 $self->_run_xslt( { output_path => $xslt_output_path } );
519              
520             return $self->_run_input_output_cmd(
521             {
522             input => $xslt_output_path,
523             output => $self->_output_path(),
524             template => [
525 3         95 "fop", ( "-" . $args->{fo_out_format} ),
526             $self->_output_cmd_comp(), $self->_input_cmd_comp(),
527             ],
528             xsltproc => 0,
529             },
530             );
531             }
532              
533             sub _run_mode_pdf
534             {
535 4     4   8 my $self = shift;
536              
537 4         19 return $self->_run_xslt_and_from_fo(
538             {
539             fo_out_format => "pdf",
540             },
541             );
542             }
543              
544             sub _run_mode_rtf
545             {
546 0     0   0 my $self = shift;
547              
548 0         0 return $self->_run_xslt_and_from_fo(
549             {
550             fo_out_format => "rtf",
551             },
552             );
553             }
554              
555             sub _input_cmd_comp
556             {
557 12     12   19 my $self = shift;
558              
559 12         31 return App::XML::DocBook::Docmake::CmdComponent->new(
560             {
561             is_input => 1,
562             is_output => 0,
563             }
564             );
565             }
566              
567             sub _output_cmd_comp
568             {
569 11     11   18 my $self = shift;
570              
571 11         57 return App::XML::DocBook::Docmake::CmdComponent->new(
572             {
573             is_input => 0,
574             is_output => 1,
575             }
576             );
577             }
578              
579              
580             1;
581              
582             __END__