File Coverage

blib/lib/Plack/App/REST.pm
Criterion Covered Total %
statement 40 42 95.2
branch 10 12 83.3
condition 5 8 62.5
subroutine 7 7 100.0
pod 1 1 100.0
total 63 70 90.0


line stmt bran cond sub pod time code
1             package Plack::App::REST;
2              
3 3     3   263727 use 5.008_005;
  3         13  
4 3     3   16 use strict;
  3         7  
  3         77  
5 3     3   15 use warnings FATAL => 'all';
  3         15  
  3         199  
6              
7             our $VERSION = '0.04'; # Set automatically by milla
8              
9 3     3   688 use parent qw( Plack::Component );
  3         320  
  3         23  
10 3     3   17199 use HTTP::Exception;
  3         30106  
  3         21  
11              
12             sub call {
13 7     7 1 99092 my($self, $env) = @_;
14              
15 7         19 my $method = $env->{REQUEST_METHOD};
16              
17             ### Throw an exception if method is not defined
18 7 100       59 if (!$self->can($method)){
19 1         10 return [405, ['Content-Type', 'text/plain'], ['Method Not Allowed']];
20             }
21              
22             ### Set params of path
23 6         22 my $id = _get_params($env);
24 6         15 $env->{'rest.ids'} = $id;
25              
26             ### Set ref to env
27 6         22 $env->{'REST.class'} = ref $self;
28              
29             # compatibility with Plack::Middleware::ParseContent
30 6 50       23 my $data = $env->{'parsecontent.data'} if exists $env->{'parsecontent.data'};
31              
32             ### Call method
33 6         14 my ($ret, $h) = eval{ $self->$method($env, $data) };
  6         27  
34              
35             ### Parse output
36 6 100       2204 if ( my $e = HTTP::Exception->caught ) {
    100          
37              
38 2         55 my @headers = ('Content-Type', 'text/plain');
39 2         9 my $code = $e->code;
40              
41 2 50 33     13 if ( $code =~ /^3/ && (my $loc = eval{$e->location}) ) {
  0         0  
42 0         0 push( @headers, Location => $loc );
43             }
44              
45 2         20 $env->{'psgi.errors'}->print( $e );
46 2         4135 return [ $code, \@headers, [$e->message] ];
47             }elsif($@){
48 1         26 $env->{'psgi.errors'}->print( $e );
49 1         14 return [ 500, ['Content-Type', 'text/plain'], [$@] ];
50             }
51            
52 3   50     92 return [200, ($h||[]), $ret];
53             }
54              
55             ### Get last requested path
56             sub _get_params {
57 6     6   12 my $env = shift;
58 6         16 my $p = $env->{PATH_INFO};
59 6 100 100     48 return if !$p or $p eq '/';
60              
61             # get param of uri
62 3         13 (my $r = $p) =~ s/\+/ /g;
63 3         24 $r =~ s/^\///g;
64              
65 3         16 my @id = split(/\//, $r);
66 3         12 return \@id;
67             }
68              
69             1;
70             __END__