Seperate out some code. Also support announcing pastes.

app.cfg

@@ -18,7 +18,7 @@ address="localhost:11211"
 weight="2.5"
 
 [evalserver]
-server="localhost:..."
+server="localhost:14400"
 languages=[ "perl" ]
 
 # Config for a non-local server.  Has a lower weight so that the local one gets checked first
@@ -27,10 +27,11 @@ languages=[ "perl" ]
 #  weight="1.0"
 
 [announce]
-endpoint="localhost:1234"
+host="localhost"
+port="1784"
 protocol="perlbot"
 
 [announce.channels]
-"freenode#perl"="Freenode #perl"
-"freenode#perlbot"="Freenode #perlbot"
-"magnet#perl"="irc.perl.net #perl"
+"localhost:perlbot:#perl"="Freenode #perl"
+"localhost:perlbot:#perlbot"="Freenode #perlbot"
+#"localhost:perlbot-magnet:#perl"="irc.perl.net #perl"

app.pl

@@ -15,7 +15,11 @@ use Encode qw/decode/;
 use Mojolicious::Lite;
 use Mojolicious::Plugin::TtRenderer;
 use POE::Filter::Reference;
-use TOML;
+
+use App::Config;
+use App::Memcached;
+use Eval::Perlbot;
+use IRC::Perlbot;
 
 plugin 'tt_renderer' => {
   template_options => {
@@ -27,47 +31,6 @@ plugin 'tt_renderer' => {
 
 app->renderer->default_handler( 'tt' );
 
-my $cfg = do {
-    my $toml = do {open(my $fh, "<", "$Bin/app.cfg"); local $/; <$fh>};
-# With error checking
-    my ($data, $err) = from_toml($toml);
-    unless ($data) {
-            die "Error parsing toml: $err";
-    }
-    $data;
-};
-
-my $memd;
-
-if ($cfg->{features}{memcached}) {
-    my $namespace = delete $cfg->{memcached}{namespace};
-    $namespace .= "_".time() if (delete $cfg->{memcached}{unique_namespace});
-
-    # Only load these if we're using them
-    require Cache::Memcached::Fast;
-    require IO::Compress::Gzip;
-    require IO::Uncompress::Gunzip;
-    $memd = Cache::Memcached::Fast->new({
-        namespace => $namespace // 'pastebin',
-        connect_timeout => 0.2,
-        io_timeout => 0.5,
-        close_on_error => 1,
-        compress_threshold => 1_000,
-        compress_ratio => 0.9,
-        compress_methods => [ \&IO::Compress::Gzip::gzip,
-                              \&IO::Uncompress::Gunzip::gunzip ],
-        max_failures => 3,
-        failure_timeout => 2,
-        ketama_points => 150,
-        nowait => 1,
-        hash_namespace => 1,
-        serialize_methods => [ \&Storable::freeze, \&Storable::thaw ],
-        utf8 => 1,
-        max_size => 512 * 1024,
-        $cfg->{memcached}->%*, # let the config overwrite anything set here if they want
-    });
-};
-
 my $dbh = DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1});
 $dbh->{sqlite_unicode} = 1;
 # hardcode some channels first
@@ -81,31 +44,6 @@ sub insert_pastebin {
     return $id;
 }
 
-sub get_eval {
-    my ($paste_id, $code) = @_;
-   
-    if ($cfg->{features}{memcached} && (my $cached = $memd->get($paste_id))) {
-        return $cached;
-    } else {
-        my $filter = POE::Filter::Reference->new();
-        my $socket = IO::Socket::INET->new(  PeerAddr => 'localhost', PeerPort => '14400' )
-            or die "error: cannot connect to eval server";
-
-        my $refs = $filter->put( [ { code => "perl $code" } ] );
-
-        print $socket $refs->[0]; 
-        my $output = do {local $/; <$socket>};
-        close $socket;
-        my $result = $filter->get( [ $output ] );
-        my $str = eval {decode("utf8", $result->[0]->[0])} // $result->[0]->[0];
-        $str = eval {decode("utf8", $str)} // $str; # I don't know why i need to decode this twice.  shurg.
-        $memd->set($paste_id, $str) if $cfg->{features}{memcached};
-
-        return $str;
-    }
-}
-
-
 get '/' => sub {
     my $c    = shift;
     $c->stash({pastedata => q{}, channels => $cfg->{announce}{channels}, page_tmpl => 'editor.html'});
@@ -122,6 +60,11 @@ post '/paste' => sub {
 
     my $id = insert_pastebin(@args);
 
+    # TODO select which one based on config
+# TODO make this use the config, or http params for the url
+    my ($channel, $who, $what, $link) = @_;
+    IRC::Perlbot::announce($c->param('chan'), $c->param('name'), $c->param('desc'), "https://perlbot.pl/pastebin/$id");
+
     $c->redirect_to('/pastebin/'.$id);
     #$c->render(text => "post accepted! $id");
 };
@@ -139,6 +82,7 @@ get '/edit/:pasteid' => sub {
         $c->render('page');
     } else {
 # 404
+        return $c->reply->not_found;
     }
 };
 
@@ -157,6 +101,7 @@ get '/pastebin/:pasteid' => sub {
         $c->render('page');
     } else {
 # 404
+        return $c->reply->not_found;
     }
 
 };

lib/App/Config.pm

@@ -0,0 +1,24 @@
+package App::Config;
+
+use strict;
+use warnings;
+
+use Exporter qw/import/;
+use Data::Dumper;
+use FindBin qw($Bin);
+
+use TOML;
+
+our @EXPORT=qw/$cfg/;
+
+our $cfg = do {
+    my $toml = do {open(my $fh, "<", "$Bin/app.cfg"); local $/; <$fh>};
+# With error checking
+    my ($data, $err) = from_toml($toml);
+    unless ($data) {
+            die "Error parsing toml: $err";
+    }
+    $data;
+};
+
+1;

lib/App/Memcached.pm

@@ -0,0 +1,53 @@
+package App::Memcached;
+
+use strict;
+use warnings;
+no warnings "experimental::postderef";
+use feature "postderef", "postderef_qq";
+
+use App::Config;
+use Exporter qw/import/;
+
+our @EXPORT = qw/$memd/;
+
+our $memd;
+
+if ($cfg->{features}{memcached}) {
+    my $namespace = delete $cfg->{memcached}{namespace};
+    $namespace .= "_".time() if (delete $cfg->{memcached}{unique_namespace});
+
+    # Only load these if we're using them
+    require Cache::Memcached::Fast;
+    require IO::Compress::Gzip;
+    require IO::Uncompress::Gunzip;
+    $memd = Cache::Memcached::Fast->new({
+        namespace => $namespace // 'pastebin',
+        connect_timeout => 0.2,
+        io_timeout => 0.5,
+        close_on_error => 1,
+        compress_threshold => 1_000,
+        compress_ratio => 0.9,
+        compress_methods => [ \&IO::Compress::Gzip::gzip,
+                              \&IO::Uncompress::Gunzip::gunzip ],
+        max_failures => 3,
+        failure_timeout => 2,
+        ketama_points => 150,
+        nowait => 1,
+        hash_namespace => 1,
+        serialize_methods => [ \&Storable::freeze, \&Storable::thaw ],
+        utf8 => 1,
+        max_size => 512 * 1024,
+        $cfg->{memcached}->%*, # let the config overwrite anything set here if they want
+    });
+} else {
+    $memd = bless {}, "App::Memcached::_mock";
+}
+
+# a mock object that does nothing but pretends to be the two functions i need
+package App::Memcached::_mock;
+
+sub get {
+}
+
+sub set {
+}

lib/Eval/Perlbot.pm

@@ -0,0 +1,38 @@
+package Eval::Perlbot;
+
+use strict;
+use warnings;
+use v5.22;
+
+use Exporter qw/import/;
+our @EXPORT=qw/get_eval/;
+
+use Encode qw/decode/;
+use POE::Filter::Reference;
+
+use App::Config;
+use App::Memcached;
+
+sub get_eval {
+    my ($paste_id, $code) = @_;
+   
+    if (my $cached = $memd->get($paste_id)) {
+        return $cached;
+    } else {
+        my $filter = POE::Filter::Reference->new();
+        my $socket = IO::Socket::INET->new(  PeerAddr => $cfg->{evalserver}{server} //'localhost', PeerPort => $cfg->{evalserver}{port} //14400 )
+            or die "error: cannot connect to eval server";
+
+        my $refs = $filter->put( [ { code => "perl $code" } ] ); # TODO make this support other langs
+
+        print $socket $refs->[0]; 
+        my $output = do {local $/; <$socket>};
+        close $socket;
+        my $result = $filter->get( [ $output ] );
+        my $str = eval {decode("utf8", $result->[0]->[0])} // $result->[0]->[0];
+        $str = eval {decode("utf8", $str)} // $str; # I don't know why i need to decode this twice.  shurg.
+        $memd->set($paste_id, $str);
+
+        return $str;
+    }
+}

lib/IRC/Perlbot.pm

@@ -0,0 +1,25 @@
+package IRC::Perlbot;
+
+use strict;
+use warnings;
+use v5.22;
+use Data::Dumper;
+
+#use Exporter qw/import/;
+#our @EXPORT=qw/get_eval/;
+
+use App::Config;
+
+sub announce {
+    my ($channel, $who, $what, $link) = @_;
+
+    print Dumper($cfg->{announce});
+
+    my $socket = IO::Socket::INET->new(  PeerAddr => $cfg->{announce}{server} //'localhost', PeerPort => $cfg->{announce}{port} //1784 )
+        or die "error: cannot connect to announce server";
+
+    print $socket "$channel\x1E$link\x1E$who\x1E$what\n";
+    close($socket);
+}
+
+1;