Replace Dancer with pure Plack

Dancer doesn't give access to psgi.input without reading it all
yannk · Oct 21, 2011 · 7324bfa · 7324bfa
1 parent c789fa3
commit 7324bfa
Show file tree

Hide file tree

Showing 8 changed files with 174 additions and 136 deletions.
diff --git a/Makefile.PL b/Makefile.PL
@@ -14,7 +14,7 @@ WriteMakefile(
     PREREQ_PM => {
         'Test::More'  => 0,
         'YAML'        => 0,
-        'Dancer'      => 1.3070,
+        'Plack'       => 0,
         'MogileFS::Client' => 0,
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },

diff --git a/app.psgi b/app.psgi
@@ -1,4 +1,24 @@
 #!/usr/bin/env perl
-use Dancer;
+
+use strict;
 use MogileFS::REST;
-dance;
+
+## get the configuration for this app
+my $servers;
+if (my $cnf = $ENV{MOGILEFS_REST_SERVERS}) {
+    $servers = [  split /,/, $cnf ];
+}
+my $default_class = $ENV{MOGILEFS_REST_DEFAULT_CLASS} || "normal";
+my $largefile = defined $ENV{MOGILEFS_REST_LARGEFILE}
+              ? $ENV{MOGILEFS_REST_LARGEFILE}
+              : 1;
+
+## instantiate a new app
+my $app = MogileFS::REST->new(
+    servers => $servers,
+    default_class => $default_class,
+    largefile => $largefile,
+);
+
+## psgi run it
+$app->run();
diff --git a/config.yml b/config.yml
diff --git a/environments/development.yml b/environments/development.yml
diff --git a/environments/production.yml b/environments/production.yml
diff --git a/lib/MogileFS/REST.pm b/lib/MogileFS/REST.pm
@@ -1,33 +1,80 @@
 package MogileFS::REST;
-use Dancer ':syntax';
 use Carp;
 use HTTP::Status ':constants';
 use MogileFS::Client;
+use Plack::Request;
+use Plack::Response;
 use Data::Dumper;
 
-our $VERSION = '0.2';
+our $VERSION = '1.0.0';
 
-my $mogservers;
-if (my $cnf = $ENV{MOGILEFS_REST_SERVERS}) {
-    $mogservers = [  split /,/, $cnf ];
+## set shortcut methods to log handler
+for my $lvl (qw/debug info warn error fatal/) {
+    no strict 'refs';
+    *{$lvl} = sub {
+        my $app = shift;
+        my $log = $app->{log};
+        $log->$lvl(@_);
+    };
+}
+
+sub new {
+    my $class = shift;
+    my %opts =  @_;
+    unless ($opts{servers}) {
+        croak "servers should be specified.";
+    }
+    my $app = bless \%opts, $class;
+    if (! $app->{log}) {
+        require MogileFS::REST::DumbLogger;
+        $app->{log} = MogileFS::REST::DumbLogger->new;
+    }
+    $app->debug("Config: " . (Dumper $app));
+    return $app;
+}
+
+sub run {
+    my $app = shift;
+    return sub {
+        my $env = shift;
+        my $req = Plack::Request->new($env);
+        my $method = $req->method;
+        my $res;
+        if ($method eq 'GET' or $method eq 'HEAD') {
+            if ($req->path eq '/') {
+                $res = $app->home($req);
+            }
+            else {
+                $res = $app->get($req);
+            }
+        }
+        elsif ($method eq 'DELETE') {
+            $res = $app->delete($req);
+        }
+        elsif ($method eq 'PUT') {
+            $res = $app->put($req);
+        }
+        else {
+            $res = $app->not_found($req);
+        }
+        return $res->finalize;
+    };
 }
-$mogservers ||= config->{servers};
-my $default_mogclass = $ENV{MOGILEFS_REST_DEFAULT_CLASS} || "normal";
 
 sub get_client {
-    my ($domain) = @_;
+    my ($app, $domain) = @_;
     my $client = MogileFS::Client->new(
         domain => $domain,
-        hosts  => $mogservers,
+        hosts  => $app->{servers},
     );
     return $client;
 }
 
-debug("Mogile config: " . (Dumper [$mogservers]));
-
-get '/' => sub {
-    header('Content-Type' => 'text/plain');
-    return <<EOA
+sub home {
+    my ($app, $req) = @_;
+    my $res = $req->new_response(HTTP_OK);
+    $res->content_type('text/plain');
+    $res->body(<<EOA);
 This is a simple REST API abstraction to MogileFS, so that
 we can store and retrieve files from mogile, without having to reimplement
 a MogileFS client in different languages.
@@ -38,92 +85,99 @@ Files are hosted at:
 you can HEAD/GET/PUT/DELETE on that endpoint, please README for more details.
 
 EOA
+    return $res;
+}
 
-};
-
-get '/:domain/:key' => sub {
-    my $domain = param('domain');
-    my $key = param('key');
-    my $req = request;
+sub get {
+    my ($app, $req) = @_;
+    my ($domain, $key) = split_path($req->path);
+    $app->debug("getting: $domain:$key");
     my $can_reproxy = 0;
     my $capabilities = $req->header('X-Proxy-Capabilities');
     if ($capabilities && $capabilities =~ m{\breproxy-file\b}i) {
         $can_reproxy = 1;
     }
-    my $mogile_key = $key;
-    my $client = get_client($domain);
-    my @paths = $client->get_paths($mogile_key, { no_verify => 1 });
-    return _not_found() unless @paths;
-    header('X-Reproxy-URL' => join " ", @paths);
+    my $client = $app->get_client($domain);
+    my @paths = $client->get_paths($key, { no_verify => 1 });
+    return $app->not_found($req) unless @paths;
+    my $res = $req->new_response(HTTP_OK);
+    $res->header('X-Reproxy-URL' => join " ", @paths);
     if ($can_reproxy) {
-        status(HTTP_NO_CONTENT);
-        return '';
+        ## we can reproxy, so just send headers without any body
+        $app->debug("reproxying to " . $res->header('X-Reproxy-URL'));
+        $res->status(HTTP_NO_CONTENT);
+        return $res;
     }
-    else {
-        status(HTTP_OK);
-        header('Content-Type' => 'application/octet-stream');
-        ## should we do another request to get x-reproxy-expected-size
-        if ($req->is_head) {
-            debug("request is HEAD, returning no content");
-            header('Content-Length', 0);
-            return '';
-        }
-        my $dataref = $client->get_file_data($mogile_key);
-        return $$dataref;
+
+    $res->header('Content-Type' => 'application/octet-stream');
+
+    ## should we do another request to get x-reproxy-expected-size?
+    if ($req->method eq 'HEAD') {
+        $app->debug("request is HEAD, returning no content");
+        $res->header('Content-Length', 0);
+        return $res;
     }
-};
+    my $dataref = $client->get_file_data($key);
+    $res->body($$dataref); ## TODO fix me to pass down an handle
+    return $res;
+}
 
-del '/:domain/:key' => sub {
-    my $domain = param('domain');
-    my $key = param('key');
-    my $mogile_key = $key;
-    my $req = request;
+sub delete {
+    my ($app, $req) = @_;
 
-    my $client = get_client($domain);
-    my $rv = $client->delete($mogile_key);
+    my ($domain, $key) = split_path($req->path);
+    $app->info("deleting $domain:$key");
+    my $client = $app->get_client($domain);
+    my $rv = $client->delete($key);
     my $e = $client->errstr;
-    return _error("Couldn't delete $domain/$mogile_key: $e") unless $rv;
-    status(HTTP_NO_CONTENT);
-    return '';
-};
-
-put '/:domain/:key' => sub {
-    my $domain = param('domain');
-    my $key = param('key');
-    my $mogile_key = $key;
-
-    my $req = request;
-    my $mogclass = $req->header('X-MogileFS-Class') || $default_mogclass;
-    my $dataref = \request->body;
-
-    my $size;
-    {
-        use bytes;
-        $size = bytes::length($$dataref);
-    }
-    my $opts = { bytes => $size };
-    my $client = get_client($domain);
-    my $rv = $client->store_content($mogile_key, $mogclass, $dataref, $opts);
+    return $app->error("Couldn't delete $domain/$key: $e") unless $rv;
+    my $res = $req->new_response(HTTP_NO_CONTENT);
+    return $res;
+}
+
+sub put {
+    my ($app, $req) = @_;
+
+    my ($domain, $key) = split_path($req->path);
+    $app->info("creating $domain:$key");
+    my $mogclass = $req->header('X-MogileFS-Class') || $app->{default_class};
+
+    my $size = $req->content_length;
+    my $opts = { bytes => $size, largefile => $app->{largefile} };
+    my $data_handle = $req->input;
+    my $client = $app->get_client($domain);
+    my $rv = $client->store_file($key, $mogclass, $data_handle, $opts);
     if ($rv) {
-        status(HTTP_CREATED);
-        return '';
+        return $req->new_response(HTTP_CREATED);
     }
     else {
         my $errstr = $client->errstr;
-        error("Error is $errstr");
-        return _error("Couldn't save key '$domain/$mogile_key': $errstr");
+        $app->error("Error is $errstr");
+        return $app->error("Couldn't save key '$domain/$key': $errstr");
     }
-};
+}
+
+sub not_found {
+    my ($app, $req) = @_;
+    my $res = $req->new_response(HTTP_NOT_FOUND);
+    $res->content_type('text/plain');
+    $res->body('No such file');
+    return $res;
+}
 
-sub _not_found {
-    status(HTTP_NOT_FOUND);
-    return "Not such file";
+sub error {
+    my ($app, $req, $error) = @_;
+    my $res = $req->new_response(HTTP_INTERNAL_SERVER_ERROR);
+    $res->content_type('text/plain');
+    $res->body($error || "Server Error");
+    return $res;
 }
 
-sub _error {
-    header('Content-Type' => 'text/plain');
-    status(HTTP_INTERNAL_SERVER_ERROR);
-    return $_[0] || "Server Error"
+sub split_path {
+    my $path = shift;
+    $path =~ s{^/+}{};
+    my ($domain, $key) = split m{/}, $path, 2;
+    return ($domain, $key);
 }
 
-true;
+1;
diff --git a/lib/MogileFS/REST/DumbLogger.pm b/lib/MogileFS/REST/DumbLogger.pm
@@ -0,0 +1,16 @@
+package MogileFS::REST::DumbLogger;
+use strict;
+
+sub new {
+    return bless {}, shift();
+}
+
+for my $lvl (qw/debug info warn error fatal/) {
+    no strict 'refs';
+    *{$lvl} = sub {
+        my $logger = shift;
+        print STDERR join (" ", uc($lvl), @_), "\n";
+    };
+}
+
+1;
diff --git a/t/002_index_route.t b/t/002_index_route.t
@@ -2,10 +2,5 @@ use Test::More tests => 2;
 use strict;
 use warnings;
 
-$ENV{DANCER_ENVIRONMENT} = 'development';
-# the order is important
-use MogileFS::REST;
-use Dancer::Test;
-
 route_exists [GET => '/'], 'a route handler is defined for /';
 response_status_is ['GET' => '/'], 200, 'response status is 200 for /';