File Coverage

blib/lib/Amon2/Lite.pm
Criterion Covered Total %
statement 166 173 95.9
branch 29 30 96.6
condition 5 12 41.6
subroutine 31 36 86.1
pod n/a
total 231 251 92.0


line stmt bran cond sub pod time code
1             package Amon2::Lite;
2 13     13   1613669 use strict;
  13         36  
  13         453  
3 13     13   73 use warnings;
  13         29  
  13         365  
4 13     13   295 use 5.008008;
  13         51  
  13         750  
5             our $VERSION = '0.13';
6              
7 13     13   1296 use parent qw/Amon2 Amon2::Web/;
  13         402  
  13         112  
8 13     13   1435613 use Router::Simple 0.04;
  13         77889  
  13         388  
9 13     13   12165 use Text::Xslate;
  13         141952  
  13         793  
10 13     13   14035 use Text::Xslate::Bridge::TT2Like;
  13         98425  
  13         449  
11 13     13   134 use File::Spec;
  13         25  
  13         348  
12 13     13   75 use File::Basename qw(dirname);
  13         26  
  13         1187  
13 13     13   6566 use Data::Section::Simple ();
  13         3674  
  13         235  
14 13     13   75 use Amon2::Config::Simple;
  13         19  
  13         537  
15              
16             my $COUNTER;
17              
18             sub import {
19 14     14   116 my $class = shift;
20 13     13   61 no strict 'refs';
  13         24  
  13         825  
21              
22 14         112 my $router = Router::Simple->new();
23 14         126 my $caller = caller(0);
24              
25 14         51 my $base_class = 'Amon2::Lite::_child_' . $COUNTER++;
26             {
27 13     13   63 no warnings;
  13         21  
  13         22721  
  14         24  
28 14         21 unshift @{"$base_class\::ISA"}, qw/Amon2 Amon2::Web/;
  14         393  
29 14         48 unshift @{"$caller\::ISA"}, $base_class;
  14         145  
30             }
31              
32 14         75 *{"$caller\::to_app"} = sub {
33 12     12   816 my ($class, %opts) = @_;
34              
35 12         136 my $app = $class->Amon2::Web::to_app();
36 12 100       142 if (delete $opts{handle_static}) {
37 1         12 my $vpath = Data::Section::Simple->new($caller)->get_data_section();
38 1         424694 require Plack::App::File;
39 1         11302 my $orig_app = $app;
40 1         2 my $app_file_1;
41             my $app_file_2;
42 1         84 my $root1 = File::Spec->catdir( dirname((caller(0))[1]), 'static' );
43 1         38 my $root2 = File::Spec->catdir( dirname((caller(0))[1]) );
44             $app = sub {
45 4     4   47039 my $env = shift;
46 4 100 66     60 if ((my $content = $vpath->{$env->{PATH_INFO}}) && $env->{PATH_INFO} =~ m{^/}) {
    100          
    100          
47 1         8 my $ct = Plack::MIME->mime_type($env->{PATH_INFO});
48 1         21 return [200, ['Content-Type' => $ct, 'Content-Length' => length($content)], [$content]];
49             } elsif ($env->{PATH_INFO} =~ qr{^(?:/robots\.txt|/favicon\.ico)$}) {
50 1   33     16 $app_file_1 ||= Plack::App::File->new({ root => $root1 });
51 1         21 return $app_file_1->call($env);
52             } elsif ($env->{PATH_INFO} =~ m{^/static/}) {
53 1   33     25 $app_file_2 ||= Plack::App::File->new({ root => $root2 });
54 1         99 return $app_file_2->call($env);
55             } else {
56 1         6 return $orig_app->($env);
57             }
58 1         10 };
59             }
60 12 100       30 if (my @middlewares = @{"${caller}::_MIDDLEWARES"}) {
  12         114  
61 2         5 for my $middleware (@middlewares) {
62 2         6 my ($klass, $args) = @$middleware;
63 2         13 $klass = Plack::Util::load_class($klass, 'Plack::Middleware');
64 2         3543 $app = $klass->wrap($app, %$args);
65             }
66             }
67 12 100       1280 unless ($opts{no_x_content_type_options}) {
68             $class->add_trigger(AFTER_DISPATCH => sub {
69 27     27   311102 my ($c, $res) = @_;
70 27         161 $res->header( 'X-Content-Type-Options' => 'nosniff' );
71 11         189 });
72             }
73 12 100       271 unless ($opts{no_x_frame_options}) {
74             $class->add_trigger(AFTER_DISPATCH => sub {
75 27     27   1616 my ($c, $res) = @_;
76 27         103 $res->header( 'X-Frame-Options' => 'DENY' );
77 11         76 });
78             }
79 12         193 return $app;
80 14         110 };
81              
82 14         92 *{"${base_class}::enable_middleware"} = sub {
83 2     2   98 my ($class, $klass, %args) = @_;
84 2         4 push @{"${caller}::_MIDDLEWARES"}, [$klass, \%args];
  2         17  
85 14         54 };
86 14         109 *{"${base_class}::enable_session"} = sub {
87 1     1   119 my ($class, %args) = @_;
88 1   33     6 $args{state} ||= do {
89 1         890 require Plack::Session::State::Cookie;
90 1         5643 Plack::Session::State::Cookie->new(httponly => 1); # for security
91             };
92 1         743 require Plack::Middleware::Session;
93 1         2877 $class->enable_middleware('Plack::Middleware::Session', %args);
94             $class->add_trigger(AFTER_DISPATCH => sub {
95 2     2   1496 my ($c, $res) = @_;
96 2         11 $res->header('Cache-Control' => 'private');
97 1         17 });
98 14         78 };
99              
100 14     0   57 *{"$caller\::router"} = sub { $router };
  14         82  
  0         0  
101              
102             # any [qw/get post delete/] => '/bye' => sub { ... };
103             # any '/bye' => sub { ... };
104 14         69 *{"$caller\::any"} = sub ($$;$) {
105 2     2   114 my $pkg = caller(0);
106 2 100       6 if (@_==3) {
107 1         4 my ($methods, $pattern, $code) = @_;
108 1         6 $router->connect(
109             $pattern,
110 1         6 {code => $code, method => [ map { uc $_ } @$methods ]},
111 1         3 {method => [map { uc $_ } @$methods]},
112             );
113             } else {
114 1         2 my ($pattern, $code) = @_;
115 1         5 $router->connect(
116             $pattern,
117             {code => $code},
118             );
119             }
120 14         74 };
121              
122 14         64 *{"$caller\::get"} = sub {
123 18     18   255772 $router->connect($_[0], {code => $_[1], method => ['GET', 'HEAD']}, {method => 'GET'});
124 14         42 };
125              
126 14         75 *{"$caller\::post"} = sub {
127 2     2   225 $router->connect($_[0], {code => $_[1], method => ['POST']}, {method => ['POST']});
128 14         45 };
129              
130 14         83 *{"${base_class}\::dispatch"} = sub {
131 28     28   388229 my ($c) = @_;
132 28 100       186 if (my $p = $router->match($c->request->env)) {
133 23         7785 return $p->{code}->( $c, $p );
134             } else {
135 5 100       347 if ($router->method_not_allowed) {
136 4         22 my $content = '405 Method Not Allowed';
137 4         25 return $c->create_response(
138             405,
139             [
140             'Content-Type' => 'text/plain; charset=utf-8',
141             'Content-Length' => length($content),
142             ],
143             [$content]
144             );
145             } else {
146 1         13 return $c->res_404();
147             }
148             }
149 14         47 };
150              
151 14         1076 my $tmpl_dir = File::Spec->catdir(dirname((caller(0))[1]), 'tmpl');
152 14         98 *{"${base_class}::create_view"} = sub {
153 2     2   1055 $base_class->template_options();
154 14         63 };
155 14         82 *{"${base_class}::template_options"} = sub {
156 4     4   86 my ($class, %options) = @_;
157              
158             # using lazy loading to read __DATA__ section.
159 4         50 my $vpath = Data::Section::Simple->new($caller)->get_data_section();
160             my %params = (
161             'syntax' => 'TTerse',
162             'module' => [ 'Text::Xslate::Bridge::TT2Like' ],
163             'path' => [ $vpath, $tmpl_dir ],
164             'function' => {
165 0     0   0 c => sub { Amon2->context() },
166 0     0   0 uri_with => sub { Amon2->context()->req->uri_with(@_) },
167 0     0   0 uri_for => sub { Amon2->context()->uri_for(@_) },
168             },
169 4         585 );
170             my $merge = sub {
171 3     3   8 my ($stuff) = @_;
172 3         8 for (qw(module path)) {
173 6 100       25 if ($stuff->{$_}) {
174 1         2 unshift @{$params{$_}}, @{delete $stuff->{$_}};
  1         2  
  1         5  
175             }
176             }
177 3         6 for (qw(function)) {
178 3 100       14 if ($stuff->{$_}) {
179 1         1 $params{$_} = +{ %{$params{$_}}, %{delete $stuff->{$_}} };
  1         4  
  1         7  
180             }
181             }
182 3         18 while (my ($k, $v) = each %$stuff) {
183 3         14 $params{$k} = $v;
184             }
185 4         24 };
186 4 100       43 if (my $config = $caller->config->{'Text::Xslate'}) {
187 1         11 $merge->($config);
188             }
189 4 100       74 if (%options) {
190 2         6 $merge->(\%options);
191             }
192 4         65 my $xslate = Text::Xslate->new(%params);
193 13     13   104 no warnings 'redefine';
  13         35  
  13         2963  
194 4     3   11589 *{"${caller}::create_view"} = sub { $xslate };
  4         25  
  3         568  
195 4         87 $xslate;
196 14         70 };
197              
198 14 50       169 if (-d File::Spec->catdir($caller->base_dir, 'config')) {
199 0     0   0 *{"${base_class}::load_config"} = sub { Amon2::Config::Simple->load(shift) };
  0         0  
  0         0  
200             } else {
201 14     3   1424 *{"${base_class}::load_config"} = sub { +{ } };
  14         27689  
  3         42  
202             }
203             }
204              
205              
206             1;
207             __END__