File Coverage

blib/lib/Plack/Middleware/Signposting/Catmandu.pm
Criterion Covered Total %
statement 43 43 100.0
branch 7 10 70.0
condition 1 2 50.0
subroutine 10 10 100.0
pod 1 1 100.0
total 62 66 93.9


line stmt bran cond sub pod time code
1              
2             our $VERSION = '0.06';
3              
4             use Catmandu::Sane;
5 1     1   391867 use Catmandu;
  1         9  
  1         8  
6 1     1   194 use Catmandu::Fix;
  1         3  
  1         7  
7 1     1   229 use Plack::Request;
  1         3  
  1         40  
8 1     1   421 use Plack::Util::Accessor;
  1         39126  
  1         27  
9 1     1   6 use Moo;
  1         2  
  1         7  
10 1     1   21  
  1         1  
  1         6  
11             extends 'Plack::Middleware::Signposting';
12              
13             has store => (is => 'ro');
14             has bag => (is => 'ro');
15             has _bag => (is => 'lazy');
16             has fix => (is => 'ro');
17             has match_paths => (is => 'ro');
18             has _fixer => (is => 'lazy');
19              
20             my ($self) = @_;
21             Catmandu->store($self->store)->bag($self->bag);
22 2     2   20 }
23 2         10  
24             my ($self) = @_;
25             Catmandu::Fix->new(fixes => [$self->fix]);
26             }
27 2     2   16  
28 2         21 my ($self, $env) = @_;
29              
30             my $request = Plack::Request->new($env);
31             my $res = $self->app->($env);
32 8     8 1 155468  
33             my $bag = $self->_bag;
34 8         38 my $fixer = $self->_fixer;
35 8         77  
36             # only get/head requests
37 8         1849 return $res unless $request->method =~ m{^get|head$}i;
38 8         228  
39             my $id;
40             my $match_paths = $self->match_paths;
41 8 50       1485 foreach my $p (@$match_paths) {
42             if ($request->path =~ /$p/) {
43 8         58 $id = $1;
44 8         16 last;
45 8         16 }
46 11 100       60 }
47 3         46  
48 3         5 return $res unless $id;
49              
50             # see http://search.cpan.org/~miyagawa/Plack-1.0044/lib/Plack/Middleware.pm#RESPONSE_CALLBACK
51             return $self->response_cb($res, sub {
52 8 100       99 my $res = shift;
53              
54             # ignore streaming response for now
55             return unless ref $res->[2] eq 'ARRAY';
56 3     3   44  
57             my $data = $bag->get($id) || return;
58              
59 3 50       11 $fixer->fix($data);
60              
61 3   50     54 # add information to the 'Link' header
62             if ($data->{signs}) {
63 3         220 Plack::Util::header_push(
64             $res->[1],
65             'Link' => $self->to_link_format( @{$data->{signs}} )
66 3 50       1292 );
67             }
68             });
69 3         6 }
  3         14  
70              
71             1;
72 3         19  
73              
74             =encoding utf-8
75              
76             =head1 NAME
77              
78             Plack::Middleware::Signposting::Catmandu - A Signposting implementation from a Catmandu store
79              
80             =head1 SYNOPSIS
81              
82             builder {
83             enable "Plack::Middleware::Signposting::Catmandu",
84             store => 'library',
85             bag => 'books',
86             fix => 'signs.fix', #optional
87             match_paths => ['publication/(\w+)/*', 'record/(\w+)/*'],
88             ;
89              
90             # ...
91             };
92              
93             =head1 SEE ALSO
94              
95             L<Plack::Middleware>, L<Catmandu>
96              
97             =cut