examples/bloggery/bloggery.cgi | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 19 | 77 | 24.6 |
branch | 0 | 12 | 0.0 |
condition | 0 | 3 | 0.0 |
subroutine | 7 | 29 | 24.1 |
pod | 1 | 6 | 16.6 |
total | 27 | 127 | 21.2 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #!/usr/bin/perl | ||||||
2 | |||||||
3 | 1 | 1 | 985 | use FindBin; | |||
1 | 750 | ||||||
1 | 40 | ||||||
4 | 1 | 1 | 381 | use lib $FindBin::Bin.'/code'; | |||
1 | 463 | ||||||
1 | 7 | ||||||
5 | 1 | 1 | 506 | use Web::Simple 'Bloggery'; | |||
1 | 3 | ||||||
1 | 5 | ||||||
6 | |||||||
7 | package Bloggery::PostList; | ||||||
8 | |||||||
9 | 1 | 1 | 811 | use File::stat; | |||
1 | 6220 | ||||||
1 | 4 | ||||||
10 | |||||||
11 | sub from_dir { | ||||||
12 | 0 | 0 | 0 | my ($class, $dir) = @_; | |||
13 | 0 | 0 | bless ({ dir => $dir }, $class); | ||||
14 | } | ||||||
15 | |||||||
16 | sub all { | ||||||
17 | 0 | 0 | 0 | my ($self) = @_; | |||
18 | 0 | 0 | map { Bloggery::Post->from_file($_) } | ||||
19 | 0 | 0 | sort { stat($a)->mtime <=> stat($b)->mtime } | ||||
20 | 0 | 0 | grep { !/\.summary\.html$/ } | ||||
21 | 0 | 0 | glob($self->{dir}.'/*.html'); | ||||
22 | } | ||||||
23 | |||||||
24 | sub post { | ||||||
25 | 0 | 0 | 0 | my ($self, $name) = @_; | |||
26 | 0 | 0 | my $file = $self->{dir}."/${name}.html"; | ||||
27 | 0 | 0 | 0 | 0 | return unless $file && -f $file; | ||
28 | 0 | 0 | return Bloggery::Post->from_file($file); | ||||
29 | } | ||||||
30 | |||||||
31 | sub map { | ||||||
32 | 0 | 0 | 0 | my ($self, $code) = @_; | |||
33 | 0 | 0 | map $code->($_), $self->all; | ||||
34 | } | ||||||
35 | |||||||
36 | package Bloggery::Post; | ||||||
37 | |||||||
38 | sub from_file { | ||||||
39 | 0 | 0 | 0 | my ($class, $file) = @_; | |||
40 | 0 | 0 | bless({ file => $file }, $class); | ||||
41 | } | ||||||
42 | |||||||
43 | sub name { | ||||||
44 | 0 | 0 | 0 | my $name = shift->{file}; | |||
45 | 0 | 0 | $name =~ s/.*\///; | ||||
46 | 0 | 0 | $name =~ s/\.html$//; | ||||
47 | 0 | 0 | $name; | ||||
48 | } | ||||||
49 | |||||||
50 | sub title { | ||||||
51 | 0 | 0 | 0 | my $title = shift->name; | |||
52 | 0 | 0 | $title =~ s/-/ /g; | ||||
53 | 0 | 0 | $title; | ||||
54 | } | ||||||
55 | |||||||
56 | sub html { | ||||||
57 | 0 | 0 | 0 | \do { local (@ARGV, $/) = shift->{file}; <> }; | |||
0 | 0 | ||||||
0 | 0 | ||||||
58 | } | ||||||
59 | |||||||
60 | sub summary_html { | ||||||
61 | 0 | 0 | 0 | my $file = shift->{file}; | |||
62 | 0 | 0 | $file =~ s/\.html$/.summary.html/; | ||||
63 | 0 | 0 | 0 | return \' No summary ' unless -f $file; |
|||
64 | 0 | 0 | \do { local (@ARGV, $/) = $file; <> }; | ||||
0 | 0 | ||||||
0 | 0 | ||||||
65 | } | ||||||
66 | |||||||
67 | package Bloggery; | ||||||
68 | |||||||
69 | has post_list => (is => 'lazy'); | ||||||
70 | |||||||
71 | sub default_config { | ||||||
72 | ( | ||||||
73 | 1 | 1 | 1 | 21 | title => 'Bloggery', | ||
74 | posts_dir => $FindBin::Bin.'/posts', | ||||||
75 | ); | ||||||
76 | } | ||||||
77 | |||||||
78 | sub _build_post_list { | ||||||
79 | 0 | 0 | my ($self) = @_; | ||||
80 | Bloggery::PostList->from_dir( | ||||||
81 | $self->config->{posts_dir} | ||||||
82 | 0 | ); | |||||
83 | } | ||||||
84 | |||||||
85 | sub post { | ||||||
86 | 0 | 0 | 0 | my ($self, $post) = @_; | |||
87 | 0 | $self->post_list->post($post); | |||||
88 | } | ||||||
89 | |||||||
90 | sub dispatch_request { | ||||||
91 | 0 | 0 | 0 | my $self = shift; | |||
92 | sub (GET + /) { | ||||||
93 | 0 | 0 | redispatch_to '/index.html' | ||||
94 | }, | ||||||
95 | sub (.html) { | ||||||
96 | 0 | response_filter { $self->render_html(@_) } | |||||
97 | 0 | 0 | }, | ||||
98 | sub (GET + /index) { | ||||||
99 | 0 | 0 | $self->post_list | ||||
100 | }, | ||||||
101 | sub (GET + /*) { | ||||||
102 | 0 | 0 | $self->post($_[1]) | ||||
103 | }, | ||||||
104 | sub (GET) { | ||||||
105 | 0 | 0 | [ 404, [ 'Content-type', 'text/plain' ], [ 'Not found' ] ] | ||||
106 | }, | ||||||
107 | sub { | ||||||
108 | 0 | 0 | [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ] | ||||
109 | }, | ||||||
110 | 0 | }; | |||||
111 | |||||||
112 | sub render_html { | ||||||
113 | 0 | 0 | 0 | my ($self, $data) = @_; | |||
114 | 1 | 1 | 1008 | use HTML::Tags; | |||
1 | 2 | ||||||
1 | 4 | ||||||
115 | 0 | 0 | return $data if ref($data) eq 'ARRAY'; | ||||
116 | return [ | ||||||
117 | 0 | 200, | |||||
118 | [ 'Content-type', 'text/html' ], | ||||||
119 | [ | ||||||
120 | HTML::Tags::to_html_string( | ||||||
121 | , | ||||||
122 | , | ||||||
123 | |
||||||
124 | , | ||||||
125 | , | ||||||
126 | , $self->title_for($data),, |
||||||
127 | , |
||||||
128 | $self->main_html_for($data), | ||||||
129 | , | ||||||
130 | , | ||||||
131 | |||||||
132 | ) | ||||||
133 | ] | ||||||
134 | ]; | ||||||
135 | } | ||||||
136 | |||||||
137 | sub title_for { | ||||||
138 | 0 | 0 | 0 | my ($self, $data) = @_; | |||
139 | 0 | 0 | if ($data->isa('Bloggery::Post')) { | ||||
140 | 0 | return $data->title; | |||||
141 | } | ||||||
142 | 0 | return $self->config->{title}; | |||||
143 | } | ||||||
144 | |||||||
145 | sub main_html_for { | ||||||
146 | 0 | 0 | 0 | my ($self, $data) = @_; | |||
147 | 1 | 1 | 5 | use HTML::Tags; | |||
1 | 1 | ||||||
1 | 3 | ||||||
148 | 0 | 0 | if ($data->isa('Bloggery::Post')) { | ||||
0 | |||||||
149 | 0 | $data->html | |||||
150 | } elsif ($data->isa('Bloggery::PostList')) { | ||||||
151 |
|
||||||
152 | $data->map(sub { | ||||||
153 | 0 | 0 | my $path = $_->name.'.html'; | ||||
154 | |
||||||
155 | 0 | , , $_->title, ,, |
|||||
156 | , $_->summary_html, , | ||||||
157 | ; | ||||||
158 | 0 | }), | |||||
159 | ; | ||||||
160 | } else { | ||||||
161 | 0 | , "Don't know how to render $data",; |
|||||
162 | } | ||||||
163 | } | ||||||
164 | |||||||
165 | Bloggery->run_if_script; |