lib/App/IdiotBox.pm

   1 package App::IdiotBox;
   2
   3 use App::IdiotBox::Common qw(@SupportedFormats);
   4 use Web::Simple __PACKAGE__;
   5 use FindBin;
   6 use HTML::Zoom;
   7 use HTML::Zoom::FilterBuilder::Template;
   8 use List::Util qw(first);
   9
  10 {
  11   package App::IdiotBox::Announcement;
  12
  13   sub id { shift->{id} }
  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} }
  22   sub video_count {
  23     exists $_[0]->{video_count}
  24       ? $_[0]->{video_count}
  25       : $_[0]->{videos}->count
  26   }
  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} }
  36   sub file_name {
  37     (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g;
  38     $s;
  39   }
  40   sub url_path {
  41     join('/', $_[0]->bucket->slug, $_[0]->slug);
  42   }
  43 }
  44
  45 has $_ => (is => 'ro') for qw(recent_announcements buckets);
  46
  47 sub default_config {
  48   template_dir => 'share/html',
  49   store => 'SQLite',
  50   db_file => 'var/lib/idiotbox.db',
  51   base_url => 'http://localhost:3000/',
  52   base_dir => do { use FindBin; $FindBin::Bin },
  53 }
  54
  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
  66 sub dispatch_request {
  67   my $self = shift;
  68   sub (/) { $self->show_front_page },
  69   sub (/*/...) {
  70     my $bucket = $self->buckets->get({ slug => $_[1] });
  71     sub (/) {
  72       $self->show_bucket($bucket)
  73     },
  74     sub (/*/) {
  75       $self->show_video($bucket->videos->get({ slug => $_[1] }));
  76     }
  77   }
  78 }
  79
  80 sub show_front_page {
  81   my $self = shift;
  82   my $ann = $self->recent_announcements;
  83   $self->html_response(
  84     front_page => sub {
  85       $_->select('#announcement-list')
  86         ->repeat_content($ann->map(sub {
  87             my $obj = $_;
  88             sub {
  89               $_->select('.bucket-name')->replace_content($obj->bucket->name)
  90                 ->select('.made-at')->replace_content($obj->made_at)
  91                 ->select('.bucket-link')->set_attribute(
  92                     'href' => $obj->bucket->slug.'/'
  93                   )
  94                 ->select('.new-videos')->replace_content($obj->video_count)
  95                 ->select('.total-videos')->replace_content(
  96                     $obj->bucket->video_count
  97                   )
  98             }
  99           }))
 100     }
 101   );
 102 }
 103
 104 sub show_bucket {
 105   my ($self, $bucket) = @_;
 106   $self->html_response(bucket => sub {
 107     $_->select('.bucket-name')->replace_content($bucket->name)
 108       ->select('#video-list')->repeat_content($bucket->videos->map(sub {
 109           my $video = $_;
 110           sub {
 111             $_->select('.video-name')->replace_content($video->name)
 112               ->select('.video-author')->replace_content($video->author)
 113               ->select('.video-link')->set_attribute(
 114                   href => $video->slug.'/'
 115                 )
 116           }
 117         }))
 118   });
 119 }
 120
 121 sub show_video {
 122   my ($self, $video) = @_;
 123   my $video_file = first {
 124     -e join('/', $self->config->{base_dir}, $_)
 125   } map {
 126     join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_")
 127   } @SupportedFormats;
 128   $self->html_response(video => sub {
 129     my $video_url =
 130       $self->base_url
 131       .($video_file||'NO FILE FOUND SORRY');
 132
 133     $_->select('.video-name')->replace_content($video->name)
 134       ->select('.author-name')->replace_content($video->author)
 135       ->select('.bucket-link')->set_attribute(
 136           href => '../'
 137         )
 138       ->select('.bucket-name')->replace_content($video->bucket->name)
 139       ->select('.video-details')->replace_content($video->details)
 140       ->select('script')->template_text_raw({ video_url => $video_url });
 141   });
 142 }
 143
 144 sub html_response {
 145   my ($self, $template_name, $selectors) = @_;
 146   my $io = $self->_zoom_for($template_name => $selectors)->to_fh;
 147   return [ 200, [ 'Content-Type' => 'text/html' ], $io ]
 148 }
 149
 150 sub _template_filename_for {
 151   my ($self, $name) = @_;
 152   $self->{config}{template_dir}.'/'.$name.'.html';
 153 }
 154
 155 sub _layout_zoom {
 156   my $self = shift;
 157   $self->{layout_zoom} ||= HTML::Zoom->from_file(
 158     $self->_template_filename_for('layout')
 159   )
 160 }
 161
 162 sub _zoom_for {
 163   my ($self, $template_name, $selectors) = @_;
 164   ($self->{zoom_for_template}{$template_name} ||= do {
 165     my @body;
 166     HTML::Zoom->from_file(
 167                   $self->_template_filename_for($template_name)
 168                 )
 169               ->select('#main-content')->collect_content({ into => \@body })
 170               ->run;
 171     $self->_layout_zoom
 172          ->select('#main-content')->replace_content(\@body)
 173          ->memoize;
 174   })->apply($selectors);
 175 }
 176
 177 sub base_url {
 178   my $self = shift;
 179   $self->{base_url} ||= do {
 180     (my $u = $self->config->{base_url}) =~ s/\/$//;
 181     "${u}/";
 182   }
 183 }
 184
 185 sub _run_cli {
 186   my $self = shift;
 187   unless (@ARGV == 1 && $ARGV[0] eq 'import') {
 188     return $self->SUPER::_run_cli(@_);
 189   }
 190   $self->cli_import;
 191 }
 192
 193 sub _cli_usage {
 194   my $self = shift;
 195   "To import data into your idiotbox install, chdir into a directory\n".
 196   "containing video files and run:\n".
 197   "\n".
 198   "  $0 import\n".
 199   "\n".
 200   $self->SUPER::_cli_usage(@_);
 201 }
 202
 203 sub cli_import {
 204   my $self = shift;
 205   require App::IdiotBox::Importer;
 206   App::IdiotBox::Importer->run($self);
 207 }
 208
 209 1;