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(-)
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