Commit | Line | Data |
e30ed59d |
1 | package App::IdiotBox; |
2 | |
625f105e |
3 | use App::IdiotBox::Common qw(@SupportedFormats); |
e30ed59d |
4 | use Web::Simple __PACKAGE__; |
d7497a23 |
5 | use FindBin; |
6 | use HTML::Zoom; |
998cc52c |
7 | use HTML::Zoom::FilterBuilder::Template; |
02ea620e |
8 | use List::Util qw(first); |
d7497a23 |
9 | |
10 | { |
11 | package App::IdiotBox::Announcement; |
12 | |
ebba317f |
13 | sub id { shift->{id} } |
d7497a23 |
14 | sub made_at { shift->{made_at} } |
15 | sub bucket { shift->{bucket} } |
16 | sub video_count { shift->{video_count} } |
17 | |
18 | package App::IdiotBox::Bucket; |
19 | |
20 | sub slug { shift->{slug} } |
21 | sub name { shift->{name} } |
d9702c6d |
22 | sub video_count { |
23 | exists $_[0]->{video_count} |
24 | ? $_[0]->{video_count} |
25 | : $_[0]->{videos}->count |
26 | } |
71fd1550 |
27 | sub videos { shift->{videos} } |
28 | |
29 | package App::IdiotBox::Video; |
30 | |
31 | sub slug { shift->{slug} } |
32 | sub name { shift->{name} } |
33 | sub author { shift->{author} } |
34 | sub details { shift->{details} } |
35 | sub bucket { shift->{bucket} } |
998cc52c |
36 | sub file_name { |
37 | (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g; |
38 | $s; |
39 | } |
ebba317f |
40 | sub url_path { |
41 | join('/', $_[0]->bucket->slug, $_[0]->slug); |
42 | } |
d7497a23 |
43 | } |
44 | |
362a8766 |
45 | has $_ => (is => 'ro') for qw(recent_announcements buckets); |
46 | |
8b9d3d54 |
47 | sub default_config { |
71a02d85 |
48 | template_dir => 'share/html', |
49 | store => 'SQLite', |
50 | db_file => 'var/lib/idiotbox.db', |
998cc52c |
51 | base_url => 'http://localhost:3000/', |
ebba317f |
52 | base_dir => do { use FindBin; $FindBin::Bin }, |
8b9d3d54 |
53 | } |
e30ed59d |
54 | |
71a02d85 |
55 | sub BUILD { |
56 | my $self = shift; |
57 | my $store; |
58 | ($store = $self->config->{store}) =~ /^(\w+)$/ |
59 | or die "Store config should be just a name, got ${store} instead"; |
60 | my $store_class = "App::IdiotBox::Store::${store}"; |
61 | eval "require ${store_class}; 1" |
62 | or die "Couldn't load ${store} store: $@"; |
63 | $store_class->bind($self); |
64 | } |
65 | |
8b9d3d54 |
66 | sub dispatch_request { |
67 | my $self = shift; |
e30ed59d |
68 | sub (/) { $self->show_front_page }, |
26b4958e |
69 | sub (/admin/) { |
70 | sub (%new_name=&new_slug=) { |
71 | my ($self, $name, $slug) = @_; |
72 | |
73 | unless ($name && $slug) { |
74 | return $self->show_admin_page(error => "Please enter a name and a bucket"); |
75 | } |
76 | if ($name =~ /^\s+$/ || $slug =~ /^\s+$/) { |
77 | return $self->show_admin_page(error => "Names/buckets must not be all whitespace"); |
78 | } |
79 | |
80 | $slug =~ s/ /-/g; |
81 | |
82 | my $nb = $self->buckets->add(bless({ |
83 | slug => $slug, |
84 | name => $name, |
85 | }, 'App::IdiotBox::Bucket')); |
86 | |
87 | $self->show_admin_page; |
88 | }, |
89 | }, |
90 | sub (/admin/) { $self->show_admin_page }, |
91 | |
92 | sub (/admin/*/...) { |
93 | my $bucket = $self->buckets->get({ slug => $_[1] }); |
94 | sub (%new_name=) { |
95 | my ($self, $new_name) = @_; |
96 | if (!$new_name) { |
97 | return $self->show_edit_bucket_page($bucket, error => "Please enter a new name"); |
98 | } elsif ($new_name =~ /^\s+$/) { |
99 | return $self->show_edit_bucket_page($bucket, error => "Names must not be all whitespace"); |
100 | } |
101 | $self->buckets->replace($bucket, bless({ |
102 | slug => $bucket->slug, |
103 | name => $new_name, |
104 | }, 'App::IdiotBox::Bucket')); |
105 | $self->show_bucket_edited_page($bucket); |
106 | }, |
107 | sub (/) { |
108 | $self->show_edit_bucket_page($bucket); |
109 | }, |
110 | sub (/delete/) { |
111 | $self->show_confirm_delete_bucket_page($bucket) |
112 | }, |
113 | sub (/delete/yes/) { |
114 | $self->buckets->remove({ slug => $bucket->slug }); |
115 | $self->show_bucket_deleted_page($bucket->slug); |
116 | }, |
117 | }, |
8b9d3d54 |
118 | sub (/*/...) { |
e30ed59d |
119 | my $bucket = $self->buckets->get({ slug => $_[1] }); |
8b9d3d54 |
120 | sub (/) { |
121 | $self->show_bucket($bucket) |
122 | }, |
123 | sub (/*/) { |
124 | $self->show_video($bucket->videos->get({ slug => $_[1] })); |
125 | } |
e30ed59d |
126 | } |
8b9d3d54 |
127 | } |
e30ed59d |
128 | |
847de56a |
129 | sub show_front_page { |
130 | my $self = shift; |
e30ed59d |
131 | my $ann = $self->recent_announcements; |
132 | $self->html_response( |
1a1c4f78 |
133 | front_page => sub { |
134 | $_->select('#announcement-list') |
135 | ->repeat_content($ann->map(sub { |
136 | my $obj = $_; |
137 | sub { |
138 | $_->select('.bucket-name')->replace_content($obj->bucket->name) |
02ea620e |
139 | ->select('.made-at')->replace_content($obj->made_at) |
fb836c4b |
140 | ->select('.bucket-link')->set_attribute( |
141 | 'href' => $obj->bucket->slug.'/' |
142 | ) |
1a1c4f78 |
143 | ->select('.new-videos')->replace_content($obj->video_count) |
144 | ->select('.total-videos')->replace_content( |
145 | $obj->bucket->video_count |
146 | ) |
147 | } |
148 | })) |
149 | } |
e30ed59d |
150 | ); |
151 | } |
152 | |
26b4958e |
153 | sub show_admin_page { |
154 | my $self = shift; |
155 | my %opts = @_; |
156 | my $error = $opts{error} || ''; |
157 | |
158 | my $bucket = $self->buckets; |
159 | $self->html_response( |
160 | admin => sub { |
161 | $_->select('#bucket-list') |
162 | ->repeat_content($bucket->map(sub { |
163 | my $obj = $_; |
164 | sub { |
165 | $_->select('.bucket-slug')->replace_content($obj->slug) |
166 | ->select('.bucket-name')->replace_content($obj->name) |
167 | ->select('.edit-link')->set_attribute( |
168 | 'href' => $obj->slug.'/' |
169 | ) |
170 | ->select('.delete-link')->set_attribute( |
171 | 'href' => $obj->slug.'/delete/' |
172 | ) |
173 | } |
174 | })) |
175 | ->select('.error-text')->replace_content($error) |
176 | |
177 | } |
178 | |
179 | ); |
180 | } |
181 | |
182 | sub show_confirm_delete_bucket_page { |
183 | my ($self, $bucket) = @_; |
184 | $self->html_response('delete' => sub { |
185 | $_->select('.bucket-name')->replace_content($bucket->name) |
186 | ->select('.confirm-yes')->set_attribute( |
187 | 'href' => 'yes/' |
188 | ) |
189 | }); |
190 | } |
191 | |
192 | sub show_edit_bucket_page { |
193 | my ($self, $bucket, %opt) = @_; |
194 | my $error = $opt{error} || ''; |
195 | $self->html_response('edit' => sub { |
196 | $_->select('.bucket-name')->replace_content($bucket->name) |
197 | ->select('.error-text')->replace_content($error); |
198 | }); |
199 | } |
200 | |
201 | sub show_bucket_deleted_page { |
202 | my ($self, $name) = @_; |
203 | $self->html_response('deleted' => sub { |
204 | $_->select('.bucket-name')->replace_content($name) |
205 | }); |
206 | } |
207 | |
208 | sub show_bucket_edited_page { |
209 | my ($self, $name) = @_; |
210 | $self->html_response('edited' => sub { |
211 | $_->select('.bucket-name')->replace_content($name) |
212 | }); |
213 | } |
214 | |
847de56a |
215 | sub show_bucket { |
216 | my ($self, $bucket) = @_; |
1a1c4f78 |
217 | $self->html_response(bucket => sub { |
218 | $_->select('.bucket-name')->replace_content($bucket->name) |
219 | ->select('#video-list')->repeat_content($bucket->videos->map(sub { |
220 | my $video = $_; |
221 | sub { |
222 | $_->select('.video-name')->replace_content($video->name) |
223 | ->select('.video-author')->replace_content($video->author) |
224 | ->select('.video-link')->set_attribute( |
fb836c4b |
225 | href => $video->slug.'/' |
1a1c4f78 |
226 | ) |
227 | } |
228 | })) |
229 | }); |
d7497a23 |
230 | } |
231 | |
847de56a |
232 | sub show_video { |
233 | my ($self, $video) = @_; |
02ea620e |
234 | my $video_file = first { |
235 | -e join('/', $self->config->{base_dir}, $_) |
236 | } map { |
237 | join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_") |
625f105e |
238 | } @SupportedFormats; |
1a1c4f78 |
239 | $self->html_response(video => sub { |
998cc52c |
240 | my $video_url = |
241 | $self->base_url |
6df05090 |
242 | .($video_file||'NO FILE FOUND SORRY'); |
998cc52c |
243 | |
1a1c4f78 |
244 | $_->select('.video-name')->replace_content($video->name) |
245 | ->select('.author-name')->replace_content($video->author) |
246 | ->select('.bucket-link')->set_attribute( |
fb836c4b |
247 | href => '../' |
1a1c4f78 |
248 | ) |
249 | ->select('.bucket-name')->replace_content($video->bucket->name) |
250 | ->select('.video-details')->replace_content($video->details) |
998cc52c |
251 | ->select('script')->template_text_raw({ video_url => $video_url }); |
1a1c4f78 |
252 | }); |
d7497a23 |
253 | } |
254 | |
847de56a |
255 | sub html_response { |
256 | my ($self, $template_name, $selectors) = @_; |
1a1c4f78 |
257 | my $io = $self->_zoom_for($template_name => $selectors)->to_fh; |
e30ed59d |
258 | return [ 200, [ 'Content-Type' => 'text/html' ], $io ] |
259 | } |
260 | |
847de56a |
261 | sub _template_filename_for { |
262 | my ($self, $name) = @_; |
d7497a23 |
263 | $self->{config}{template_dir}.'/'.$name.'.html'; |
264 | } |
265 | |
847de56a |
266 | sub _layout_zoom { |
267 | my $self = shift; |
d7497a23 |
268 | $self->{layout_zoom} ||= HTML::Zoom->from_file( |
269 | $self->_template_filename_for('layout') |
e30ed59d |
270 | ) |
271 | } |
272 | |
847de56a |
273 | sub _zoom_for { |
274 | my ($self, $template_name, $selectors) = @_; |
e30ed59d |
275 | ($self->{zoom_for_template}{$template_name} ||= do { |
276 | my @body; |
d7497a23 |
277 | HTML::Zoom->from_file( |
278 | $self->_template_filename_for($template_name) |
e30ed59d |
279 | ) |
1a1c4f78 |
280 | ->select('#main-content')->collect_content({ into => \@body }) |
d7497a23 |
281 | ->run; |
1a1c4f78 |
282 | $self->_layout_zoom |
283 | ->select('#main-content')->replace_content(\@body) |
284 | ->memoize; |
285 | })->apply($selectors); |
e30ed59d |
286 | } |
287 | |
847de56a |
288 | sub base_url { |
289 | my $self = shift; |
998cc52c |
290 | $self->{base_url} ||= do { |
291 | (my $u = $self->config->{base_url}) =~ s/\/$//; |
292 | "${u}/"; |
293 | } |
294 | } |
295 | |
847de56a |
296 | sub _run_cli { |
297 | my $self = shift; |
ebba317f |
298 | unless (@ARGV == 1 && $ARGV[0] eq 'import') { |
299 | return $self->SUPER::_run_cli(@_); |
300 | } |
301 | $self->cli_import; |
302 | } |
303 | |
847de56a |
304 | sub _cli_usage { |
305 | my $self = shift; |
ebba317f |
306 | "To import data into your idiotbox install, chdir into a directory\n". |
307 | "containing video files and run:\n". |
308 | "\n". |
309 | " $0 import\n". |
310 | "\n". |
311 | $self->SUPER::_cli_usage(@_); |
312 | } |
313 | |
847de56a |
314 | sub cli_import { |
315 | my $self = shift; |
ebba317f |
316 | require App::IdiotBox::Importer; |
317 | App::IdiotBox::Importer->run($self); |
318 | } |
319 | |
e30ed59d |
320 | 1; |