Skip to content

Commit

Permalink
Allow local_module_url_prefix to be ''
Browse files Browse the repository at this point in the history 
closes gh-17
  • Loading branch information
@rwstauner
rwstauner committed Oct 8, 2019
1 parent 0e80997 commit 1082041
Show file tree
Hide file tree
Showing 5 changed files with 43 additions and 27 deletions.
4 changes: 4 additions & 0 deletions Changes
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,10 @@ Revision history for Perl extension {{$dist->name}}

{{$NEXT}}

- Allow local_module_url_prefix to be '' [rt-129865].
- URI Escape the module name in external pod links
(introduces dependency on URI::Escape).

3.101 2018-08-06T14:32:38Z

- Ensure local_module_url_prefix defaults to current perldoc_url_prefix.
Expand Down
3 changes: 3 additions & 0 deletions dist.ini
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,9 @@ Test::EOL.trailing_whitespace = 0
match = corpus/lit-cp1252
encoding = cp1252

[Prereqs / RuntimeRequires]
URI::Escape = 0

[Prereqs / RuntimeRecommends]
HTML::Entities = 0

Expand Down
13 changes: 9 additions & 4 deletions lib/Pod/Markdown.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ package Pod::Markdown;
use Pod::Simple 3.27 (); # detected_encoding and keep_encoding bug fix
use parent qw(Pod::Simple::Methody);
use Encode ();
use URI::Escape ();

our %URL_PREFIXES = (
sco => 'http://search.cpan.org/perldoc?',
Expand Down Expand Up @@ -1224,16 +1225,20 @@ and L</markdown_fragment_format> is used (which can be customized).
sub format_perldoc_url {
my ($self, $name, $section) = @_;

my $url_prefix = defined($name)
my $url_prefix = $self->perldoc_url_prefix;
if (
defined($name)
&& $self->is_local_module($name)
&& $self->local_module_url_prefix
|| $self->perldoc_url_prefix;
&& defined($self->local_module_url_prefix)
) {
$url_prefix = $self->local_module_url_prefix;
}

my $url = '';

# If the link is to another module (external link).
if ($name) {
$url = $url_prefix . $name;
$url = $url_prefix . URI::Escape::uri_escape($name);
}

# See https://rt.cpan.org/Ticket/Display.html?id=57776
Expand Down
2 changes: 1 addition & 1 deletion t/codes.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ code 'C<c*de>', '`c*de`';

# Links tested extensively in t/links.t.
code 'L<link>', "[link](${pod_prefix}link)";
code 'L<star*>', "[star\\*](${pod_prefix}star*)";
code 'L<star*>', "[star\\*](${pod_prefix}star%2A)";

# Pod::Simple handles the E<> entirely (Pod::Markdown never sees them).
code 'E<lt>', '<';
Expand Down
48 changes: 26 additions & 22 deletions t/links.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,21 +28,21 @@ my @tests = (

# in order of L<> examples in perlpod:
['name', q<name>, qq^[name](${pod_prefix}name)^],
['other module', q<Other::Pod>, qq^[Other::Pod](${pod_prefix}Other::Pod)^],
['other module, empty text', q<|Other::Pod>, qq^[Other::Pod](${pod_prefix}Other::Pod)^],
['other module', q<Other::Pod>, qq^[Other::Pod](${pod_prefix}Other%3A%3APod)^],
['other module, empty text', q<|Other::Pod>, qq^[Other::Pod](${pod_prefix}Other%3A%3APod)^],

['other module/sec, empty text', q<|Other::Pod/sec>, qq^["sec" in Other::Pod](${pod_prefix}Other::Pod#sec)^],
['section in other module', q<Other::Pod/sec>, qq^["sec" in Other::Pod](${pod_prefix}Other::Pod#sec)^],
['other module/sec, empty text', q<|Other::Pod/sec>, qq^["sec" in Other::Pod](${pod_prefix}Other%3A%3APod#sec)^],
['section in other module', q<Other::Pod/sec>, qq^["sec" in Other::Pod](${pod_prefix}Other%3A%3APod#sec)^],
['quoted section in other doc', q<perlsyn/"For Loops">, qq^["For Loops" in perlsyn](${pod_prefix}perlsyn#For${space}Loops)^],

['section in this doc', q</sec>, qq^["sec"](#sec)^],
['quoted section in this doc', q</"sec">, qq^["sec"](#sec)^],
['/sec, empty text', q<|/sec>, qq^["sec"](#sec)^],

['other module, alternate text', q<other-pod|Other::Pod>, qq^[other-pod](${pod_prefix}Other::Pod)^],
['other module, alternate text', q<other-pod|Other::Pod>, qq^[other-pod](${pod_prefix}Other%3A%3APod)^],

['sec in other mod, alt text', q<x-sec|Other::Pod/sec>, qq^[x-sec](${pod_prefix}Other::Pod#sec)^],
['"sec" in other mod, alt text', q<x-sec|Other::Pod/"sec">, qq^[x-sec](${pod_prefix}Other::Pod#sec)^],
['sec in other mod, alt text', q<x-sec|Other::Pod/sec>, qq^[x-sec](${pod_prefix}Other%3A%3APod#sec)^],
['"sec" in other mod, alt text', q<x-sec|Other::Pod/"sec">, qq^[x-sec](${pod_prefix}Other%3A%3APod#sec)^],

['/"sec" in this doc, alt text', q<other-sec|/"sec">, qq^[other-sec](#sec)^],
['/sec in this doc, alt text', q<other-sec|/sec>, qq^[other-sec](#sec)^],
Expand All @@ -56,7 +56,7 @@ my @tests = (
["don't expand nested L's", q^perlpodspec/"About LE<lt>...E<gt> Codes"^, qq^["About L<...> Codes" in perlpodspec](${pod_prefix}perlpodspec#About${space}L<...>${space}Codes)^],

# perlpodspec examples:
['name', q<Foo::Bar>, qq^[Foo::Bar](${pod_prefix}Foo::Bar)^],
['name', q<Foo::Bar>, qq^[Foo::Bar](${pod_prefix}Foo%3A%3ABar)^],
['alt|pod/sec', q<Perlport's section on NL's|perlport/Newlines>, qq^[Perlport's section on NL's](${pod_prefix}perlport#Newlines)^],
['pod/sec', q<perlport/Newlines>, qq^["Newlines" in perlport](${pod_prefix}perlport#Newlines)^],
['man/sec', q<crontab(5)/"DESCRIPTION">, qq^["DESCRIPTION" in crontab(5)](${man_prefix}5/crontab)^],
Expand All @@ -80,7 +80,7 @@ my @tests = (

# Insert backslashes (to escape markdown).
['_underscore_', q<_underscore_>, qq^[\\_underscore\\_](${pod_prefix}_underscore_)^],
['*asterisk*', q<*asterisk*>, qq^[\\*asterisk\\*](${pod_prefix}*asterisk*)^],
['*asterisk*', q<*asterisk*>, qq^[\\*asterisk\\*](${pod_prefix}%2Aasterisk%2A)^],
['section with quotes', q<whiskey|/Say "Cheese">, qq^[whiskey](#Say${space}${quot}Cheese${quot})^],

# is there something better to do?
Expand All @@ -99,42 +99,46 @@ my @tests = (
['man alias: manny', q<crontab(1)>, qq^[crontab(1)](http://manny.local/page/1/crontab)^, man_url_prefix => 'manny'],
['man alias: man', q<crontab(1)>, qq^[crontab(1)](http://man.he.net/man1/crontab)^, man_url_prefix => 'man'],

['pod url', q<Foo::Bar>, qq^[Foo::Bar](http://localhost/pod/Foo::Bar)^, perldoc_url_prefix => 'http://localhost/pod/'],
['pod alias: sco', q<Foo::Bar>, qq^[Foo::Bar](http://search.cpan.org/perldoc?Foo::Bar)^, perldoc_url_prefix => 'sco'],
['pod alias: metacpan', q<Foo::Bar>, qq^[Foo::Bar](https://metacpan.org/pod/Foo::Bar)^, perldoc_url_prefix => 'metacpan'],
['pod alias: perldoc', q<Foo::Bar>, qq^[Foo::Bar](https://metacpan.org/pod/Foo::Bar)^, perldoc_url_prefix => 'perldoc'],
['pod url', q<Foo::Bar>, qq^[Foo::Bar](http://localhost/pod/Foo%3A%3ABar)^, perldoc_url_prefix => 'http://localhost/pod/'],
['pod alias: sco', q<Foo::Bar>, qq^[Foo::Bar](http://search.cpan.org/perldoc?Foo%3A%3ABar)^, perldoc_url_prefix => 'sco'],
['pod alias: metacpan', q<Foo::Bar>, qq^[Foo::Bar](https://metacpan.org/pod/Foo%3A%3ABar)^, perldoc_url_prefix => 'metacpan'],
['pod alias: perldoc', q<Foo::Bar>, qq^[Foo::Bar](https://metacpan.org/pod/Foo%3A%3ABar)^, perldoc_url_prefix => 'perldoc'],
);

# Local Module URLs
{
my $p = {};
#'<,'>perldo if (s/^\[|\],$//g){ $a = [map { s/^\s+|\s+$//gr } split /,/, $_, 4]; @$a > 2 and $_ = " test_link({$a->[3]}, $a->[1], $a->[2], $a->[0]);" }

test_link($p, q<Local::Foo>, qq^[Local::Foo](${pod_prefix}Local::Foo)^,
test_link($p, q<Local::Foo>, qq^[Local::Foo](${pod_prefix}Local%3A%3AFoo)^,
'Local::* defaults to perldoc');
test_link($p, q<Foo_Corp::Bar>, qq^[Foo\\_Corp::Bar](${pod_prefix}Foo_Corp::Bar)^,
test_link($p, q<Foo_Corp::Bar>, qq^[Foo\\_Corp::Bar](${pod_prefix}Foo_Corp%3A%3ABar)^,
'Foo_Corp::* defaults to perldoc');

$p->{perldoc_url_prefix} = 'perldoc://';
test_link($p, q<Local::Foo>, qq^[Local::Foo](perldoc://Local::Foo)^,
test_link($p, q<Local::Foo>, qq^[Local::Foo](perldoc://Local%3A%3AFoo)^,
'local module without custom url respects perldoc_url_prefix');

$p->{local_module_url_prefix} = 'local://';
test_link($p, q<Local::Foo>, qq^[Local::Foo](local://Local::Foo)^,
test_link($p, q<Local::Foo>, qq^[Local::Foo](local://Local%3A%3AFoo)^,
'Local::* custom url');
test_link($p, q<Foo_Corp::Bar>, qq^[Foo\\_Corp::Bar](local://Foo_Corp::Bar)^,
test_link($p, q<Foo_Corp::Bar>, qq^[Foo\\_Corp::Bar](local://Foo_Corp%3A%3ABar)^,
'Foo_Corp::* custom url');

test_link($p, q<Normal::Foo>, qq^[Normal::Foo](perldoc://Normal::Foo)^,
test_link($p, q<Normal::Foo>, qq^[Normal::Foo](perldoc://Normal%3A%3AFoo)^,
'non local module');

$p->{local_module_re} = qr/Normal/;
test_link($p, q<Normal::Foo>, qq^[Normal::Foo](local://Normal::Foo)^,
test_link($p, q<Normal::Foo>, qq^[Normal::Foo](local://Normal%3A%3AFoo)^,
'Normal::* with custom RE');
test_link($p, q<NonLocal::Foo>, qq^[NonLocal::Foo](perldoc://NonLocal::Foo)^,
test_link($p, q<NonLocal::Foo>, qq^[NonLocal::Foo](perldoc://NonLocal%3A%3AFoo)^,
'NonLocal* with custom RE');
test_link($p, q<Local::Foo>, qq^[Local::Foo](perldoc://Local::Foo)^,
test_link($p, q<Local::Foo>, qq^[Local::Foo](perldoc://Local%3A%3AFoo)^,
'even Local::* uses perldoc when custom re does not match');

$p = {local_module_url_prefix => ''};
test_link($p, q<Local::Foo::Bar>, qq^[Local::Foo::Bar](Local%3A%3AFoo%3A%3ABar)^,
'local module with empty prefix');
}

# Most of these examples were internal links
Expand Down

0 comments on commit 1082041

Please sign in to comment.