3 use App::IdiotBox::Common qw(@SupportedFormats);
4 use Web::Simple __PACKAGE__;
7 use HTML::Zoom::FilterBuilder::Template;
8 use List::Util qw(first);
11 package App::IdiotBox::Announcement;
13 sub id { shift->{id} }
14 sub made_at { shift->{made_at} }
15 sub bucket { shift->{bucket} }
16 sub video_count { shift->{video_count} }
18 package App::IdiotBox::Bucket;
20 sub slug { shift->{slug} }
21 sub name { shift->{name} }
23 exists $_[0]->{video_count}
24 ? $_[0]->{video_count}
25 : $_[0]->{videos}->count
27 sub videos { shift->{videos} }
29 package App::IdiotBox::Video;
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} }
37 (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g;
41 join('/', $_[0]->bucket->slug, $_[0]->slug);
45 has $_ => (is => 'ro') for qw(recent_announcements buckets);
48 template_dir => 'share/html',
50 db_file => 'var/lib/idiotbox.db',
51 base_url => 'http://localhost:3000/',
52 base_dir => do { use FindBin; $FindBin::Bin },
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);
66 sub dispatch_request {
68 sub (/) { $self->show_front_page },
70 sub (%new_name=&new_slug=) {
71 my ($self, $name, $slug) = @_;
73 unless ($name && $slug) {
74 return $self->show_admin_page(error => "Please enter a name and a bucket");
76 if ($name =~ /^\s+$/ || $slug =~ /^\s+$/) {
77 return $self->show_admin_page(error => "Names/buckets must not be all whitespace");
82 my $nb = $self->buckets->add(bless({
85 }, 'App::IdiotBox::Bucket'));
87 $self->show_admin_page;
90 sub (/admin/) { $self->show_admin_page },
93 my $bucket = $self->buckets->get({ slug => $_[1] });
95 my ($self, $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");
101 $self->buckets->replace($bucket, bless({
102 slug => $bucket->slug,
104 }, 'App::IdiotBox::Bucket'));
105 $self->show_bucket_edited_page($bucket);
108 $self->show_edit_bucket_page($bucket);
111 $self->show_confirm_delete_bucket_page($bucket)
114 $self->buckets->remove({ slug => $bucket->slug });
115 $self->show_bucket_deleted_page($bucket->slug);
119 my $bucket = $self->buckets->get({ slug => $_[1] });
121 $self->show_bucket($bucket)
124 $self->show_video($bucket->videos->get({ slug => $_[1] }));
129 sub show_front_page {
131 my $ann = $self->recent_announcements;
132 $self->html_response(
134 $_->select('#announcement-list')
135 ->repeat_content($ann->map(sub {
138 $_->select('.bucket-name')->replace_content($obj->bucket->name)
139 ->select('.made-at')->replace_content($obj->made_at)
140 ->select('.bucket-link')->set_attribute(
141 'href' => $obj->bucket->slug.'/'
143 ->select('.new-videos')->replace_content($obj->video_count)
144 ->select('.total-videos')->replace_content(
145 $obj->bucket->video_count
153 sub show_admin_page {
156 my $error = $opts{error} || '';
158 my $bucket = $self->buckets;
159 $self->html_response(
161 $_->select('#bucket-list')
162 ->repeat_content($bucket->map(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.'/'
170 ->select('.delete-link')->set_attribute(
171 'href' => $obj->slug.'/delete/'
175 ->select('.error-text')->replace_content($error)
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(
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);
201 sub show_bucket_deleted_page {
202 my ($self, $name) = @_;
203 $self->html_response('deleted' => sub {
204 $_->select('.bucket-name')->replace_content($name)
208 sub show_bucket_edited_page {
209 my ($self, $name) = @_;
210 $self->html_response('edited' => sub {
211 $_->select('.bucket-name')->replace_content($name)
216 my ($self, $bucket) = @_;
217 $self->html_response(bucket => sub {
218 $_->select('.bucket-name')->replace_content($bucket->name)
219 ->select('#video-list')->repeat_content($bucket->videos->map(sub {
222 $_->select('.video-name')->replace_content($video->name)
223 ->select('.video-author')->replace_content($video->author)
224 ->select('.video-link')->set_attribute(
225 href => $video->slug.'/'
233 my ($self, $video) = @_;
234 my $video_file = first {
235 -e join('/', $self->config->{base_dir}, $_)
237 join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_")
239 $self->html_response(video => sub {
242 .($video_file||'NO FILE FOUND SORRY');
244 $_->select('.video-name')->replace_content($video->name)
245 ->select('.author-name')->replace_content($video->author)
246 ->select('.bucket-link')->set_attribute(
249 ->select('.bucket-name')->replace_content($video->bucket->name)
250 ->select('.video-details')->replace_content($video->details)
251 ->select('script')->template_text_raw({ video_url => $video_url });
256 my ($self, $template_name, $selectors) = @_;
257 my $io = $self->_zoom_for($template_name => $selectors)->to_fh;
258 return [ 200, [ 'Content-Type' => 'text/html' ], $io ]
261 sub _template_filename_for {
262 my ($self, $name) = @_;
263 $self->{config}{template_dir}.'/'.$name.'.html';
268 $self->{layout_zoom} ||= HTML::Zoom->from_file(
269 $self->_template_filename_for('layout')
274 my ($self, $template_name, $selectors) = @_;
275 ($self->{zoom_for_template}{$template_name} ||= do {
277 HTML::Zoom->from_file(
278 $self->_template_filename_for($template_name)
280 ->select('#main-content')->collect_content({ into => \@body })
283 ->select('#main-content')->replace_content(\@body)
285 })->apply($selectors);
290 $self->{base_url} ||= do {
291 (my $u = $self->config->{base_url}) =~ s/\/$//;
298 unless (@ARGV == 1 && $ARGV[0] eq 'import') {
299 return $self->SUPER::_run_cli(@_);
306 "To import data into your idiotbox install, chdir into a directory\n".
307 "containing video files and run:\n".
311 $self->SUPER::_cli_usage(@_);
316 require App::IdiotBox::Importer;
317 App::IdiotBox::Importer->run($self);