File Coverage

blib/lib/EBook/Ishmael/EBook/CBR.pm
Criterion Covered Total %
statement 21 36 58.3
branch 1 6 16.6
condition n/a
subroutine 7 10 70.0
pod 0 3 0.0
total 29 55 52.7


line stmt bran cond sub pod time code
1             package EBook::Ishmael::EBook::CBR;
2 17     17   299 use 5.016;
  17         60  
3             our $VERSION = '2.03';
4 17     17   115 use strict;
  17         46  
  17         523  
5 17     17   87 use warnings;
  17         30  
  17         1174  
6              
7 17     17   135 use parent 'EBook::Ishmael::EBook::CB';
  17         47  
  17         215  
8              
9 17     17   1446 use File::Which;
  17         32  
  17         1281  
10              
11 17     17   90 use EBook::Ishmael::ShellQuote qw(safe_qx);
  17         34  
  17         7352  
12              
13             # TODO: Create new CBR test file that uses older RAR version, so that tests
14             # on systems with older unrar's can pass.
15              
16             my $MAGIC = pack "C*", 0x52, 0x61, 0x72, 0x21, 0x1a, 0x07;
17              
18             my $UNRAR;
19             for my $b (qw(unrar UnRAR)) {
20             if (defined which($b)) {
21             $UNRAR = $b;
22             last;
23             }
24             }
25              
26             our $CAN_TEST = defined $UNRAR;
27              
28             sub heuristic {
29              
30 126     126 0 254 my $class = shift;
31 126         254 my $file = shift;
32 126         231 my $fh = shift;
33              
34 126 50       644 return 0 unless $file =~ /\.cbr$/;
35              
36 0           read $fh, my $mag, length $MAGIC;
37              
38 0           return $mag eq $MAGIC;
39              
40             }
41              
42             sub _unrar {
43              
44 0     0     my $rar = shift;
45 0           my $out = shift;
46              
47 0 0         unless (defined $UNRAR) {
48 0           die "Cannot unrar $rar; unrar not installed\n";
49             }
50              
51 0           safe_qx($UNRAR, 'x', $rar, $out);
52 0 0         unless ($? >> 8 == 0) {
53 0           die "Failed to run '$UNRAR' on $rar\n";
54             }
55              
56 0           return 1;
57              
58             }
59              
60             sub extract {
61              
62 0     0 0   my $self = shift;
63 0           my $out = shift;
64              
65 0           _unrar($self->{Source}, $out);
66              
67 0           return 1;
68              
69             }
70              
71 0     0 0   sub format { 'CBR' }
72              
73             1;