From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ZOUL / Text-FindLinks-0.04 / lib / Text / FindLinks.pm 

            

              
1
—
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
—
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
—
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
—
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
—
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138

              
package Text::FindLinks;
=encoding utf8
=head1 NAME
Text::FindLinks - Find and markup URLs in plain text
=cut
use warnings;
use strict;
use Exporter;
use Params::Validate qw/validate CODEREF/;
our @ISA = 'Exporter';
our @EXPORT_OK = qw/find_links markup_links/;
our $VERSION = '0.04';
=head1 SYNOPSIS
    use Text::FindLinks 'markup_links';
    my $text = "Have you seen www.foo.com yet?";
    # Have you seen <a href="http://www.foo.com">http://www.foo.com</a> yet?
    print markup_links(text => $text);
=head1 FUNCTIONS
=head2 markup_links(text => ..., [handler => sub { ... }])
Finds all URLs in the given text and replaces them using
the given handler. The handler gets passed three arguments:
the URL itself, all the text to the left from it and all the
text to the right. (The context is passed in case you would
like to keep some URLs untouched.) If no handler is given,
the default handler will be used that simply creates a link
to the URL and skips URLs already turned into links.
=cut
sub markup_links
{
    validate(@_,
    {
        text    => 1,
        handler =>
        {
            type     => CODEREF,
            optional => 1,
        },
    });
    my %args = @_;
    my $text = $args{'text'};
    my $decorator = $args{'handler'} || \&decorate_link;
    $text =~ s{(
        (
            (((https?)|(ftp))://)   # either a schema...
            | (www\.)               # or the ‘www’ token
        )
        [^\s<]+                     # anything except whitespace and ‘<’
        (?<![,.;?!])                # must not end with given characters
        )}
        {&$decorator($1, $`, $')}gex;
    return $text;
}
=head2 find_links(text => ...)
Returns an array with all the URLs found in given text.
Just a simple wrapper around C<markup_links>, see the
sources.
=cut
sub find_links
{
    validate(@_, { text => 1 });
    my %args = @_;
    my @links;
    markup_links(
        text    => $args{'text'},
        handler => sub { push @links, shift });
    return @links;
}
=head2 decorate_link($url, $left, $right)
Default URL handler that will be used if you don’t pass your
own to the C<markup_links> sub using the C<handler> attribute.
It turns an URL into a HTML link and skips URLs that are
apparently already links. Not exported.
=cut
sub decorate_link
{
    my ($url, $left, $right) = @_;
    # Skip already marked links.
    return $url if ($left =~ /href=["']$/);
    return $url if ($right =~ qr|^</a>|);
    my $label = $url;
    $url = "http://$url" if ($url =~ /^www/i);
    return qq|<a href="$url">$label</a>|;
}
=head1 BUGS
The algorithm is extremely naive, a simple regex. It is almost
certain that some URLs will not be recognized and some things
that are not URLs will (to keep the balance). I’d be glad to
hear if there is some URL that misbehaves.
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-FindLinks>
=head1 AUTHOR
Tomáš Znamenáček, zoul@fleuron.cz
L<http://github.com/zoul/Text-FindLinks>
=head1 COPYRIGHT & LICENSE
Copyright 2009 Tomáš Znamenáček
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See L<http://dev.perl.org/licenses/> for more information.
=cut
1;