File Coverage

blib/lib/HTTP/Engine/Middleware/Status.pm
Criterion Covered Total %
statement 16 19 84.2
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod 0 1 0.0
total 21 26 80.7


line stmt bran cond sub pod time code
1             package HTTP::Engine::Middleware::Status;
2 1     1   387 use HTTP::Engine::Middleware;
  1         1  
  1         6  
3 1     1   4 use HTTP::Engine::Response;
  1         1  
  1         25  
4              
5 1     1   4 use Any::Moose '::Util::TypeConstraints';
  1         1  
  1         4  
6              
7             subtype 'HTTP::Engine::Middleware::Status::Plugin'
8             => as 'Object'
9             => where { $_->isa('HTTP::Engine::Middleware::Status::Base') };
10              
11             subtype 'HTTP::Engine::Middleware::Status::Plugins'
12             => as 'ArrayRef[HTTP::Engine::Middleware::Status::Plugin]';
13             coerce 'HTTP::Engine::Middleware::Status::Plugins'
14             => from 'ArrayRef[HashRef]' => via {
15             my $build = [];
16             for my $plugin (@{ $_ }) {
17             my $module = $plugin->{module};
18             my $config = $plugin->{config} || +{};
19             $module = __PACKAGE__ . "::$module" unless $module =~ s/^\+//;
20             Any::Moose::load_class($module);
21             push @{ $build }, $module->new(%{ $config });
22             }
23             $build;
24             };
25             coerce 'HTTP::Engine::Middleware::Status::Plugins'
26             => from 'ArrayRef[Str]' => via {
27             my $build = [];
28             for my $module (@{ $_ }) {
29             $module = __PACKAGE__ . "::$module" unless $module =~ s/^\+//;
30             Any::Moose::load_class($module);
31             push @{ $build }, $module->new;
32             }
33             $build;
34             };
35              
36             has 'launch_at' => (
37             is => 'rw',
38             isa => 'Str',
39             default => '/httpengine-status',
40             );
41              
42             has 'plugins' => (
43             is => 'rw',
44             isa => 'HTTP::Engine::Middleware::Status::Plugins',
45             default => sub { [] },
46             coerce => 1,
47             );
48              
49             sub run_hook {
50 3     3 0 7 my($self, $hook, %args) = @_;
51 3         3 my @rets;
52 3 50       7 if ($hook eq 'render') {
53 3         3 for my $plugin (@{ $self->plugins }) {
  3         8  
54 2         14 push @rets, $plugin->render_header(%args), $plugin->render(%args);
55             }
56             } else {
57 0         0 for my $plugin (@{ $self->plugins }) {
  0         0  
58 0         0 push @rets, $plugin->$hook(%args);
59             }
60             }
61 3         9 @rets;
62             }
63              
64             before_handle {
65             my ( $c, $self, $req ) = @_;
66              
67             my $launch_at = $self->launch_at;
68             unless ($launch_at && $req->uri->path =~ /^$launch_at/) {
69             # $self->run_hook('before');
70             return $req;
71             }
72              
73             my $plugin_htmls = join '', $self->run_hook('render', req => $req);
74              
75             my $html =<<HTML;
76             <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
77             "http://www.w3.org/TR/html4/loose.dtd">
78             <html>
79             <head>
80             <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
81             <meta http-equiv="Content-Script-Type" content="text/javascript">
82             <meta http-equiv="Content-Style-Type" content="text/css">
83             <title>HTTP::Engine Status</title>
84             </head>
85             <body>
86             <h1>HTTP::Engine Status</h1>
87              
88             $plugin_htmls
89              
90             </body>
91             </html>
92             HTML
93              
94             HTTP::Engine::Response->new( body => $html );;
95             };
96              
97             __MIDDLEWARE__
98              
99             __END__
100              
101             =head1 NAME
102              
103             HTTP::Engine::Middleware::Status - server status manager
104              
105             =head1 SYNOPSIS
106              
107             my $mw = HTTP::Engine::Middleware->new;
108             $mw->install( 'HTTP::Engine::Middleware::Status' => {
109             launch_at => '/hem-server-status',
110             plugins => [
111             'Memory', # use HTTP::Engine::Middleware::Status::Memory
112             ],
113             });
114             HTTP::Engine->new(
115             interface => {
116             module => 'YourFavoriteInterfaceHere',
117             request_handler => $mw->handler( \&handler ),
118             }
119             )->run();
120              
121             # $ GET http//localhost/hem-server-status
122             # to get the status contents
123              
124             =head1 DESCRIPTION
125              
126             this module is given server status contents like Apache's mod_status.c to HTTP::Engine.
127              
128             =head1 SEE ALSO
129              
130             L<HTTP::Engine::Middleware::Status::Memory>
131              
132             =head1 AUTHORS
133              
134             Kazuhiro Osawa
135              
136             =cut