File Coverage

blib/lib/MojoMojo/Formatter/DocBook.pm
Criterion Covered Total %
statement 25 68 36.7
branch 3 14 21.4
condition n/a
subroutine 8 9 88.8
pod 4 4 100.0
total 40 95 42.1


line stmt bran cond sub pod time code
1             package MojoMojo::Formatter::DocBook;
2              
3 27     27   94037 use strict;
  27         72  
  27         776  
4 27     27   143 use warnings;
  27         60  
  27         805  
5 27     27   530 use parent qw/MojoMojo::Formatter/;
  27         280  
  27         138  
6              
7             eval
8 27     27   4870 "use XML::LibXSLT;use XML::SAX::ParserFactory (); use XML::LibXML::Reader;";
  0         0  
  0         0  
9             my $eval_res = $@;
10 27     27   10843 use MojoMojo::Formatter::DocBook::Colorize;
  27         74  
  27         765  
11              
12             my $xsltfile =
13             "/usr/share/sgml/docbook/stylesheet/xsl/nwalsh/xhtml/docbook.xsl";
14              
15             =head2 module_loaded
16              
17             Return true if the module is loaded.
18              
19             =cut
20              
21             sub module_loaded
22             {
23 1 50   1 1 75 return 0 unless -f $xsltfile;
24 0 0       0 return $eval_res ? 0 : 1;
25             }
26              
27             my $debug = 0;
28              
29             =head1 NAME
30              
31             MojoMojo::Formatter::DocBook - format part of content as DocBook
32              
33             =head1 DESCRIPTION
34              
35             This formatter will format content between two =docbook blocks as
36             DocBook document.
37              
38             =head1 METHODS
39              
40             =head2 format_content_order
41              
42             Format order can be 1-99. The DocBook formatter runs on 10.
43              
44             =cut
45              
46 744     744 1 2187 sub format_content_order { 10 }
47              
48             =head2 format_content
49              
50             Calls the formatter. Takes a ref to the content as well as the
51             context object.
52              
53             =cut
54              
55             sub format_content
56             {
57 124     124 1 884 my ($class, $content, $c) = @_;
58              
59 124         697 my @lines = split /\n/, $$content;
60 124         295 my $dbk;
61 124         326 $$content = "";
62 124         695 my $start_re = $class->gen_re(qr/docbook/);
63 124         699 my $end_re = $class->gen_re(qr/end/);
64 124         458 foreach my $line (@lines)
65             {
66 648 50       1299 if ($dbk)
67             {
68 0 0       0 if ($line =~ m/^(.*)$end_re(.*)$/)
69             {
70 0         0 $$content .= $class->to_xhtml($dbk);
71 0         0 $dbk = "";
72             }
73 0         0 else { $dbk .= $line . "\n"; }
74             }
75             else
76             {
77 648 50       2333 if ($line =~ m/^(.*)$start_re(.*)$/)
78             {
79 0         0 $$content .= $1;
80 0         0 $dbk = " " . $2; # make it true :)
81             }
82 648         1750 else { $$content .= $line . "\n"; }
83             }
84             }
85             }
86              
87             =head2 to_xhtml <dbk>
88              
89             Takes DocBook documentation and renders it as XHTML.
90              
91             =cut
92              
93             sub to_xhtml
94             {
95 0     0 1   my ($class, $dbk) = @_;
96 0           my $result;
97              
98             # Beurk
99 0           $dbk =~ s/&/_-_amp_-_;/g;
100              
101 0           $dbk =~ s/^\s+//;
102 0           $dbk =~ s/^\n+//;
103              
104             # 1 - Mark lang
105             # <programlisting lang="..."> to <programlisting lang="...">[lang=...] code [/lang]
106 0           my $my_Handler = MojoMojo::Formatter::DocBook::Colorize->new($debug);
107 0           $my_Handler->step('marklang');
108              
109 0           my $parsersax = XML::SAX::ParserFactory->parser(Handler => $my_Handler,);
110              
111 0           my @markeddbk = eval { $parsersax->parse_string($dbk) };
  0            
112 0 0         if ($@)
113             {
114 0           return "\nDocument malformed : $@\n";
115             }
116              
117             # 2 - Transform with xslt
118 0           my $parser = XML::LibXML->new();
119 0           my $xslt = XML::LibXSLT->new();
120              
121 0           my $source = eval { $parser->parse_string("@markeddbk") };
  0            
122              
123 0 0         if ($@)
124             {
125 0           return "\nDocument malformed : line $@\n";
126             }
127              
128 0           my $style_doc = $parser->parse_file($xsltfile);
129 0           my $stylesheet = eval { $xslt->parse_stylesheet($style_doc); };
  0            
130              
131             # warn "@_" if @_;
132              
133             #return "XHTML XHTML XHTML";
134              
135             # C'est ici que l'on peut ajouter le css, LANG ...
136             # voir http://docbook.sourceforge.net/release/xsl/current/doc/html/index.html
137             # et http://www.sagehill.net/docbookxsl
138 0           my $results = $stylesheet->transform(
139             $source,
140             XML::LibXSLT::xpath_to_string(
141             'section.autolabel' => '1',
142             'chapter.autolabel' => '1',
143             'suppress.navigation' => '1',
144             'generate.toc' => '0'
145             )
146             );
147              
148 0           my $format = 0;
149              
150 0           my $string = eval { $results->toString($format); };
  0            
151              
152             # 3 - Colorize Code [lang=...] ... code ... [/lang]
153 0           $my_Handler->step('colorize');
154              
155 0           my @colorized = $parsersax->parse_string($string);
156              
157 0           $string = "@colorized";
158 0           $string =~ s/_-_amp_-_;/&/g;
159              
160             # 4 - filter
161             # To adapt to mojomojo
162             # delete <?xml version ...>, <html>,</html>,<head>,</head>,<body>,</body>
163 0           $string =~ s/^.*<body>//s;
164 0           $string =~ s/<\/body>.*<\/html>//s;
165 0           $string =~ s/<a id=\"id\d*\"><\/a>//g;
166 0           $string =~ s/clear:\sboth//g;
167              
168 0           return $string;
169             }
170              
171             =head1 SEE ALSO
172              
173             L<MojoMojo>, L<Module::Pluggable::Ordered>
174              
175             =head1 AUTHORS
176              
177             Daniel Brosseau <dab@catapulse.org>
178              
179             =head1 LICENSE
180              
181             This library is free software. You can redistribute it and/or modify
182             it under the same terms as Perl itself.
183              
184             =cut
185              
186             1;