File Coverage

blib/lib/Plack/App/REST.pm
Criterion Covered Total %
statement 41 43 95.3
branch 10 12 83.3
condition 5 8 62.5
subroutine 7 7 100.0
pod 1 1 100.0
total 64 71 90.1


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