Look2Remove.me!

bin/look2remove.me.psgi

@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN {
+    use Cwd            ();
+    use File::Spec     ();
+    use File::Basename ();
+
+    my $root =
+      File::Spec->rel2abs(File::Basename::dirname(Cwd::realpath(__FILE__)));
+
+    unshift @INC, "$root/../lib";
+    unshift @INC, "$root/../contrib/lamework/lib";
+}
+
+use Look2RemoveMe;
+
+Look2RemoveMe->new;

lib/Look2RemoveMe.pm

@@ -0,0 +1,54 @@
+package Look2RemoveMe;
+
+use strict;
+use warnings;
+
+use base 'Lamework';
+
+use Plack::Builder;
+
+sub compile_psgi_app {
+    my $self = shift;
+
+    my $app = sub {
+        my $env = shift;
+
+        return [404, [], ['404 Not Found']];
+    };
+
+    builder {
+        enable '+Look2RemoveMe::Middleware::StaticWithRTL' => path =>
+          qr{^/uploads/},
+          root => "htdocs";
+
+        enable 'Static' => path =>
+          qr{\.(?:js|css|jpe?g|gif|png|html?|js|css|swf|ico)$},
+          root => "htdocs";
+
+        enable 'SimpleLogger', level => 'debug';
+
+        enable '+Lamework::Middleware::RoutesDispatcher';
+
+        enable '+Lamework::Middleware::ActionBuilder';
+
+        enable '+Lamework::Middleware::ViewRenderer';
+
+        $app;
+    };
+}
+
+sub setup {
+    my $self = shift;
+
+    my $routes = $self->routes;
+
+    $routes->add_route('/', name => 'root');
+    $routes->add_route('/messages', defaults => {action => 'Message'});
+    $routes->add_route('/messages/:id', defaults => {action => 'MessageShow'});
+    $routes->add_route('/images',     defaults => {action => 'Image'});
+    $routes->add_route('/images/:id', defaults => {action => 'ImageShow'});
+
+    return $routes;
+}
+
+1;

lib/Look2RemoveMe/Action/SubmitText.pm

@@ -0,0 +1,40 @@
+package Look2RemoveMe::Action::SubmitText;
+
+use strict;
+use warnings;
+
+use base 'Look2RemoveMe::Action';
+
+use Try::Tiny;
+
+use Look2RemoveMe::Text;
+
+sub run {
+    my $self = shift;
+
+    return unless $self->req->method eq 'POST';
+
+    $self->set_var(type => 'text');
+    $self->set_template('upload');
+
+    my $text = $self->req->param('text');
+
+    return $self->set_var('errors' => {text => 'Required'})
+      unless defined $text && $text ne '' && $text !~ m/^\s+$/;
+
+    try {
+        my $text = Look2RemoveMe::Text->new_from_string($text);
+
+        $self->set_template('upload_success');
+        $self->set_var(url => $self->url_for('view', id => $text->id));
+    }
+    catch {
+        my $e = $_;
+
+        die $e unless $e->isa('Look2RemoveMe::Exception');
+
+        $self->set_var('errors' => {text => $e->error});
+    };
+}
+
+1;

lib/Look2RemoveMe/Action/UploadImage.pm

@@ -0,0 +1,39 @@
+package Look2RemoveMe::Action::UploadImage;
+
+use strict;
+use warnings;
+
+use base 'Look2RemoveMe::Action';
+
+use Try::Tiny;
+
+use Look2RemoveMe::Image;
+
+sub run {
+    my $self = shift;
+
+    return unless $self->req->method eq 'POST';
+
+    $self->set_var(type => 'image');
+    $self->set_template('upload');
+
+    my $upload = $self->req->upload('image');
+
+    return $self->set_var('errors' => {image => 'Required'}) unless $upload;
+
+    try {
+        my $image = Look2RemoveMe::Image->new_from_upload($upload);
+
+        $self->set_var(url => $self->url_for('view', id => $image->id));
+        $self->set_template('upload_success');
+    }
+    catch {
+        my $e = $_;
+
+        die $e unless $e->isa('Look2RemoveMe::Exception');
+
+        $self->set_var('errors' => {image => $e->error});
+    };
+}
+
+1;

lib/Look2RemoveMe/Action/View.pm

@@ -0,0 +1,58 @@
+package Look2RemoveMe::Action::View;
+
+use strict;
+use warnings;
+
+use base 'Look2RemoveMe::Action';
+
+use Look2RemoveMe::Registry;
+use Look2RemoveMe::File;
+use Look2RemoveMe::Image;
+
+sub run {
+    my $self = shift;
+
+    my $id = $self->captures->{id};
+
+    $self->_view_text($id);
+}
+
+sub _view_text {
+    my $self = shift;
+    my ($id) = @_;
+
+    my $text = Look2RemoveMe::Text->new(id => $id);
+
+    return $self->render_not_found unless $text->exists;
+
+    my $content = $text->slurp;
+    $text->remove;
+
+    $self->set_var(text => $content);
+}
+
+sub _view_image {
+    my $self = shift;
+    my ($id) = @_;
+
+    my $image = Look2RemoveMe::Image->new(id => $id);
+
+    return $self->render_not_found unless $image->exists;
+
+    my $path = $self->_realpath_to_www($image->realpath);
+
+    $self->set_var(image => {src => $path});
+}
+
+sub _realpath_to_www {
+    my $self = shift;
+    my ($path) = @_;
+
+    my $home = Look2RemoveMe::Registry->get('home');
+    $home = File::Spec->catfile($home, 'htdocs');
+    $path =~ s{^$home}{};
+
+    return $path;
+}
+
+1;

lib/Look2RemoveMe/App/FileWithRTL.pm

@@ -0,0 +1,43 @@
+package Look2RemoveMe::App::FileWithRTL;
+
+use strict;
+use warnings;
+
+use base 'Plack::App::File';
+
+use Look2RemoveMe::File;
+use Plack::Util;
+use Plack::MIME;
+use HTTP::Date;
+
+sub serve_path {
+    my($self, $env, $file) = @_;
+
+    my $content_type = Plack::MIME->mime_type($file) || 'text/plain';
+
+    if ($content_type =~ m!^text/!) {
+        $content_type .= "; charset=" . ($self->encoding || "utf-8");
+    }
+
+    open my $fh, "<:raw", $file
+        or return $self->return_403;
+
+    my $file = Look2RemoveMe::File->new(id => '123');
+    $file->decrement_rtl;
+
+    my @stat = stat $file;
+
+    Plack::Util::set_io_path($fh, Cwd::realpath($file));
+
+    return [
+        200,
+        [
+            'Content-Type'   => $content_type,
+            'Content-Length' => $stat[7],
+            'Last-Modified'  => HTTP::Date::time2str( $stat[9] )
+        ],
+        $fh,
+    ];
+}
+
+1;

lib/Look2RemoveMe/File.pm

@@ -0,0 +1,119 @@
+package Look2RemoveMe::File;
+
+use strict;
+use warnings;
+
+use Digest::MD5 ();
+use File::Spec;
+use File::Basename ();
+use File::Copy     ();
+use File::Path     ();
+
+our $ROOT;
+
+sub set_root {
+    my $class = shift;
+
+    $ROOT = File::Spec->catfile(@_);
+}
+
+sub new {
+    my $class = shift;
+
+    my $self = {@_};
+    bless $self, $class;
+
+    die 'id is required' unless defined $self->{id};
+
+    $self->{root} = $ROOT;
+
+    return $self;
+}
+
+sub new_from_path {
+    my $class = shift;
+    my ($path) = @_;
+
+    open my $file, '<', $path or die $!;
+
+    my $ctx = Digest::MD5->new;
+
+    $ctx->addfile($file);
+    $ctx->add(time);
+
+    my $id = $ctx->hexdigest;
+
+    my $self = $class->new(id => $id);
+
+    $self->_prepare_path;
+
+    File::Copy::copy($path, $self->realpath) or die $!;
+
+    return $self;
+}
+
+sub new_from_string {
+    my $class = shift;
+    my ($string) = @_;
+
+    my $ctx = Digest::MD5->new;
+
+    $ctx->add($string);
+    $ctx->add(time);
+
+    my $id = $ctx->hexdigest;
+
+    my $self = $class->new(id => $id);
+
+    $self->_prepare_path;
+
+    open my $file, '>', $self->realpath or die $!;
+
+    print $file $string;
+
+    return $self;
+}
+
+sub id { shift->{id} }
+
+sub realpath {
+    my $self = shift;
+
+    my $id = $self->{id};
+
+    my $prefix = substr($id, 0, 2);
+    my $path = substr($id, 2);
+
+    return File::Spec->catfile($self->{root}, $prefix, $path);
+}
+
+sub exists {
+    my $self = shift;
+
+    return -e $self->realpath;
+}
+
+sub slurp {
+    my $self = shift;
+
+    open my $file, '<', $self->realpath or die $!;
+
+    local $/;
+
+    return <$file>;
+}
+
+sub remove {
+    my $self = shift;
+
+    unlink $self->realpath;
+}
+
+sub _prepare_path {
+    my $self = shift;
+
+    my $directory = File::Basename::dirname($self->realpath);
+    File::Path::make_path($directory);
+}
+
+1;