File Coverage

lib/Pod/PerldocJp/ToText.pm
Criterion Covered Total %
statement 21 79 26.5
branch 0 24 0.0
condition 0 9 0.0
subroutine 7 12 58.3
pod 0 4 0.0
total 28 128 21.8


line stmt bran cond sub pod time code
1             package Pod::PerldocJp::ToText;
2              
3 1     1   22770 use strict;
  1         1  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         22  
5 1     1   3 use base 'Pod::Perldoc::ToText';
  1         5  
  1         511  
6 1     1   34828 use Encode;
  1         1  
  1         69  
7 1     1   475 use Encode::Guess;
  1         2542  
  1         3  
8 1     1   434 use Term::Encoding;
  1         386  
  1         88  
9              
10             my $term_encoding = Term::Encoding::get_encoding() || 'utf-8';
11             my @encodings =
12             split ' ', $ENV{PERLDOCJP_ENCODINGS} || 'euc-jp shiftjis utf8';
13              
14             {
15 1     1   4 no warnings 'redefine';
  1         1  
  1         567  
16              
17             sub _decode_if_necessary {
18 0     0     my ($self, $text) = @_;
19 0 0         return $text if Encode::is_utf8($text);
20 0 0         if ($self->{encoding}) {
21 0           return decode($self->{encoding}, $text);
22             }
23 0           my $enc = guess_encoding($text, @encodings);
24 0 0 0       if (ref $enc && grep { $_ eq $enc->name } @encodings) {
  0            
25 0           $self->{encoding} = $enc->name;
26 0           return decode($self->{encoding}, $text);
27             }
28 0           return $text;
29             }
30              
31             sub Pod::Text::cmd_encoding {
32 0     0 0   my ($self, $text, $line) = @_;
33 0           ($self->{encoding}) = $text =~ /^(\S+)/;
34             }
35              
36             sub Pod::Text::preprocess_paragraph {
37 0     0 0   my $self = shift;
38 0           local $_ = shift;
39 0           $_ = _decode_if_necessary($self, $_);
40              
41 0           1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
  0            
42 0 0         $self->output_code ($_) if $self->cutting;
43 0           $_;
44             }
45              
46             sub Pod::Text::wrap {
47 0     0 0   my $self = shift;
48 0           local $_ = shift;
49 0           $_ = _decode_if_necessary($self, $_);
50              
51 0           my $output = '';
52 0           my $spaces = ' ' x $$self{MARGIN};
53 0           my $width = $$self{opt_width} - $$self{MARGIN};
54 0           my $current = 0;
55 0           my $pos = 0;
56 0           my $length = length;
57 0           while (--$length) {
58 0 0 0       if (length and ord(substr($_, $pos, 1)) > 255) {
59 0           $current++;
60             }
61 0           $current++;
62 0 0         if ($current >= $width) {
63 0 0         if (s/^([^\n]{$pos})//) {
64 0           my $got = $1;
65             # a long word divided in two
66 0 0 0       if ($got =~ /[!-~]$/ and $_ =~ /^[!-~]/) {
67             # if the whole line is a word (maybe a long url etc)
68             # take the rest of the word from the next line
69 0 0         if ($got =~ /^[!-~]+$/) {
70 0 0         if (s/^([!-~]+)//) {
71 0           $got .= $1;
72             }
73             }
74             # otherwise, move the word to the next line
75             else {
76 0 0         if ($got =~ s/([!-~]+)$//) {
77 0           $_ = $1 . $_;
78             }
79             }
80             }
81 0           s/^\s+//;
82 0           $output .= $spaces . $got . "\n";
83 0           $current = $pos = 0;
84 0           $length = length;
85             # this may happen if the whole of the next line is taken
86 0 0         last unless $length;
87 0           next;
88             }
89             else {
90 0           last;
91             }
92             }
93 0           $pos++;
94             }
95 0           $output .= $spaces . $_;
96 0           $output =~ s/\s+$/\n\n/;
97 0           return $output;
98             }
99              
100             sub Pod::Text::output {
101 0     0 0   my ($self, $text) = @_;
102              
103 0           $text = _decode_if_necessary($self, $text);
104              
105 0           $text =~ tr/\240\255/ /d;
106 0           $text = Encode::encode($term_encoding, $text, Encode::PERLQQ);
107 0           print { $$self{output_fh} } $text;
  0            
108             }
109             }
110              
111             1;
112              
113             __END__