File Coverage

blib/lib/EBook/Ishmael/EBook/FictionBook2.pm
Criterion Covered Total %
statement 137 159 86.1
branch 47 78 60.2
condition 5 8 62.5
subroutine 19 19 100.0
pod 0 9 0.0
total 208 273 76.1


line stmt bran cond sub pod time code
1             package EBook::Ishmael::EBook::FictionBook2;
2 17     17   337 use 5.016;
  17         64  
3             our $VERSION = '2.03';
4 17     17   91 use strict;
  17         33  
  17         405  
5 17     17   65 use warnings;
  17         31  
  17         1022  
6              
7 17     17   91 use File::Spec;
  17         29  
  17         463  
8 17     17   8415 use MIME::Base64;
  17         14168  
  17         1334  
9              
10 17     17   116 use XML::LibXML;
  17         31  
  17         137  
11              
12 17     17   3242 use EBook::Ishmael::ImageID qw(mimetype_id);
  17         34  
  17         800  
13 17     17   84 use EBook::Ishmael::EBook::Metadata;
  17         31  
  17         401  
14 17     17   69 use EBook::Ishmael::Time qw(guess_time);
  17         26  
  17         33766  
15              
16             my $NS = "http://www.gribuser.ru/xml/fictionbook/2.0";
17              
18             sub heuristic {
19              
20 104     104 0 271 my $class = shift;
21 104         224 my $file = shift;
22 104         192 my $fh = shift;
23              
24 104 100       436 return 1 if $file =~ /\.fb2$/;
25 93 100       2111 return 0 unless -T $fh;
26              
27 35         112 read $fh, my ($head), 1024;
28              
29 35         579 return $head =~ /<\s*FictionBook[^<>]+xmlns\s*=\s*"\Q$NS\E"[^<>]*>/;
30              
31             }
32              
33             sub _read_metadata {
34              
35 10     10   16 my $self = shift;
36              
37 10         107 my $ns = $self->{_dom}->documentElement->namespaceURI;
38              
39 10         42 my $xpc = XML::LibXML::XPathContext->new($self->{_dom});
40 10         322 $xpc->registerNs('FictionBook', $ns);
41              
42 10 50       37 my ($desc) = $xpc->findnodes(
43             '/FictionBook:FictionBook' .
44             '/FictionBook:description'
45             ) or return 1;
46              
47 10         378 my ($title) = $xpc->findnodes('./FictionBook:title-info', $desc);
48 10         269 my ($doc) = $xpc->findnodes('./FictionBook:document-info', $desc);
49 10         235 my ($publish) = $xpc->findnodes('./FictionBook:publish-info', $desc);
50              
51 10 50       225 if (defined $title) {
52 10         36 for my $n ($title->childNodes) {
53 110         546 my $name = $n->nodeName;
54 110 100 66     415 if ($name eq 'genre') {
    100          
    100          
    100          
    50          
55 10         57 $self->{Metadata}->add_genre($n->textContent);
56             } elsif ($name eq 'author') {
57             $self->{Metadata}->add_author(
58 10         43 join(' ', grep { /\S/ } map { $_->textContent } $n->childNodes)
  20         88  
  20         106  
59             );
60             } elsif ($name eq 'book-title') {
61 10         43 $self->{Metadata}->set_title($n->textContent);
62             } elsif ($name eq 'lang' or $name eq 'src-lang') {
63 10         51 $self->{Metadata}->add_language($n->textContent);
64             } elsif ($name eq 'translator') {
65 0         0 $self->{Metadata}->add_contributor($n->textContent);
66             }
67             }
68             }
69              
70 10 50       35 if (defined $doc) {
71 10         304 for my $n ($doc->childNodes) {
72 110         432 my $name = $n->nodeName;
73 110 100       347 if ($name eq 'author') {
    100          
    100          
    100          
    100          
    50          
74             $self->{Metadata}->add_contributor(
75 10         21 join(' ', grep { /\S/ } map { $_->textContent } $n->childNodes)
  20         65  
  20         108  
76             );
77             } elsif ($name eq 'program-used') {
78 10         38 $self->{Metadata}->set_software($n->textContent);
79             } elsif ($name eq 'date') {
80 10         16 my $t = eval { guess_time($n->textContent) };
  10         45  
81 10 50       549 if (defined $t) {
82 10         39 $self->{Metadata}->set_created($t);
83             }
84             } elsif ($name eq 'id') {
85 10         85 $self->{Metadata}->set_id($n->textContent);
86             } elsif ($name eq 'version') {
87 10         51 $self->{Metadata}->set_format("FictionBook2 " . $n->textContent);
88             } elsif ($name eq 'src-ocr') {
89 0         0 $self->{Metadata}->add_author($n->textContent);
90             }
91             }
92             }
93              
94 10 50       75 if (defined $publish) {
95 10         438 for my $n ($publish->childNodes) {
96 30         141 my $name = $n->nodeName;
97 30 50 66     123 if ($name eq 'year' and not defined $self->{Metadata}->created) {
    50          
    50          
98 0         0 my $t = eval { guess_time($n->textContent) };
  0         0  
99 0 0       0 if (defined $t) {
100 0         0 $self->{Metadata}->set_created($t);
101             }
102             } elsif ($name eq 'publisher') {
103 0         0 $self->{Metadata}->add_contributor($n->textContent);
104             } elsif ($name eq 'book-name') {
105 0         0 $self->{Metadata}->set_title($n->textContent);
106             }
107             }
108             }
109              
110 10         24 for my $n ($xpc->findnodes('/FictionBook:FictionBook/FictionBook:binary')) {
111 10         657 my $mime = $n->getAttribute('content-type');
112 10 50       113 next if not defined $mime;
113 10         33 my $format = mimetype_id($mime);
114 10 50       37 next if not defined $format;
115 10         18 push @{ $self->{_images} }, [ $n, $format ];
  10         41  
116             }
117              
118 10         26 my ($covmeta) = $xpc->findnodes('./FictionBook:coverpage', $title);
119             # Put if code inside own block so we can easily last out of it.
120 10 50       377 if (defined $covmeta) {{
121 10 50       17 my ($img) = $xpc->findnodes('./FictionBook:image', $covmeta)
  10         18  
122             or last;
123 10 50       264 my $href = $img->getAttribute('l:href') or last;
124 10         127 $href =~ s/^#//;
125 10 50       31 my ($binary) = $xpc->findnodes(
126             "/FictionBook:FictionBook/FictionBook:binary[\@id=\"$href\"]"
127             ) or last;
128 10         387 my $mime = $binary->getAttribute('content-type');
129 10 50       91 last if not defined $mime;
130 10         24 my $format = mimetype_id($mime);
131 10 50       22 last if not defined $format;
132 10         39 $self->{_cover} = [ $binary, $format ];
133             }}
134              
135 10         99 return 1;
136              
137             }
138              
139             sub new {
140              
141 10     10 0 15 my $class = shift;
142 10         19 my $file = shift;
143 10         14 my $enc = shift;
144 10   50     20 my $net = shift // 1;
145              
146 10         59 my $self = {
147             Source => undef,
148             Metadata => EBook::Ishmael::EBook::Metadata->new,
149             Network => $net,
150             _dom => undef,
151             _cover => undef,
152             _images => [],
153             };
154              
155 10         19 bless $self, $class;
156              
157 10         299 $self->{Source} = File::Spec->rel2abs($file);
158              
159             $self->{_dom} = XML::LibXML->load_xml(
160             location => $file,
161             no_network => !$self->{Network},
162 10         71 );
163              
164 10         10988 $self->_read_metadata;
165              
166 10 50       357 if (not defined $self->{Metadata}->format) {
167 0         0 $self->{Metadata}->set_format('FictionBook2');
168             }
169              
170 10         31 return $self;
171              
172             }
173              
174             sub html {
175              
176 3     3 0 12 my $self = shift;
177 3         6 my $out = shift;
178              
179 3         35 my $ns = $self->{_dom}->documentElement->namespaceURI;
180              
181 3         11 my $xpc = XML::LibXML::XPathContext->new($self->{_dom});
182 3         105 $xpc->registerNs('FictionBook', $ns);
183              
184 3 50       13 my @bodies = $xpc->findnodes(
185             '/FictionBook:FictionBook' .
186             '/FictionBook:body'
187             ) or die "Invalid FictionBook2 file $self->{Source}\n";
188              
189             my $html = join '',
190 9         1041 map { $_->toString }
191 3         134 map { $_->childNodes }
  3         11  
192             @bodies;
193              
194 3 50       20 if (defined $out) {
195 0 0       0 open my $fh, '>', $out
196             or die "Failed to open $out for writing: $!\n";
197 0         0 binmode $fh, ':utf8';
198 0         0 print { $fh } $html;
  0         0  
199 0         0 close $fh;
200 0         0 return $out;
201             } else {
202 3         58 return $html;
203             }
204              
205             }
206              
207             sub raw {
208              
209 2     2 0 5 my $self = shift;
210 2         3 my $out = shift;
211              
212 2         24 my $ns = $self->{_dom}->documentElement->namespaceURI;
213              
214 2         6 my $xpc = XML::LibXML::XPathContext->new($self->{_dom});
215 2         39 $xpc->registerNs('FictionBook', $ns);
216              
217 2 50       7 my @bodies = $xpc->findnodes(
218             '/FictionBook:FictionBook' .
219             '/FictionBook:body'
220             ) or die "Invalid FictionBook2 file $self->{Source}\n";
221              
222 2         62 my $raw = join '', map { $_->textContent } @bodies;
  2         113  
223              
224 2 50       8 if (defined $out) {
225 0 0       0 open my $fh, '>', $out
226             or die "Failed to open $out for writing: $!\n";
227 0         0 binmode $fh, ':utf8';
228 0         0 print { $fh } $raw;
  0         0  
229 0         0 close $fh;
230 0         0 return $out;
231             } else {
232 2         5 return $raw;
233             }
234              
235             }
236              
237             sub metadata {
238              
239 4     4 0 1804 my $self = shift;
240              
241 4         16 return $self->{Metadata};
242              
243             }
244              
245             sub has_cover {
246              
247 4     4 0 2151 my $self = shift;
248              
249 4         17 return defined $self->{_cover};
250              
251             }
252              
253             sub cover {
254              
255 2     2 0 4 my $self = shift;
256              
257 2 50       9 return (undef, undef) unless $self->has_cover;
258 2         296 my $bin = decode_base64($self->{_cover}[0]->textContent);
259 2         18 return ($bin, $self->{_cover}[1]);
260              
261             }
262              
263             sub image_num {
264              
265 4     4 0 5117 my $self = shift;
266              
267 4         7 return scalar @{ $self->{_images} };
  4         26  
268              
269             }
270              
271             sub image {
272              
273 2     2 0 6 my $self = shift;
274 2         3 my $n = shift;
275              
276 2 50       8 if ($n >= $self->image_num) {
277 0         0 return (undef, undef);
278             }
279              
280 2         370 my $img = decode_base64($self->{_images}[$n][0]->textContent);
281 2         22 return ($img, $self->{_images}[$n][1]);
282              
283             }
284              
285             1;