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 use App::IdiotBox::Announcement;
  11 use App::IdiotBox::Bucket;
  12 use App::IdiotBox::Video;
  13
  14 has $_ => (is => 'ro') for qw(recent_announcements buckets);
  15
  16 sub default_config {
  17   template_dir => 'share/html',
  18   store => 'SQLite',
  19   db_file => 'var/lib/idiotbox.db',
  20   base_url => 'http://localhost:3000/',
  21   base_dir => do { use FindBin; $FindBin::Bin },
  22 }
  23
  24 sub BUILD {
  25   my $self = shift;
  26   my $store;
  27   ($store = $self->config->{store}) =~ /^(\w+)$/
  28     or die "Store config should be just a name, got ${store} instead";
  29   my $store_class = "App::IdiotBox::Store::${store}";
  30   eval "require ${store_class}; 1"
  31     or die "Couldn't load ${store} store: $@";
  32   $store_class->bind($self);
  33 }
  34
  35 sub dispatch_request {
  36   my $self = shift;
  37   sub (/) { $self->show_front_page },
  38
  39   sub (/admin/) {
  40     sub (%new_name=&new_slug=) {
  41         my ($self, $name, $slug) = @_;
  42
  43         my ($nb, $err) = App::IdiotBox::Bucket->create(
  44           slug => $slug,
  45           name => $name,
  46         );
  47
  48         return $self->show_admin_page(error => $err) if $err;
  49
  50         my $nb = $self->buckets->add($nb);
  51
  52         $self->show_admin_page;
  53     },
  54   },
  55   sub (/admin/) { $self->show_admin_page },
  56
  57   sub (/admin/*/...) {
  58     my $bucket = $self->buckets->get({ slug => $_[1] });
  59     sub (%new_name=) {
  60       my ($self, $new_name) = @_;
  61
  62       my ($ub, $err) = $bucket->update(
  63         name => $new_name,
  64       );
  65
  66       return $self->show_admin_page(error => $err) if $err;
  67
  68       $self->buckets->replace($bucket, $ub);
  69
  70       $self->show_bucket_edited_page($bucket);
  71     },
  72     sub (/) {
  73       $self->show_edit_bucket_page($bucket);
  74     },
  75     sub (/delete/) {
  76       $self->show_confirm_delete_bucket_page($bucket)
  77     },
  78     sub (/delete/yes/) {
  79       $self->buckets->remove({ slug => $bucket->slug });
  80       $self->show_bucket_deleted_page($bucket->slug);
  81     },
  82   },
  83   sub (/*/...) {
  84     my $bucket = $self->buckets->get({ slug => $_[1] });
  85     sub (/) {
  86       $self->show_bucket($bucket)
  87     },
  88     sub (/*/) {
  89       $self->show_video($bucket->videos->get({ slug => $_[1] }));
  90     }
  91   }
  92 }
  93
  94 sub show_front_page {
  95   my $self = shift;
  96   my $ann = $self->recent_announcements;
  97   $self->html_response(
  98     front_page => sub {
  99       $_->select('#announcement-list')
 100         ->repeat_content($ann->map(sub {
 101             my $obj = $_;
 102             sub {
 103               $_->select('.bucket-name')->replace_content($obj->bucket->name)
 104                 ->select('.made-at')->replace_content($obj->made_at)
 105                 ->select('.bucket-link')->set_attribute(
 106                     'href' => $obj->bucket->slug.'/'
 107                   )
 108                 ->select('.new-videos')->replace_content($obj->video_count)
 109                 ->select('.total-videos')->replace_content(
 110                     $obj->bucket->video_count
 111                   )
 112             }
 113           }))
 114     }
 115   );
 116 }
 117
 118 sub show_admin_page {
 119   my $self = shift;
 120   my %opts = @_;
 121   my $error = $opts{error} || '';
 122
 123   my $bucket = $self->buckets;
 124   $self->html_response(
 125     admin => sub {
 126       $_->select('#bucket-list')
 127         ->repeat_content($bucket->map(sub {
 128             my $obj = $_;
 129             sub {
 130               $_->select('.bucket-slug')->replace_content($obj->slug)
 131                 ->select('.bucket-name')->replace_content($obj->name)
 132                 ->select('.edit-link')->set_attribute(
 133                     'href' => $obj->slug.'/'
 134                   )
 135                 ->select('.delete-link')->set_attribute(
 136                     'href' => $obj->slug.'/delete/'
 137                   )
 138             }
 139           }))
 140         ->select('.error-text')->replace_content($error)
 141
 142     }
 143
 144   );
 145 }
 146
 147 sub show_confirm_delete_bucket_page {
 148   my ($self, $bucket) = @_;
 149   $self->html_response('delete' => sub {
 150     $_->select('.bucket-name')->replace_content($bucket->name)
 151       ->select('.confirm-yes')->set_attribute(
 152         'href' => 'yes/'
 153         )
 154   });
 155 }
 156
 157 sub show_edit_bucket_page {
 158   my ($self, $bucket, %opt) = @_;
 159   my $error = $opt{error} || '';
 160   $self->html_response('edit' => sub {
 161     $_->select('.bucket-name')->replace_content($bucket->name)
 162       ->select('.error-text')->replace_content($error);
 163   });
 164 }
 165
 166 sub show_bucket_deleted_page {
 167   my ($self, $name) = @_;
 168   $self->html_response('deleted' => sub {
 169     $_->select('.bucket-name')->replace_content($name)
 170   });
 171 }
 172
 173 sub show_bucket_edited_page {
 174   my ($self, $name) = @_;
 175   $self->html_response('edited' => sub {
 176     $_->select('.bucket-name')->replace_content($name)
 177   });
 178 }
 179
 180 sub show_bucket {
 181   my ($self, $bucket) = @_;
 182   $self->html_response(bucket => sub {
 183     $_->select('.bucket-name')->replace_content($bucket->name)
 184       ->select('#video-list')->repeat_content($bucket->videos->map(sub {
 185           my $video = $_;
 186           sub {
 187             $_->select('.video-name')->replace_content($video->name)
 188               ->select('.video-author')->replace_content($video->author)
 189               ->select('.video-link')->set_attribute(
 190                   href => $video->slug.'/'
 191                 )
 192           }
 193         }))
 194   });
 195 }
 196
 197 sub show_video {
 198   my ($self, $video) = @_;
 199   my $video_file = first {
 200     -e join('/', $self->config->{base_dir}, $_)
 201   } map {
 202     join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_")
 203   } @SupportedFormats;
 204   $self->html_response(video => sub {
 205     my $video_url =
 206       $self->base_url
 207       .($video_file||'NO FILE FOUND SORRY');
 208
 209     $_->select('.video-name')->replace_content($video->name)
 210       ->select('.author-name')->replace_content($video->author)
 211       ->select('.bucket-link')->set_attribute(
 212           href => '../'
 213         )
 214       ->select('.bucket-name')->replace_content($video->bucket->name)
 215       ->select('.video-details')->replace_content($video->details)
 216       ->select('script')->template_text_raw({ video_url => $video_url });
 217   });
 218 }
 219
 220 sub html_response {
 221   my ($self, $template_name, $selectors) = @_;
 222   my $io = $self->_zoom_for($template_name => $selectors)->to_fh;
 223   return [ 200, [ 'Content-Type' => 'text/html' ], $io ]
 224 }
 225
 226 sub _template_filename_for {
 227   my ($self, $name) = @_;
 228   $self->{config}{template_dir}.'/'.$name.'.html';
 229 }
 230
 231 sub _layout_zoom {
 232   my $self = shift;
 233   $self->{layout_zoom} ||= HTML::Zoom->from_file(
 234     $self->_template_filename_for('layout')
 235   )
 236 }
 237
 238 sub _zoom_for {
 239   my ($self, $template_name, $selectors) = @_;
 240   ($self->{zoom_for_template}{$template_name} ||= do {
 241     my @body;
 242     HTML::Zoom->from_file(
 243                   $self->_template_filename_for($template_name)
 244                 )
 245               ->select('#main-content')->collect_content({ into => \@body })
 246               ->run;
 247     $self->_layout_zoom
 248          ->select('#main-content')->replace_content(\@body)
 249          ->memoize;
 250   })->apply($selectors);
 251 }
 252
 253 sub base_url {
 254   my $self = shift;
 255   $self->{base_url} ||= do {
 256     (my $u = $self->config->{base_url}) =~ s/\/$//;
 257     "${u}/";
 258   }
 259 }
 260
 261 sub _run_cli {
 262   my $self = shift;
 263   unless (@ARGV == 1 && $ARGV[0] eq 'import') {
 264     return $self->SUPER::_run_cli(@_);
 265   }
 266   $self->cli_import;
 267 }
 268
 269 sub _cli_usage {
 270   my $self = shift;
 271   "To import data into your idiotbox install, chdir into a directory\n".
 272   "containing video files and run:\n".
 273   "\n".
 274   "  $0 import\n".
 275   "\n".
 276   $self->SUPER::_cli_usage(@_);
 277 }
 278
 279 sub cli_import {
 280   my $self = shift;
 281   require App::IdiotBox::Importer;
 282   App::IdiotBox::Importer->run($self);
 283 }
 284
 285 1;