File Coverage

blib/lib/Pod/ParseLink.pm
Criterion Covered Total %
statement 50 50 100.0
branch 25 26 96.1
condition 19 24 79.1
subroutine 8 8 100.0
pod 0 1 0.0
total 102 109 93.5


line stmt bran cond sub pod time code
1             # Pod::ParseLink -- Parse an L<> formatting code in POD text.
2             #
3             # Copyright 2001, 2008, 2009, 2014 by Russ Allbery
4             #
5             # This program is free software; you may redistribute it and/or modify it
6             # under the same terms as Perl itself.
7             #
8             # This module implements parsing of the text of an L<> formatting code as
9             # defined in perlpodspec. It should be suitable for any POD formatter. It
10             # exports only one function, parselink(), which returns the five-item parse
11             # defined in perlpodspec.
12             #
13             # Perl core hackers, please note that this module is also separately
14             # maintained outside of the Perl core as part of the podlators. Please send
15             # me any patches at the address above in addition to sending them to the
16             # standard Perl mailing lists.
17              
18             ##############################################################################
19             # Modules and declarations
20             ##############################################################################
21              
22             package Pod::ParseLink;
23              
24 1     1   13501 use 5.006;
  1         3  
25 1     1   3 use strict;
  1         2  
  1         19  
26 1     1   18 use warnings;
  1         1  
  1         32  
27              
28 1     1   7 use vars qw(@EXPORT @ISA $VERSION);
  1         1  
  1         53  
29              
30 1     1   4 use Exporter;
  1         1  
  1         449  
31             @ISA = qw(Exporter);
32             @EXPORT = qw(parselink);
33              
34             $VERSION = '4.08';
35              
36             ##############################################################################
37             # Implementation
38             ##############################################################################
39              
40             # Parse the name and section portion of a link into a name and section.
41             sub _parse_section {
42 23     23   21 my ($link) = @_;
43 23         31 $link =~ s/^\s+//;
44 23         29 $link =~ s/\s+$//;
45              
46             # If the whole link is enclosed in quotes, interpret it all as a section
47             # even if it contains a slash.
48 23 100       43 return (undef, $1) if ($link =~ /^"\s*(.*?)\s*"$/);
49              
50             # Split into page and section on slash, and then clean up quoting in the
51             # section. If there is no section and the name contains spaces, also
52             # guess that it's an old section link.
53 21         55 my ($page, $section) = split (/\s*\/\s*/, $link, 2);
54 21 100       40 $section =~ s/^"\s*(.*?)\s*"$/$1/ if $section;
55 21 100 100     87 if ($page && $page =~ / / && !defined ($section)) {
      100        
56 1         2 $section = $page;
57 1         1 $page = undef;
58             } else {
59 20 100       28 $page = undef unless $page;
60 20 100       27 $section = undef unless $section;
61             }
62 21         31 return ($page, $section);
63             }
64              
65             # Infer link text from the page and section.
66             sub _infer_text {
67 17     17   16 my ($page, $section) = @_;
68 17         14 my $inferred;
69 17 100 100     130 if ($page && !$section) {
    100 66        
    50 33        
70 3         4 $inferred = $page;
71             } elsif (!$page && $section) {
72 6         9 $inferred = '"' . $section . '"';
73             } elsif ($page && $section) {
74 8         13 $inferred = '"' . $section . '" in ' . $page;
75             }
76 17         21 return $inferred;
77             }
78              
79             # Given the contents of an L<> formatting code, parse it into the link text,
80             # the possibly inferred link text, the name or URL, the section, and the type
81             # of link (pod, man, or url).
82             sub parselink {
83 27     27 0 11709 my ($link) = @_;
84 27         83 $link =~ s/\s+/ /g;
85 27         23 my $text;
86 27 100       60 if ($link =~ /\|/) {
87 8         22 ($text, $link) = split (/\|/, $link, 2);
88             }
89 27 100       48 if ($link =~ /\A\w+:[^:\s]\S*\Z/) {
90 4         3 my $inferred;
91 4 100 66     15 if (defined ($text) && length ($text) > 0) {
92 2         5 return ($text, $text, $link, undef, 'url');
93             } else {
94 2         5 return ($text, $link, $link, undef, 'url');
95             }
96             } else {
97 23         32 my ($name, $section) = _parse_section ($link);
98 23         18 my $inferred;
99 23 100 66     44 if (defined ($text) && length ($text) > 0) {
100 6         4 $inferred = $text;
101             } else {
102 17         20 $inferred = _infer_text ($name, $section);
103             }
104 23 100 100     64 my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod';
105 23         90 return ($text, $inferred, $name, $section, $type);
106             }
107             }
108              
109             ##############################################################################
110             # Module return value and documentation
111             ##############################################################################
112              
113             # Ensure we evaluate to true.
114             1;
115             __END__