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);
{
package App::IdiotBox::Announcement;
+ sub id { shift->{id} }
sub made_at { shift->{made_at} }
sub bucket { shift->{bucket} }
sub video_count { shift->{video_count} }
sub slug { shift->{slug} }
sub name { shift->{name} }
- sub video_count { shift->{video_count} }
+ sub video_count {
+ exists $_[0]->{video_count}
+ ? $_[0]->{video_count}
+ : $_[0]->{videos}->count
+ }
sub videos { shift->{videos} }
package App::IdiotBox::Video;
sub author { shift->{author} }
sub details { shift->{details} }
sub bucket { shift->{bucket} }
+ sub file_name {
+ (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g;
+ $s;
+ }
+ sub url_path {
+ join('/', $_[0]->bucket->slug, $_[0]->slug);
+ }
}
-default_config(
- template_dir => $FindBin::Bin.'/../share/html'
-);
+has $_ => (is => 'ro') for qw(recent_announcements buckets);
-dispatch {
+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) = @_;
+
+ 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 show_front_page {
+sub show_front_page {
+ my $self = shift;
my $ann = $self->recent_announcements;
$self->html_response(
- front_page => [
- '#announcement-list' => [
- -repeat_content => {
- repeat_for => $ann->map(sub { [
- '.fill-bucket-name' => [
- -replace_content => { replace_with => $_->bucket->name }
- ],
- '.fill-bucket-link' => [
- -set_attribute => { name => 'href', value => $_->bucket->slug.'/' }
- ],
- '.fill-new-videos' => [
- -replace_content => { replace_with => $_->video_count }
- ],
- '.fill-total-videos' => [
- -replace_content => { replace_with => $_->bucket->video_count }
- ],
- ] })->as_stream
- }
- ]
- ]
+ 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 show_bucket ($bucket) {
- $self->html_response(bucket => [
- '.fill-bucket-name' => [
- -replace_content => { replace_with => $bucket->name }
- ],
- '#video-list' => [
- -repeat_content => {
- repeat_for => $bucket->videos->map(sub { [
- '.fill-video-name' => [
- -replace_content => { replace_with => $_->name }
- ],
- '.fill-video-author' => [
- -replace_content => { replace_with => $_->author }
- ],
- '.fill-video-link' => [
- -set_attribute => {
- name => 'href', value => $_->slug.'/'
+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/'
+ )
}
- ],
- ] })->as_stream
- }
- ]
- ]);
-}
-
-method show_video ($video) {
- $self->html_response(video => [
- '.fill-video-name' => [
- -replace_content => { replace_with => $video->name }
- ],
- '.fill-author-name' => [
- -replace_content => { replace_with => $video->author }
- ],
- '.fill-bucket-link' => [
- -set_attribute => { name => 'href', value => '../' }
- ],
- '.fill-bucket-name' => [
- -replace_content => { replace_with => $video->bucket->name }
- ],
- '.fill-video-details' => [
- -replace_content => { replace_with => $video->details }
- ]
- ]);
-}
-
-method html_response ($template_name, $selectors) {
- my $io = $self->_zoom_for($template_name => $selectors)->as_readable_fh;
+ }))
+ ->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 _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(
$self->_template_filename_for($template_name)
)
- ->with_selectors(
- '#main-content' => [
- -capture_events => { into => \@body }
- ]
- )
+ ->select('#main-content')->collect_content({ into => \@body })
->run;
- $self->_layout_zoom->with_selectors(
- '#main-content' => [
- -replace_content_events => { replace_with => \@body }
- ]
- )->to_zoom;
- })->with_selectors($selectors)
+ $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;
projects / catagits/App-IdiotBox.git / blobdiff