X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FIdiotBox.pm;h=119f5178355f8958a24489928d27412c3b067422;hb=f29e9b6f6ae3cd365017102ed4ec49160fe8f46a;hp=29452c069d280886a3b4f795b60bd142d3f925ca;hpb=e30ed59ddb7852f9c79a449dfce61a31e97dc807;p=catagits%2FApp-IdiotBox.git diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm index 29452c0..119f517 100644 --- a/lib/App/IdiotBox.pm +++ b/lib/App/IdiotBox.pm @@ -1,71 +1,285 @@ 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; +use List::Util qw(first); -dispatch { +use App::IdiotBox::Announcement; +use App::IdiotBox::Bucket; +use App::IdiotBox::Video; + +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; + my $store; + ($store = $self->config->{store}) =~ /^(\w+)$/ + or die "Store config should be just a name, got ${store} instead"; + my $store_class = "App::IdiotBox::Store::${store}"; + eval "require ${store_class}; 1" + or die "Couldn't load ${store} store: $@"; + $store_class->bind($self); +} + +sub dispatch_request { + my $self = shift; sub (/) { $self->show_front_page }, - subdispatch sub (/*/...) { + + sub (/admin/) { + sub (%new_name=&new_slug=) { + my ($self, $name, $slug) = @_; + + my ($nb, $err) = App::IdiotBox::Bucket->create( + slug => $slug, + name => $name, + ); + + return $self->show_admin_page(error => $err) if $err; + + my $nb = $self->buckets->add($nb); + + $self->show_admin_page; + }, + }, + sub (/admin/) { $self->show_admin_page }, + + sub (/admin/*/...) { + my $bucket = $self->buckets->get({ slug => $_[1] }); + sub (%new_name=) { + my ($self, $new_name) = @_; + + my ($ub, $err) = $bucket->update( + name => $new_name, + ); + + return $self->show_admin_page(error => $err) if $err; + + $self->buckets->replace($bucket, $ub); + + $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] }); - } - ] + sub (/) { + $self->show_bucket($bucket) + }, + sub (/*/) { + $self->show_video($bucket->videos->get({ slug => $_[1] })); + } } -}; +} -method show_front_page { +sub show_front_page { + my $self = shift; my $ann = $self->recent_announcements; $self->html_response( - front_page => [ - '#announcement-list' => { - -repeat => { - data => $ann->map(sub { +{ - '#fill-bucket-name' => { -replace_content => $_->bucket->name }, - '#fill-bucket-link' => { - -set_attribute => { name => 'href', value => '/'.$_->slug.'/' } - }, - '#fill-new-videos' => $_->videos->count, - '#fill-total-videos' => $_->bucket->videos->count, - } }) - } - } - ] + front_page => sub { + $_->select('#announcement-list') + ->repeat_content($ann->map(sub { + my $obj = $_; + sub { + $_->select('.bucket-name')->replace_content($obj->bucket->name) + ->select('.made-at')->replace_content($obj->made_at) + ->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 + ) + } + })) + } ); } -method html_response ($template_name, $selectors) { - my $io = $self->_zoom_for($template_name => $selectors)->as_io; +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 { + my $video = $_; + sub { + $_->select('.video-name')->replace_content($video->name) + ->select('.video-author')->replace_content($video->author) + ->select('.video-link')->set_attribute( + href => $video->slug.'/' + ) + } + })) + }); +} + +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.".$_") + } @SupportedFormats; + $self->html_response(video => sub { + my $video_url = + $self->base_url + .($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( + href => '../' + ) + ->select('.bucket-name')->replace_content($video->bucket->name) + ->select('.video-details')->replace_content($video->details) + ->select('script')->template_text_raw({ video_url => $video_url }); + }); +} + +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 _layout_zoom { - $self->{layout_zoom} ||= HTML::Zoom->from_filename( - $self->_teamplate_filename_for('layout') +sub _template_filename_for { + my ($self, $name) = @_; + $self->{config}{template_dir}.'/'.$name.'.html'; +} + +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_filename( - $self->_template_filename_for($template_name); - ) - ->with_selectors( - '#main-content' => { -capture_events_into => \@body } + HTML::Zoom->from_file( + $self->_template_filename_for($template_name) ) - ->to_bit_bucket; - my @all = $self->_layout_zoom->with_selectors( - '#main-content' => { - -replace_content_events => \@body - } - )->to_event_array; - HTML::Zoom->from_events(\@all) - })->with_selectors(@$selectors) + ->select('#main-content')->collect_content({ into => \@body }) + ->run; + $self->_layout_zoom + ->select('#main-content')->replace_content(\@body) + ->memoize; + })->apply($selectors); +} + +sub base_url { + my $self = shift; + $self->{base_url} ||= do { + (my $u = $self->config->{base_url}) =~ s/\/$//; + "${u}/"; + } +} + +sub _run_cli { + my $self = shift; + unless (@ARGV == 1 && $ARGV[0] eq 'import') { + return $self->SUPER::_run_cli(@_); + } + $self->cli_import; +} + +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". + " $0 import\n". + "\n". + $self->SUPER::_cli_usage(@_); +} + +sub cli_import { + my $self = shift; + require App::IdiotBox::Importer; + App::IdiotBox::Importer->run($self); } 1;