http proxy for gridfs (psgi)

gridfs-proxy.pl

use MongoDB::Async;
use Coro;
use Coro::EV;
use MongoDB::Async::GridFS;
use Data::Dumper;
use POSIX qw(:math_h);

# (setenv "PERL5LIB" "./exlib/lib/perl5/x86_64-linux:./exlib/lib/perl5")

my $connection = MongoDB::Async::Connection->new(host => 'localhost', port => 27017);
my $database   = $connection->test; # gridfs db name
my $grid = $database->get_gridfs;

my $app = sub {
  my $env = shift;
  $env->{'psgi.streaming'} or die "This is not streaming compliant.";

  return response_bad_request() if $env->{REQUEST_URI} !~ m{\A/test/([^/.]*) }xms; # path regexp
  my $id = $1;
  my $range = $env->{HTTP_RANGE};

  return sub {
    my $responder = shift;
    eval {
      my $file = $grid->get(MongoDB::Async::OID->new(value => $id));
      if ($file) {
        if ($range =~ m{bytes=(\d*)-(\d*)}xs) {
          async_response_ranged($responder, $file, $1, $2);
        } else {
          async_response_all($responder, $file);
        }
      } else {
        async_response_not_found($responder);
      }
    };
    if ($@) {
      print STDOUT "error ".Dumper($@)."\n";
    }
  };
};



sub response_bad_request {
  return [ 400, [ 'Content-Type' => 'text/plain' ], [ "Bad Request" ] ]
}

sub async_response_not_found {
  my $responder = shift;
  $responder->([404, ['Content-Type' => 'text/plain'],["File not found"]])
}

sub async_response_all {
  my ($responder,$file) = @_;

  my $writer = $responder->([200, ['Content-Type' => $file->info->{'contentType'}]]);
  eval {
    print_grid_file_all($file, $writer);
    $writer->close();
  };
  if ($@) {
    print STDOUT "error ".Dumper($@)."\n";
  }
}

sub async_response_ranged {
  my $responder = shift;
  my $file = shift;
  my $total_length = $file->info->{"length"};
  my $begin = shift || 0;
  my $end = shift || $total_length-1;

  my $writer = $responder->([206, ['Content-Type' => $file->info->{'contentType'},
                                   'Content-Range' => "bytes $begin-$end/$total_length"]]);
  eval {
    print_grid_file_range($file, $writer, $end-$begin+1, $begin);
    $writer->close();
  };
  if ($@) {
    print STDOUT "error ".Dumper($@)."\n";
  }
}


#

sub print_grid_file_all {
    my ($grid_file, $fh) = @_;
    $grid_file->_grid->chunks->ensure_index(Tie::IxHash->new(files_id => 1, n => 1));
    my $cursor = $grid_file->_grid->chunks->query({"files_id" => $grid_file->info->{"_id"}})->sort({"n" => 1});
    while (my $chunk = $cursor->next) {
        $fh->write($chunk->{"data"});
    }
    return 0;
}

sub print_grid_file_range {
    my ($grid_file, $fh, $length, $offset) = @_;
    $offset ||= 0;
    $length ||= 0;
    my ($written, $pos) = (0, 0);
    $grid_file->_grid->chunks->ensure_index(Tie::IxHash->new(files_id => 1, n => 1));

    my $chunk_size = $grid_file->info->{'chunkSize'};
    my $begin_chunk = floor($offset / $chunk_size);
    my $begin_offset = $begin_chunk * $chunk_size;

    $offset -= $begin_offset;

    my $cursor = $grid_file->_grid->chunks->query({"files_id" => $grid_file->info->{"_id"}, "n" => {'$gte' => $begin_chunk}})->sort({"n" => 1});

    while ((my $chunk = $cursor->next) && (!$length || $written < $length)) {
        my $len = length $chunk->{'data'};

        # if we are cleanly beyond the offset
        if (!$offset || $pos >= $offset) {
            if (!$length || $written + $len < $length) {
                $fh->write($chunk->{"data"});
                $written += $len;
                $pos += $len;
            }
            else {
                $fh->write(substr($chunk->{'data'}, 0, $length-$written));
                $written += $length-$written;
                $pos += $length-$written;
            }
            next;
        }
        # if the offset goes to the middle of this chunk
        elsif ($pos + $len > $offset) {
            # if the length of this chunk is smaller than the desired length
            if (!$length || $len <= $length-$written) {
                $fh->write(substr($chunk->{'data'}, $offset-$pos, $len-($offset-$pos)));
                $written += $len-($offset-$pos);
                $pos += $len-($offset-$pos);
            }
            else {
                $fh->write(substr($chunk->{'data'}, $offset-$pos, $length));
                $written += $length;
                $pos += $length;
            }
            next;
        }
        # if the offset is larger than this chunk
        $pos += $len;
    }
    return $written;
}