From 2ddd3376b2ca76946eab0af0d04e18adefe6d31c Mon Sep 17 00:00:00 2001
From: David Phillips <david@yeah.nah.nz>
Date: Sun, 22 Mar 2020 11:43:56 +1300
Subject: URL_Title: Add option to dump page content to log

---
 Plugin/URL_Title.pm | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

(limited to 'Plugin')

diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index d787d90..df72f02 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -8,6 +8,10 @@ use HTML::Entities;
 use utf8;
 use Encode;
 
+# For optional debug page dumping
+use IO::Compress::Gzip qw/gzip/;
+use MIME::Base64 qw/encode_base64/;
+
 use IdaliusConfig qw/assert_scalar/;
 
 my $config;
@@ -21,6 +25,9 @@ sub configure {
 	IdaliusConfig::assert_scalar($config, $self, "url_len");
 	die "url_len must be positive" if $config->{url_len} <= 0;
 
+	# debug_dump is an optional parameter to dump base64(gzip(page_data)) into
+	# the log - defaults to disabled and not checked here
+
 	$cmdref->($self, "title of", sub { $self->get_title_cmd(@_); });
 
 	return $self;
@@ -54,7 +61,7 @@ sub start_handler
 
 sub get_title
 {
-	my ($what) = @_;
+	my ($logger, $what) = @_;
 	my $url;
 
 	# Drawn from RFC 3986§2
@@ -88,6 +95,16 @@ sub get_title
 
 	my $html = $response->{content};
 
+	if ($config->{debug_dump}) {
+		my $zipped;
+		if (gzip \$html => \$zipped) {
+			my $encoded = encode_base64($zipped, "");
+			$logger->("debug_dump for $url: $encoded");
+		} else {
+			$logger->("debug_dump gzip error: $!");
+		}
+	}
+
 	$charset = undef;
 	$content_type = undef;
 	$title = undef;
@@ -143,7 +160,7 @@ sub get_title_cmd
 {
 	my ($self, $irc, $logger, $who, $where, $ided, $rest, $no_reenter, @arguments) = @_;
 
-	my ($title, $warning, $error) = get_title($rest);
+	my ($title, $warning, $error) = get_title($logger, $rest);
 	$logger->($error) if $error;
 
 	return $error if $error;
@@ -157,7 +174,7 @@ sub on_message
 {
 	my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_;
 
-	my ($title, $warning, $error) = get_title($what);
+	my ($title, $warning, $error) = get_title($logger, $what);
 
 	# Log only errors, not warnings
 	$logger->($error) if $error;
-- 
cgit v1.1