#!/usr/bin/env perl use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/lib"; use Data::Dumper; use DBI; use Mojolicious::Lite; use Mojolicious::Plugin::TtRenderer; use Cache::Memcached::Fast; use POE::Filter::Reference; use IO::Compress::Gzip; use IO::Uncompress::Gunzip; plugin 'tt_renderer' => { template_options => { PRE_CHOMP => 1, POST_CHOMP => 1, TRIM => 1, }, }; app->renderer->default_handler( 'tt' ); app->renderer->paths( [ './tmpl' ] ); my $memd = new Cache::Memcached::Fast({ servers => [ { address => 'localhost:11211', weight => 2.5 }, ], 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, }); my $dbh = DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1}); # hardcode some channels first my %channels = ( "freenode#perlbot" => "#perlbot (freenode)", "freenode#perl" => "#perl (freenode)", ); sub insert_pastebin { my ($paste, $who, $what, $where) = @_; $dbh->do("INSERT INTO posts (paste, who, 'where', what, 'when') VALUES (?, ?, ?, ?, ?)", {}, $paste, $who, $where, $what, time()); my $id = $dbh->last_insert_id('', '', 'posts', 'id'); return $id; } 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 => '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 ] ); $memd->set($paste_id, $result->[0]->[0]); return $result->[0]->[0]; } } get '/' => sub { my $c = shift; $c->stash({pastedata => q{}, channels => \%channels, viewing => 0, page_tmpl => 'editor.html.tt'}); $c->render("page"); }; get '/pastebin' => sub {$_[0]->redirect_to('/')}; get '/paste' => sub {$_[0]->redirect_to('/')}; post '/paste' => sub { my $c = shift; my @args = map {($c->param($_))} qw/paste name desc chan/; my $id = insert_pastebin(@args); $c->redirect_to('/pastebin/'.$id); #$c->render(text => "post accepted! $id"); }; get '/edit/:pasteid' => sub { my $c = shift; my $pasteid = $c->param('pasteid'); my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid); if ($row->{when}) { $c->stash({pastedata => $row->{paste}, channels => \%channels, viewing => 0}); $c->stash({page_tmpl => 'editor.html.tt'}); $c->render('page'); } else { # 404 } }; get '/pastebin/:pasteid' => sub { my $c = shift; my $pasteid = $c->param('pasteid'); my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid); if ($row->{when}) { $c->stash({pastedata => $row->{paste}, channels => \%channels, viewing => 1}); $c->stash($row); $c->stash({page_tmpl => 'editor.html.tt'}); $c->render('page'); } else { # 404 } }; get '/eval/:pasteid' => sub { my ($c) = @_; my $pasteid = $c->param('pasteid'); my $row = $dbh->selectrow_hashref("SELECT * FROM posts WHERE id = ? LIMIT 1", {}, $pasteid); my $code = $row->{paste} // ''; my $output = get_eval($pasteid, $code); $c->render(json => {evalout => $output}); }; app->start;