diff options
| author | David Phillips <david@yeah.nah.nz> | 2019-01-05 16:19:55 +1300 | 
|---|---|---|
| committer | David Phillips <david@yeah.nah.nz> | 2019-01-05 16:20:35 +1300 | 
| commit | 50d5e664e8fa21252b760bd54dd4a025d3f06585 (patch) | |
| tree | e2a8ed698038ae2fc12d75d2af39c1d723a0392a | |
| parent | 6d6c86b0cd6ad63ed0cf784de5b7faf996a699b8 (diff) | |
| download | idalius-50d5e664e8fa21252b760bd54dd4a025d3f06585.tar.xz | |
URL_Title: add direct command
| -rw-r--r-- | Plugin/URL_Title.pm | 44 | 
1 files changed, 33 insertions, 11 deletions
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index c5c10d0..19b7437 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -19,6 +19,8 @@ sub configure {  	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;  } @@ -33,16 +35,16 @@ sub start_handler  	                    "tagname,self");  } -sub on_message +sub get_title  { -	my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; +	my ($what) = @_;  	my $url;  	# Drawn from RFC 3986Β§2  	if ($what =~ /(https?:\/\/[a-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=%]+)/i) {  		$url = $1;  	} -	return unless $url; +	return (undef, "No URL found in that string") 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 @@ -51,18 +53,16 @@ sub on_message  	my $response = $http->get($url);  	if (!$response->{success}) { -		$logger->("Something broke: $response->{reason}"); -		return; +		chomp $response->{content}; +		return (undef, "Error: HTTP client: $response->{reason} ($response->{content})");  	}  	if (not $response->{headers}->{"content-type"}) { -		$logger->("No content-type in reponse header, not continuing"); -		return; +		return (undef, "No content-type in reponse header, not continuing");  	}  	if (!($response->{headers}->{"content-type"} =~ m,(text/html|image/svg\+xml),)) { -		$logger->("I don't think I can parse titles from $response->{headers}->{'content-type'} - stopping here"); -		return; +		return (undef, "I don't think I can parse titles from $response->{headers}->{'content-type'} - stopping here");  	}  	my $html = $response->{content}; @@ -72,13 +72,13 @@ sub on_message  	my $p = HTML::Parser->new(api_version => 3);  	$p->handler( start => \&start_handler, "tagname,self");  	$p->parse($html); -	$logger->("Error parsing HTML: $!") if $!; +	return (undef, "Error parsing HTML: $!") if $!;  	$title =~ s/\s+/ /g;  	$title =~ s/(^\s+|\s+$)//g;  	utf8::upgrade($title); -	return unless $title; +	return (undef, "Error: No title") unless $title;  	my $shorturl = $url;  	# remove http(s):// to avoid triggering other poorly configured bots @@ -92,6 +92,28 @@ sub on_message  	return $composed_title;  } +sub get_title_cmd +{ +	my ($self, $irc, $logger, $who, $where, $ided, $rest, @arguments) = @_; + +	my ($title, $error) = get_title($rest); +	$logger->($error) if $error; + +	return $error if $error; +	return $title if $title; + +} + +sub on_message +{ +	my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_; + +	my ($title, $error) = get_title($what); +	$logger->($error) if $error; + +	return $title if $title; +} +  sub on_action {  	on_message(@_);  }  | 
