line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DTL::Fast::Filter::Urlize; |
2
|
3
|
|
|
3
|
|
1809
|
use strict; use utf8; use warnings FATAL => 'all'; |
|
3
|
|
|
3
|
|
6
|
|
|
3
|
|
|
3
|
|
70
|
|
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
17
|
|
|
3
|
|
|
|
|
68
|
|
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
103
|
|
3
|
3
|
|
|
3
|
|
12
|
use parent 'DTL::Fast::Filter'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
17
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
$DTL::Fast::FILTER_HANDLERS{'urlize'} = __PACKAGE__; |
6
|
|
|
|
|
|
|
|
7
|
3
|
|
|
3
|
|
180
|
use DTL::Fast::Utils qw(unescape); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1720
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $DOMAINS_RE = qr/com|org|net|gov|mil|biz|info|mobi|name|aero|jobs|museum|travel|ru|рф|[a-z]{2,3}/; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $URL_RE = qr |
12
|
|
|
|
|
|
|
{ |
13
|
|
|
|
|
|
|
(?:(?:http|ftp|https)\://)? # protocol |
14
|
|
|
|
|
|
|
(?:\w+\:\w+\@)? # username and password |
15
|
|
|
|
|
|
|
(?:(?:www|ftp)\.)? # domain prefixes |
16
|
|
|
|
|
|
|
(?:[-\w]+\.)+ # domain name |
17
|
|
|
|
|
|
|
(?:$DOMAINS_RE) # top level domain |
18
|
|
|
|
|
|
|
(?:\:\d{1,5})? # port number |
19
|
|
|
|
|
|
|
(?:/[-\w~._]*)*? # directories and files |
20
|
|
|
|
|
|
|
(?:\?[^\s#]+?)? # query string no spaces or sharp |
21
|
|
|
|
|
|
|
(?:\#[^\s]+?)? # anchor |
22
|
|
|
|
|
|
|
}x; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
our $EMAIL_RE = qr |
25
|
|
|
|
|
|
|
{ |
26
|
|
|
|
|
|
|
(?:[-\w_~\.]+\@) # user name |
27
|
|
|
|
|
|
|
(?:[-\w]+\.)+ # domain name |
28
|
|
|
|
|
|
|
(?:$DOMAINS_RE) # top level domain |
29
|
|
|
|
|
|
|
}x; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#@Override |
32
|
|
|
|
|
|
|
sub filter |
33
|
|
|
|
|
|
|
{ |
34
|
18
|
|
|
18
|
0
|
28
|
my $self = shift; # self |
35
|
18
|
|
|
|
|
21
|
my $filter_manager = shift; # filter_manager |
36
|
18
|
|
|
|
|
28
|
my $value = shift; # value |
37
|
18
|
|
|
|
|
22
|
shift; #context |
38
|
|
|
|
|
|
|
|
39
|
18
|
|
|
|
|
4992
|
$value =~ s |
40
|
|
|
|
|
|
|
{ |
41
|
|
|
|
|
|
|
(?:($EMAIL_RE)|($URL_RE)) |
42
|
|
|
|
|
|
|
($|\s|\.|,|!) # after link |
43
|
|
|
|
|
|
|
}{ |
44
|
20
|
|
|
|
|
57
|
$self->wrap_email($1,$3).$self->wrap_url($2,$3) |
45
|
|
|
|
|
|
|
}gxesi; |
46
|
|
|
|
|
|
|
|
47
|
18
|
|
|
|
|
118
|
$filter_manager->{'safe'} = 1; |
48
|
|
|
|
|
|
|
|
49
|
18
|
|
|
|
|
85
|
return $value; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub wrap_url |
53
|
|
|
|
|
|
|
{ |
54
|
20
|
|
|
20
|
0
|
27
|
my $self = shift; |
55
|
20
|
|
|
|
|
42
|
my $text = shift; |
56
|
20
|
100
|
|
|
|
54
|
return '' if not $text; |
57
|
18
|
|
50
|
|
|
56
|
my $appendix = shift // ''; |
58
|
|
|
|
|
|
|
|
59
|
18
|
|
|
|
|
26
|
my $uri = $text; |
60
|
18
|
100
|
|
|
|
75
|
$uri = 'http://'.$uri if |
61
|
|
|
|
|
|
|
$uri !~ m{^(http|ftp|https)://}i; |
62
|
|
|
|
|
|
|
|
63
|
18
|
|
50
|
|
|
73
|
return sprintf '%s%s' |
64
|
|
|
|
|
|
|
, $uri // 'undef' |
65
|
|
|
|
|
|
|
, DTL::Fast::html_protect(unescape($self->normalize_text($text))) |
66
|
|
|
|
|
|
|
, $appendix |
67
|
|
|
|
|
|
|
; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub wrap_email |
71
|
|
|
|
|
|
|
{ |
72
|
20
|
|
|
20
|
0
|
25
|
my $self = shift; |
73
|
20
|
|
|
|
|
40
|
my $text = shift; |
74
|
20
|
100
|
|
|
|
80
|
return '' if not $text; |
75
|
2
|
|
50
|
|
|
10
|
my $appendix = shift // ''; |
76
|
|
|
|
|
|
|
|
77
|
2
|
|
|
|
|
5
|
my $uri = $text; |
78
|
|
|
|
|
|
|
|
79
|
2
|
|
|
|
|
10
|
return sprintf '%s%s' |
80
|
|
|
|
|
|
|
, $uri |
81
|
|
|
|
|
|
|
, DTL::Fast::html_protect(unescape($self->normalize_text($text))) |
82
|
|
|
|
|
|
|
, $appendix |
83
|
|
|
|
|
|
|
; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub normalize_text |
87
|
|
|
|
|
|
|
{ |
88
|
10
|
|
|
10
|
0
|
13
|
shift; |
89
|
10
|
|
|
|
|
185
|
return shift; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |