File Coverage

blib/lib/EBook/Ishmael/CharDet/HZ.pm
Criterion Covered Total %
statement 48 64 75.0
branch 25 36 69.4
condition 4 12 33.3
subroutine 8 9 88.8
pod 0 5 0.0
total 85 126 67.4


line stmt bran cond sub pod time code
1             package EBook::Ishmael::CharDet::HZ;
2 18     18   235 use 5.016;
  18         49  
3             our $VERSION = '2.05';
4 18     18   72 use strict;
  18         22  
  18         302  
5 18     18   53 use warnings;
  18         23  
  18         728  
6              
7 18     18   64 use EBook::Ishmael::CharDet::Constants qw(:CONSTANTS);
  18         21  
  18         10529  
8              
9             my $ONE_CHAR_PROB = 0.5;
10             my $THRESHOLD = 7;
11              
12             sub new {
13              
14 23     23 0 43 my ($class) = @_;
15              
16 23         173 my $self = {
17             InCode => 0,
18             Tilde => 0,
19             Consumed => 0,
20             Codes => 0,
21             Total => 0,
22             Bad => 0,
23             };
24 23         196 return bless $self, $class;
25              
26             }
27              
28             sub take {
29              
30 8767     8767 0 10059 my ($self, $data) = @_;
31              
32 8767 50       11585 return TAKE_BAD if $self->{Bad};
33 8767 50       11245 return TAKE_MUST_BE if $self->{Codes} >= $THRESHOLD;
34              
35 8767         10293 for my $i (0 .. length($data) - 1) {
36 140252         139740 my $b = ord(substr $data, $i, 1) & 0xff;
37 140252 100       178164 if ($self->{InCode}) {
    100          
38 28 100       58 if ($self->{Tilde}) {
    100          
    100          
    50          
39 6 50       11 if ($b != ord '}') {
40 0         0 $self->{Bad} = 1;
41 0         0 return TAKE_BAD;
42             }
43 6         6 $self->{Consumed} = 0;
44 6         7 $self->{InCode} = 0;
45 6         6 $self->{Tilde} = 0;
46 6         6 $self->{Codes}++;
47 6         5 $self->{Total}++;
48 6 100       14 return TAKE_MUST_BE if $self->{Codes} >= $THRESHOLD;
49             } elsif ($b == ord '~') {
50 6 50       11 if ($self->{Consumed} % 2 != 0) {
51 0         0 $self->{Bad} = 1;
52 0         0 return TAKE_BAD;
53             }
54 6         8 $self->{Tilde} = 1;
55             } elsif ($self->{Consumed} % 2 == 0) {
56 8 50 33     20 if ($b < 0x21 or $b > 0x77) {
57 0         0 $self->{Bad} = 1;
58 0         0 return TAKE_BAD;
59             }
60 8         9 $self->{Consumed}++;
61             } elsif ($self->{Consumed} % 2 != 0) {
62 8 50 33     19 if ($b < 0x21 or $b > 0x7e) {
63 0         0 $self->{Bad} = 1;
64 0         0 return TAKE_BAD;
65             }
66 8         8 $self->{Consumed}++;
67 8         7 $self->{Codes}++;
68 8         8 $self->{Total}++;
69             }
70             } elsif ($self->{Tilde}) {
71 6 50 33     28 if ($b == ord '~' or $b == ord "\n") {
    50          
72 0         0 $self->{Total}++;
73 0         0 $self->{Tilde} = 0;
74             } elsif ($b == ord '{') {
75 6         8 $self->{Tilde} = 0;
76 6         8 $self->{InCode} = 1;
77             } else {
78 0         0 $self->{Bad} = 1;
79 0         0 return TAKE_BAD;
80             }
81             } else {
82 140218 100       141505 if ($b == ord '~') {
83 6         10 $self->{Tilde} = 1;
84             } else {
85 140212         142811 $self->{Total}++;
86             }
87             }
88             }
89              
90 8765         11005 return TAKE_OK;
91              
92             }
93              
94             sub confidence {
95              
96 17     17 0 55 my ($self) = @_;
97              
98 17 50 33     109 if ($self->{Bad} or $self->{Total} == 0) {
99 0         0 return 0;
100             }
101              
102 17 50       70 if ($self->{Codes} < 6) {
103 17         180 return 1.0 - ($ONE_CHAR_PROB ** $self->{Codes});
104             } else {
105 0         0 return 0.99;
106             }
107              
108             }
109              
110             sub bad {
111              
112 0     0 0 0 my ($self) = @_;
113              
114 0         0 return $self->{Bad};
115              
116             }
117              
118 19     19 0 104 sub encoding { 'hz' }
119              
120             1;