lib/App/IdiotBox.pm

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