File Coverage

blib/lib/HTML/FormatText/W3m.pm
Criterion Covered Total %
statement 29 47 61.7
branch 1 14 7.1
condition n/a
subroutine 10 12 83.3
pod 4 4 100.0
total 44 77 57.1


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2013, 2015 Kevin Ryde
2              
3             # HTML-FormatExternal is free software; you can redistribute it and/or
4             # modify it under the terms of the GNU General Public License as published
5             # by the Free Software Foundation; either version 3, or (at your option) any
6             # later version.
7             #
8             # HTML-FormatExternal is distributed in the hope that it will be useful, but
9             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
11             # for more details.
12             #
13             # You should have received a copy of the GNU General Public License along
14             # with HTML-FormatExternal. If not, see .
15              
16             package HTML::FormatText::W3m;
17 3     3   4560 use 5.006;
  3         9  
  3         121  
18 3     3   14 use strict;
  3         3  
  3         100  
19 3     3   12 use warnings;
  3         5  
  3         94  
20 3     3   1493 use URI::file;
  3         20417  
  3         81  
21 3     3   1106 use HTML::FormatExternal;
  3         10  
  3         38  
22             our @ISA = ('HTML::FormatExternal');
23              
24             our $VERSION = 24;
25              
26 3     3   188 use constant DEFAULT_LEFTMARGIN => 0;
  3         7  
  3         181  
27 3     3   15 use constant DEFAULT_RIGHTMARGIN => 80;
  3         6  
  3         1232  
28              
29             sub program_full_version {
30 6     6 1 1415 my ($self_or_class) = @_;
31 6         32 return $self_or_class->_run_version (['w3m', '-version']);
32             }
33             sub program_version {
34 2     2 1 322 my ($self_or_class) = @_;
35 2         4 my $version = $self_or_class->program_full_version;
36 2 50       6 if (! defined $version) { return undef; }
  2         67  
37              
38             # eg. "w3m version w3m/0.5.2, options lang=en,m17n,image,color,..."
39 0 0       0 $version =~ m{^w3m version (?:w3m/)?(.*?),}i
40             or $version =~ /^(.*)/; # whole first line if format not recognised
41 0         0 return $1 . substr($version,0,0); # retain taintedness
42             }
43              
44             sub _make_run {
45 0     0   0 my ($class, $input_filename, $options) = @_;
46 0         0 my @command = ('w3m', '-dump', '-T', 'text/html');
47              
48             # w3m seems to use one less than the given -cols, presumably designed with
49             # a tty in mind so "-cols 80" prints just 79 so as not to wrap around
50 0 0       0 if (defined $options->{'_width'}) {
51 0         0 push @command, '-cols', $options->{'_width'} + 1;
52             }
53              
54 0 0       0 if ($options->{'input_charset'}) {
55 0         0 push @command, '-I', $options->{'input_charset'};
56             }
57 0 0       0 if ($options->{'output_charset'}) {
58 0         0 push @command, '-O', $options->{'output_charset'};
59             }
60              
61             # 'w3m_options' not documented ...
62 0 0       0 push @command, @{$options->{'w3m_options'} || []};
  0         0  
63              
64             # w3m (circa its version 0.5.3) interprets "%" in the input
65             # filename as URI style %ff hex encodings. Turn unusual filenames
66             # like "%" into full file:// using URI::file.
67             #
68             # Filenames merely starting "-" can be given as "./-" etc to avoid
69             # them being interpreted as options. The file:// does this too.
70             #
71 0         0 push @command, URI::file->new_abs($input_filename)->as_string;
72              
73 0         0 return (\@command);
74             }
75              
76             sub new {
77 2     2 1 817 my ($class, %self) = @_;
78 2         11 return bless \%self, $class;
79             }
80             sub format {
81 0     0 1   my ($self, $html) = @_;
82 0 0         if (ref $html) { $html = $html->as_HTML; }
  0            
83 0           return $self->format_string ($html, %$self);
84             }
85              
86             1;
87             __END__