aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrick Spek <p.spek@tyil.nl>2019-03-28 08:59:08 +0100
committerPatrick Spek <p.spek@tyil.nl>2019-03-28 08:59:08 +0100
commitd7c4e3a063a5b36e247494a95a77ffd6643d8029 (patch)
treecbf7eb038c21ae3f937725a0aee896cfa5fe3e2c
parent6afde6c0b7e6d1a0cf92d6e821afbd9910888eb4 (diff)
downloadApp::CPAN::UploadNotifier::IRC-d7c4e3a063a5b36e247494a95a77ffd6643d8029.tar.gz
App::CPAN::UploadNotifier::IRC-d7c4e3a063a5b36e247494a95a77ffd6643d8029.tar.bz2
Use a cpan database instead of HTTP::UserAgent
While this was the plan all along, there's been an issue opened up at GitHub confirming what I suspected: HTTP::UserAgent (and apparently every method to make a simple HTTP request) is leaking memory like crazy. This patch has been running for 10 hours in #perl6, and memory usage has stayed the same, so this should improve bot stability. Additionally, being hooked up to the cpan database, it can start doing more interesting stuff as well.
-rw-r--r--Dockerfile24
-rw-r--r--META6.json8
-rw-r--r--lib/App/CPAN/UploadAnnouncer/IRC/Database.pm619
-rw-r--r--lib/App/CPAN/UploadAnnouncer/IRC/Notify.pm636
-rw-r--r--lib/App/CPAN/UploadAnnouncer/IRC/Repositories/Module.pm620
5 files changed, 78 insertions, 29 deletions
diff --git a/Dockerfile b/Dockerfile
index cff9418..e35daee 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,13 +1,27 @@
-FROM tyil/rakudo-star:2018.10
+FROM tyil/perl6:debian-latest as install
-ENV PERL6LIB=lib
+WORKDIR /app
+
+RUN apt update && apt install -y build-essential curl git libssl-dev unzip uuid-dev
COPY META6.json META6.json
+
+RUN zef install --deps-only --/test .
+
COPY bin bin
COPY lib lib
-RUN apk add --no-cache curl git libressl-dev \
- && zef install --deps-only --/test . \
- && apk del curl git
+FROM tyil/perl6:debian-latest
+
+ENV PERL6LIB=lib
+
+WORKDIR /app
+
+RUN mkdir -p /usr/share/man/man1
+RUN mkdir -p /usr/share/man/man7
+RUN apt update && apt install -y libssl-dev postgresql-client
+
+COPY --from=install /app /app
+COPY --from=install /usr/local /usr/local
CMD [ "perl6", "bin/bot" ]
diff --git a/META6.json b/META6.json
index d7eb1f5..c13a75f 100644
--- a/META6.json
+++ b/META6.json
@@ -4,12 +4,12 @@
"Patrick Spek <p.spek@tyil.work>"
],
"depends": [
- "App::CPAN:version<0.0.2+>",
"Config",
- "DOM::Tiny",
+ "DBIish",
"IRC::Client",
"IRC::Client::Plugin::NickServ",
"IRC::TextColor",
+ "JSON::Fast",
"Terminal::ANSIColor"
],
"description": "An IRC bot to notify of new module uploads to CPAN",
@@ -26,11 +26,11 @@
"bot": "bin/bot"
},
"resources": [
-
+
],
"source-url": "",
"tags": [
-
+
],
"version": "0.0.0"
}
diff --git a/lib/App/CPAN/UploadAnnouncer/IRC/Database.pm6 b/lib/App/CPAN/UploadAnnouncer/IRC/Database.pm6
index 9cc950f..0e9e252 100644
--- a/lib/App/CPAN/UploadAnnouncer/IRC/Database.pm6
+++ b/lib/App/CPAN/UploadAnnouncer/IRC/Database.pm6
@@ -2,13 +2,26 @@
use v6.c;
-use DB::Pg;
+use DBIish;
unit module App::CPAN::UploadAnnouncer::IRC::Database;
-sub get-dbh () is export
+our $dbh;
+
+our sub dbh
{
- DB::Pg.new;
+ if (!$dbh) {
+ $dbh = DBIish.connect(
+ %*ENV<DB_DRIVER> // "Pg",
+ user => %*ENV<DB_USER> // "cpan",
+ password => %*ENV<DB_PASSWORD>,
+ database => %*ENV<DB_NAME> // "cpan",
+ host => %*ENV<DB_HOST> // "127.0.0.1",
+ port => %*ENV<DB_PORT> // 5432,
+ );
+ }
+
+ $dbh
}
=begin pod
diff --git a/lib/App/CPAN/UploadAnnouncer/IRC/Notify.pm6 b/lib/App/CPAN/UploadAnnouncer/IRC/Notify.pm6
index 6ca8eaf..beff334 100644
--- a/lib/App/CPAN/UploadAnnouncer/IRC/Notify.pm6
+++ b/lib/App/CPAN/UploadAnnouncer/IRC/Notify.pm6
@@ -2,8 +2,7 @@
use v6.c;
-use App::CPAN::Feed;
-use HTTP::UserAgent;
+use App::CPAN::UploadAnnouncer::IRC::Repositories::Module;
use IRC::Client;
use IRC::TextColor;
use JSON::Fast;
@@ -11,6 +10,8 @@ use Terminal::ANSIColor;
unit class App::CPAN::UploadAnnouncer::IRC::Notify does IRC::Client::Plugin;
+constant ModuleRepo = App::CPAN::UploadAnnouncer::IRC::Repositories::Module;
+
#| The directory to hold cache files. This directory will get created if it does
#| not exist yet.
has $.cache-dir;
@@ -45,30 +46,33 @@ method irc-connected (
$!cache-dir.mkdir;
}
- if ($last-cache.e) {
- %!last = $last-cache.slurp.&from-json if $last-cache.e;
+ $last-cache.spurt(to-json(%(
+ title => "N/A",
+ created_at => DateTime.now,
+ ))) unless $last-cache.e;
- @heralding-queue.push({
- :where($!debug-channel),
- :text("Last module (from cache) is %!last<title> (%!last<version>)")
- }) if $!debug-channel;
- }
+ %!last = $last-cache.slurp.&from-json;
+ %!last<created_at> = DateTime.new(%!last<created_at>);
+
+ @heralding-queue.push({
+ :where($!debug-channel),
+ :text("Last module (from cache) is %!last<title> (%!last<created_at>)")
+ }) if $!debug-channel;
start loop {
@heralding-queue.push({
:where($!debug-channel),
- :text("Starting update through NNTP")
+ :text("Fetching new modules from CPAN database")
}) if $!debug-channel;
my $update-start = now;
# Get an updated list of modules
- my $body = HTTP::UserAgent.new.get("https://www.nntp.perl.org/group/perl.cpan.uploads/").content;
- my @updates = $body.&parse-nntp-feed(:!perl5, :after(%!last)).flip;
+ my @updates = ModuleRepo::since(%!last<created_at>);
@heralding-queue.push({
:where($!debug-channel),
- :text("NNTP parsing took {now - $update-start}s")
+ :text("Database lookup took {now - $update-start}s")
}) if $!debug-channel;
# Set a new "last" item if there were updates
@@ -77,20 +81,20 @@ method irc-connected (
@heralding-queue.push({
:where($!debug-channel),
- :text("Saving %!last<title> (%!last<version>) to $last-cache.absolute()")
+ :text("Saving %!last<title> (%!last<created_at>) to $last-cache.absolute()")
}) if $!debug-channel;
$last-cache.spurt: %!last.&to-json;
@heralding-queue.push({
:where($!debug-channel),
- :text("Saved %!last<title> (%!last<version>) to $last-cache.absolute()")
+ :text("Saved %!last<title> (%!last<created_at>) to $last-cache.absolute()")
}) if $!debug-channel;
}
@heralding-queue.push({
:where($!debug-channel),
- :text("No (new) updates, last is %!last<title> (%!last<version>)")
+ :text("No (new) updates, last is %!last<title> (%!last<created_at>)")
}) if !@updates && $!debug-channel;
# Notify channel of updates
diff --git a/lib/App/CPAN/UploadAnnouncer/IRC/Repositories/Module.pm6 b/lib/App/CPAN/UploadAnnouncer/IRC/Repositories/Module.pm6
index 855666d..a87441d 100644
--- a/lib/App/CPAN/UploadAnnouncer/IRC/Repositories/Module.pm6
+++ b/lib/App/CPAN/UploadAnnouncer/IRC/Repositories/Module.pm6
@@ -2,8 +2,12 @@
use v6.c;
+use App::CPAN::UploadAnnouncer::IRC::Database;
+
unit module App::CPAN::UploadAnnouncer::IRC::Repositories::Module;
+constant Database = App::CPAN::UploadAnnouncer::IRC::Database;
+
#| Get a list of modules that have been added since a given DateTime.
our sub since (
#| The DateTime of the last update that was processed.
@@ -11,7 +15,21 @@ our sub since (
--> List
) {
-
+ my $sth = Database::dbh.prepare(q:to/STMT/);
+ SELECT
+ name AS title,
+ pause_id AS author,
+ version,
+ created_at
+ FROM modules
+ WHERE pause_id != ''
+ AND created_at > ?
+ ORDER BY created_at ASC
+ LIMIT 10
+ STMT
+
+ $sth.execute(~$last-update);
+ $sth.allrows(:array-of-hash).List
}
=begin pod