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
139
140
141
142
143
144
145
146
147
148
149
150
|
package Plugin::URL_Title;
use strict;
use warnings;
use HTTP::Tiny;
use HTML::Parser;
use HTML::Entities;
use utf8;
use Encode;
use IdaliusConfig qw/assert_scalar/;
my $config;
sub configure {
my $self = shift;
my $cmdref = shift;
shift; # run_command
$config = shift;
IdaliusConfig::assert_scalar($config, $self, "url_len");
die "url_len must be positive" if $config->{url_len} <= 0;
$cmdref->($self, "title of", sub { $self->get_title_cmd(@_); });
return $self;
}
# Globals set by HTML parser, used by get_title
my $title;
my $charset = "utf8"; # charset default to utf8, if not specified in HTML
sub start_handler
{
my $tag = shift;
my $attr = shift;
my $self = shift;
if ($tag eq "title") {
# Note: NOT dtext. leave entities until after decoding text. See comment below
$self->handler(text => sub { $title = shift; }, "text");
$self->handler(end => sub { shift->eof if shift eq "title"; },
"tagname,self");
} elsif ($tag eq "meta") {
if ($attr->{charset}) {
$charset = $attr->{charset};
}
}
}
sub get_title
{
my ($what) = @_;
my $url;
# Drawn from RFC 3986Β§2
if ($what =~ /(https?:\/\/[a-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=%]+)/i) {
$url = $1;
}
return (undef, "No URL found in that string", undef) unless $url;
# FIXME add more XML-based formats that we can theoretically extract titles from
# FIXME factor out accepted formats and response match into accepted formats array
my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html, image/svg+xml'}, timeout => 3));
my $response = $http->get($url);
if (!$response->{success}) {
if ($response->{status} == 599) {
chomp $response->{content};
return (undef, undef, "Error: HTTP client: $response->{content}");
} else {
return (undef, undef, "Error: HTTP $response->{status} ($response->{reason})");
}
}
if (not $response->{headers}->{"content-type"}) {
return (undef, undef, "No content-type in reponse header, not continuing");
}
if (!($response->{headers}->{"content-type"} =~ m,(text/html|image/svg\+xml),)) {
return (undef, undef, "I don't think I can parse titles from $response->{headers}->{'content-type'} - stopping here");
}
my $html = $response->{content};
$title = "";
my $p = HTML::Parser->new(api_version => 3);
$p->handler( start => \&start_handler, "tagname,attr,self" );
$p->parse($html);
return (undef, undef, "Error parsing HTML: $!") if $!;
# Decode raw bytes from document's title
my $dc = Encode::find_encoding($charset);
return (undef, undef, "Error: Unknown encoding $charset") unless $dc;
$title = $dc->decode($title);
# Finally, collapse entities into the characters they represent. Note this
# must be done instead of pulling dtext from the HTML parser, else you can
# end up with a bad mix of encodings (see documents with wchars mixed with
# entities representing more wchars in titles)
decode_entities($title);
# Normalise and trim whitespace for tidiness
$title =~ s/\s+/ /g;
$title =~ s/(^\s+|\s+$)//g;
return (undef, undef, "Error: No title") unless $title;
my $shorturl = $url;
# remove http(s):// to avoid triggering other poorly configured bots
$shorturl =~ s,^https?://,,g;
$shorturl =~ s,/$,,g;
# truncate URL without http(s):// to configured length if needed
$shorturl = (substr $shorturl, 0, $config->{url_len}) . "β¦" if length ($shorturl) > $config->{url_len};
my $composed_title = "$title ($shorturl)";
return $composed_title;
}
sub get_title_cmd
{
my ($self, $irc, $logger, $who, $where, $ided, $rest, $no_reenter, @arguments) = @_;
my ($title, $warning, $error) = get_title($rest);
$logger->($error) if $error;
return $error if $error;
return $warning if $warning;
$no_reenter->();
return $title if $title;
}
sub on_message
{
my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_;
my ($title, $warning, $error) = get_title($what);
# Log only errors, not warnings
$logger->($error) if $error;
return $title if $title;
}
sub on_action {
on_message(@_);
}
1;
|
