X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FApp-IdiotBox.git;a=blobdiff_plain;f=lib%2FApp%2FIdiotBox.pm;h=a915049f8cda7ef9b939ed04c7a7857a96de220a;hp=2b79deec5c18114948d1eda577c75ac43e54d845;hb=26b4958ec93a29fb6918934f2b4fab0541bad2fd;hpb=02ea620ecbee068e5a138323eccbc8327b90501c diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm index 2b79dee..a915049 100644 --- a/lib/App/IdiotBox.pm +++ b/lib/App/IdiotBox.pm @@ -1,7 +1,7 @@ package App::IdiotBox; +use App::IdiotBox::Common qw(@SupportedFormats); use Web::Simple __PACKAGE__; -use Method::Signatures::Simple; use FindBin; use HTML::Zoom; use HTML::Zoom::FilterBuilder::Template; @@ -42,13 +42,15 @@ use List::Util qw(first); } } -default_config( +has $_ => (is => 'ro') for qw(recent_announcements buckets); + +sub default_config { template_dir => 'share/html', store => 'SQLite', db_file => 'var/lib/idiotbox.db', base_url => 'http://localhost:3000/', base_dir => do { use FindBin; $FindBin::Bin }, -); +} sub BUILD { my $self = shift; @@ -61,26 +63,71 @@ sub BUILD { $store_class->bind($self); } -dispatch { +sub dispatch_request { + my $self = shift; sub (/) { $self->show_front_page }, - subdispatch sub (/*/...) { + sub (/admin/) { + sub (%new_name=&new_slug=) { + my ($self, $name, $slug) = @_; + + unless ($name && $slug) { + return $self->show_admin_page(error => "Please enter a name and a bucket"); + } + if ($name =~ /^\s+$/ || $slug =~ /^\s+$/) { + return $self->show_admin_page(error => "Names/buckets must not be all whitespace"); + } + + $slug =~ s/ /-/g; + + my $nb = $self->buckets->add(bless({ + slug => $slug, + name => $name, + }, 'App::IdiotBox::Bucket')); + + $self->show_admin_page; + }, + }, + sub (/admin/) { $self->show_admin_page }, + + sub (/admin/*/...) { my $bucket = $self->buckets->get({ slug => $_[1] }); - [ - sub (/) { - $self->show_bucket($bucket) - }, - sub (/*/) { - $self->show_video($bucket->videos->get({ slug => $_[1] })); + sub (%new_name=) { + my ($self, $new_name) = @_; + if (!$new_name) { + return $self->show_edit_bucket_page($bucket, error => "Please enter a new name"); + } elsif ($new_name =~ /^\s+$/) { + return $self->show_edit_bucket_page($bucket, error => "Names must not be all whitespace"); } - ] + $self->buckets->replace($bucket, bless({ + slug => $bucket->slug, + name => $new_name, + }, 'App::IdiotBox::Bucket')); + $self->show_bucket_edited_page($bucket); + }, + sub (/) { + $self->show_edit_bucket_page($bucket); + }, + sub (/delete/) { + $self->show_confirm_delete_bucket_page($bucket) + }, + sub (/delete/yes/) { + $self->buckets->remove({ slug => $bucket->slug }); + $self->show_bucket_deleted_page($bucket->slug); + }, + }, + sub (/*/...) { + my $bucket = $self->buckets->get({ slug => $_[1] }); + sub (/) { + $self->show_bucket($bucket) + }, + sub (/*/) { + $self->show_video($bucket->videos->get({ slug => $_[1] })); + } } -}; - -method recent_announcements { $self->{recent_announcements} } - -method buckets { $self->{buckets} } +} -method show_front_page { +sub show_front_page { + my $self = shift; my $ann = $self->recent_announcements; $self->html_response( front_page => sub { @@ -90,9 +137,9 @@ method show_front_page { sub { $_->select('.bucket-name')->replace_content($obj->bucket->name) ->select('.made-at')->replace_content($obj->made_at) - ->select('.bucket-link')->set_attribute({ - name => 'href', value => $obj->bucket->slug.'/' - }) + ->select('.bucket-link')->set_attribute( + 'href' => $obj->bucket->slug.'/' + ) ->select('.new-videos')->replace_content($obj->video_count) ->select('.total-videos')->replace_content( $obj->bucket->video_count @@ -103,7 +150,70 @@ method show_front_page { ); } -method show_bucket ($bucket) { +sub show_admin_page { + my $self = shift; + my %opts = @_; + my $error = $opts{error} || ''; + + my $bucket = $self->buckets; + $self->html_response( + admin => sub { + $_->select('#bucket-list') + ->repeat_content($bucket->map(sub { + my $obj = $_; + sub { + $_->select('.bucket-slug')->replace_content($obj->slug) + ->select('.bucket-name')->replace_content($obj->name) + ->select('.edit-link')->set_attribute( + 'href' => $obj->slug.'/' + ) + ->select('.delete-link')->set_attribute( + 'href' => $obj->slug.'/delete/' + ) + } + })) + ->select('.error-text')->replace_content($error) + + } + + ); +} + +sub show_confirm_delete_bucket_page { + my ($self, $bucket) = @_; + $self->html_response('delete' => sub { + $_->select('.bucket-name')->replace_content($bucket->name) + ->select('.confirm-yes')->set_attribute( + 'href' => 'yes/' + ) + }); +} + +sub show_edit_bucket_page { + my ($self, $bucket, %opt) = @_; + my $error = $opt{error} || ''; + $self->html_response('edit' => sub { + $_->select('.bucket-name')->replace_content($bucket->name) + ->select('.error-text')->replace_content($error); + }); +} + +sub show_bucket_deleted_page { + my ($self, $name) = @_; + $self->html_response('deleted' => sub { + $_->select('.bucket-name')->replace_content($name) + }); +} + +sub show_bucket_edited_page { + my ($self, $name) = @_; + $self->html_response('edited' => sub { + $_->select('.bucket-name')->replace_content($name) + }); +} + +sub show_bucket { + my ($self, $bucket) = @_; $self->html_response(bucket => sub { $_->select('.bucket-name')->replace_content($bucket->name) ->select('#video-list')->repeat_content($bucket->videos->map(sub { @@ -112,28 +222,29 @@ method show_bucket ($bucket) { $_->select('.video-name')->replace_content($video->name) ->select('.video-author')->replace_content($video->author) ->select('.video-link')->set_attribute( - { name => 'href', value => $video->slug.'/' } + href => $video->slug.'/' ) } })) }); } -method show_video ($video) { +sub show_video { + my ($self, $video) = @_; my $video_file = first { -e join('/', $self->config->{base_dir}, $_) } map { join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_") - } qw(flv m4v); + } @SupportedFormats; $self->html_response(video => sub { my $video_url = $self->base_url - .$video_file; + .($video_file||'NO FILE FOUND SORRY'); $_->select('.video-name')->replace_content($video->name) ->select('.author-name')->replace_content($video->author) ->select('.bucket-link')->set_attribute( - { name => 'href', value => '../' } + href => '../' ) ->select('.bucket-name')->replace_content($video->bucket->name) ->select('.video-details')->replace_content($video->details) @@ -141,22 +252,26 @@ method show_video ($video) { }); } -method html_response ($template_name, $selectors) { +sub html_response { + my ($self, $template_name, $selectors) = @_; my $io = $self->_zoom_for($template_name => $selectors)->to_fh; return [ 200, [ 'Content-Type' => 'text/html' ], $io ] } -method _template_filename_for ($name) { +sub _template_filename_for { + my ($self, $name) = @_; $self->{config}{template_dir}.'/'.$name.'.html'; } -method _layout_zoom { +sub _layout_zoom { + my $self = shift; $self->{layout_zoom} ||= HTML::Zoom->from_file( $self->_template_filename_for('layout') ) } -method _zoom_for ($template_name, $selectors) { +sub _zoom_for { + my ($self, $template_name, $selectors) = @_; ($self->{zoom_for_template}{$template_name} ||= do { my @body; HTML::Zoom->from_file( @@ -170,21 +285,24 @@ method _zoom_for ($template_name, $selectors) { })->apply($selectors); } -method base_url { +sub base_url { + my $self = shift; $self->{base_url} ||= do { (my $u = $self->config->{base_url}) =~ s/\/$//; "${u}/"; } } -method _run_cli { +sub _run_cli { + my $self = shift; unless (@ARGV == 1 && $ARGV[0] eq 'import') { return $self->SUPER::_run_cli(@_); } $self->cli_import; } -method _cli_usage { +sub _cli_usage { + my $self = shift; "To import data into your idiotbox install, chdir into a directory\n". "containing video files and run:\n". "\n". @@ -193,7 +311,8 @@ method _cli_usage { $self->SUPER::_cli_usage(@_); } -method cli_import { +sub cli_import { + my $self = shift; require App::IdiotBox::Importer; App::IdiotBox::Importer->run($self); }