File Coverage

blib/lib/HTML/FormatText/Links.pm
Criterion Covered Total %
statement 41 57 71.9
branch 1 14 7.1
condition 1 3 33.3
subroutine 13 14 92.8
pod 2 2 100.0
total 58 90 64.4


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::Links;
17 2     2   8686 use 5.006;
  2         4  
18 2     2   8 use strict;
  2         2  
  2         42  
19 2     2   6 use warnings;
  2         2  
  2         55  
20 2     2   435 use URI::file;
  2         9452  
  2         40  
21 2     2   607 use HTML::FormatExternal;
  2         3  
  2         15  
22             our @ISA = ('HTML::FormatExternal');
23              
24             # uncomment this to run the ### lines
25             # use Smart::Comments;
26              
27              
28             our $VERSION = 26;
29              
30 2     2   102 use constant DEFAULT_LEFTMARGIN => 3;
  2         3  
  2         113  
31 2     2   9 use constant DEFAULT_RIGHTMARGIN => 77;
  2         2  
  2         77  
32 2     2   9 use constant _WIDE_INPUT_CHARSET => 'entitize';
  2         2  
  2         105  
33 2     2   12 use constant _WIDE_OUTPUT_CHARSET => 'iso-8859-1';
  2         2  
  2         195  
34              
35             # It seems maybe some people make "links" an alias for "elinks", and the
36             # latter doesn't have -html-margin. Maybe it'd be worth adapting to use
37             # elinks style "set document.browse.margin_width=0" in that case, but for
38             # now just don't use it if it doesn't work.
39             #
40             use constant::defer _have_html_margin => sub {
41 1         397 my ($class) = @_;
42 1         5 my $help = $class->_run_version (['links', '-help']);
43 1   33     6 return (defined $help && $help =~ /-html-margin/);
44 2     2   544 };
  2         675  
  2         16  
45              
46             sub program_full_version {
47 5     5 1 1455 my ($self_or_class) = @_;
48 5         22 return $self_or_class->_run_version (['links', '-version']);
49             }
50             sub program_version {
51 2     2 1 346 my ($self_or_class) = @_;
52 2         5 my $version = $self_or_class->program_full_version;
53 2 50       6 if (! defined $version) { return undef; }
  2         5  
54              
55             # first line like "Links 1.00pre12" or "Links 2.2"
56 0 0       0 $version =~ /^Links (.*)/i
57             or $version =~ /^(.*)/; # whole first line if format not recognised
58 0         0 return $1 . substr($version,0,0); # retain taintedness
59             }
60              
61             sub _make_run {
62 0     0   0 my ($class, $input_filename, $options) = @_;
63 0         0 my @command = ('links', '-dump', '-force-html');
64              
65 0 0       0 if (defined $options->{'_width'}) {
66 0         0 push @command, '-width', $options->{'_width'};
67 0 0       0 if ($class->_have_html_margin) {
68 0         0 push @command, '-html-margin', 0;
69             }
70             }
71              
72 0 0       0 if (my $input_charset = $options->{'input_charset'}) {
73 0         0 push @command,
74             '-html-assume-codepage', _links_mung_charset ($input_charset),
75             '-html-hard-assume', 1;
76             }
77 0 0       0 if (my $output_charset = $options->{'output_charset'}) {
78 0         0 push @command, '-codepage', _links_mung_charset ($output_charset);
79             }
80              
81             # 'links_options' not documented ...
82 0 0       0 push @command, @{$options->{'links_options'} || []};
  0         0  
83              
84             # links interprets "%" in the input filename as URI style %ff hex
85             # encodings. Turn unusual filenames like "%" or "-" into full
86             # file:// using URI::file.
87 0         0 push @command, URI::file->new_abs($input_filename)->as_string;
88              
89 0         0 return (\@command);
90             }
91              
92             # links (version 2.2 at least) accepts "latin1" but not "latin-1". The
93             # latter is accepted by the other FormatExternal programs, so turn "latin-1"
94             # into "latin1" for convenience.
95             #
96             sub _links_mung_charset {
97 2     2   1599 my ($charset) = @_;
98 2         19 $charset =~ s/^(latin)-([0-9]+)$/$1$2/i;
99 2         38 return $charset;
100             }
101              
102              
103             1;
104             __END__