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 (/admin/) {
  70     sub (%new_name=&new_slug=) {
  71         my ($self, $name, $slug) = @_;
  72
  73         unless ($name && $slug) {
  74                 return $self->show_admin_page(error => "Please enter a name and a bucket");
  75         }
  76         if ($name =~ /^\s+$/ || $slug =~ /^\s+$/) {
  77                 return $self->show_admin_page(error => "Names/buckets must not be all whitespace");
  78         }
  79
  80         $slug =~ s/ /-/g;
  81
  82         my $nb = $self->buckets->add(bless({
  83           slug => $slug,
  84           name => $name,
  85         }, 'App::IdiotBox::Bucket'));
  86
  87         $self->show_admin_page;
  88     },
  89   },
  90   sub (/admin/) { $self->show_admin_page },
  91
  92   sub (/admin/*/...) {
  93     my $bucket = $self->buckets->get({ slug => $_[1] });
  94     sub (%new_name=) {
  95       my ($self, $new_name) = @_;
  96       if (!$new_name) {
  97         return $self->show_edit_bucket_page($bucket, error => "Please enter a new name");
  98       } elsif ($new_name =~ /^\s+$/) {
  99         return $self->show_edit_bucket_page($bucket, error => "Names must not be all whitespace");
 100       }
 101       $self->buckets->replace($bucket, bless({
 102           slug => $bucket->slug,
 103           name => $new_name,
 104         }, 'App::IdiotBox::Bucket'));
 105       $self->show_bucket_edited_page($bucket);
 106     },
 107     sub (/) {
 108       $self->show_edit_bucket_page($bucket);
 109     },
 110     sub (/delete/) {
 111       $self->show_confirm_delete_bucket_page($bucket)
 112     },
 113     sub (/delete/yes/) {
 114       $self->buckets->remove({ slug => $bucket->slug });
 115       $self->show_bucket_deleted_page($bucket->slug);
 116     },
 117   },
 118   sub (/*/...) {
 119     my $bucket = $self->buckets->get({ slug => $_[1] });
 120     sub (/) {
 121       $self->show_bucket($bucket)
 122     },
 123     sub (/*/) {
 124       $self->show_video($bucket->videos->get({ slug => $_[1] }));
 125     }
 126   }
 127 }
 128
 129 sub show_front_page {
 130   my $self = shift;
 131   my $ann = $self->recent_announcements;
 132   $self->html_response(
 133     front_page => sub {
 134       $_->select('#announcement-list')
 135         ->repeat_content($ann->map(sub {
 136             my $obj = $_;
 137             sub {
 138               $_->select('.bucket-name')->replace_content($obj->bucket->name)
 139                 ->select('.made-at')->replace_content($obj->made_at)
 140                 ->select('.bucket-link')->set_attribute(
 141                     'href' => $obj->bucket->slug.'/'
 142                   )
 143                 ->select('.new-videos')->replace_content($obj->video_count)
 144                 ->select('.total-videos')->replace_content(
 145                     $obj->bucket->video_count
 146                   )
 147             }
 148           }))
 149     }
 150   );
 151 }
 152
 153 sub show_admin_page {
 154   my $self = shift;
 155   my %opts = @_;
 156   my $error = $opts{error} || '';
 157
 158   my $bucket = $self->buckets;
 159   $self->html_response(
 160     admin => sub {
 161       $_->select('#bucket-list')
 162         ->repeat_content($bucket->map(sub {
 163             my $obj = $_;
 164             sub {
 165               $_->select('.bucket-slug')->replace_content($obj->slug)
 166                 ->select('.bucket-name')->replace_content($obj->name)
 167                 ->select('.edit-link')->set_attribute(
 168                     'href' => $obj->slug.'/'
 169                   )
 170                 ->select('.delete-link')->set_attribute(
 171                     'href' => $obj->slug.'/delete/'
 172                   )
 173             }
 174           }))
 175         ->select('.error-text')->replace_content($error)
 176
 177     }
 178
 179   );
 180 }
 181
 182 sub show_confirm_delete_bucket_page {
 183   my ($self, $bucket) = @_;
 184   $self->html_response('delete' => sub {
 185     $_->select('.bucket-name')->replace_content($bucket->name)
 186       ->select('.confirm-yes')->set_attribute(
 187         'href' => 'yes/'
 188         )
 189   });
 190 }
 191
 192 sub show_edit_bucket_page {
 193   my ($self, $bucket, %opt) = @_;
 194   my $error = $opt{error} || '';
 195   $self->html_response('edit' => sub {
 196     $_->select('.bucket-name')->replace_content($bucket->name)
 197       ->select('.error-text')->replace_content($error);
 198   });
 199 }
 200
 201 sub show_bucket_deleted_page {
 202   my ($self, $name) = @_;
 203   $self->html_response('deleted' => sub {
 204     $_->select('.bucket-name')->replace_content($name)
 205   });
 206 }
 207
 208 sub show_bucket_edited_page {
 209   my ($self, $name) = @_;
 210   $self->html_response('edited' => sub {
 211     $_->select('.bucket-name')->replace_content($name)
 212   });
 213 }
 214
 215 sub show_bucket {
 216   my ($self, $bucket) = @_;
 217   $self->html_response(bucket => sub {
 218     $_->select('.bucket-name')->replace_content($bucket->name)
 219       ->select('#video-list')->repeat_content($bucket->videos->map(sub {
 220           my $video = $_;
 221           sub {
 222             $_->select('.video-name')->replace_content($video->name)
 223               ->select('.video-author')->replace_content($video->author)
 224               ->select('.video-link')->set_attribute(
 225                   href => $video->slug.'/'
 226                 )
 227           }
 228         }))
 229   });
 230 }
 231
 232 sub show_video {
 233   my ($self, $video) = @_;
 234   my $video_file = first {
 235     -e join('/', $self->config->{base_dir}, $_)
 236   } map {
 237     join('/', $video->bucket->slug, $video->slug, $video->file_name.".$_")
 238   } @SupportedFormats;
 239   $self->html_response(video => sub {
 240     my $video_url =
 241       $self->base_url
 242       .($video_file||'NO FILE FOUND SORRY');
 243
 244     $_->select('.video-name')->replace_content($video->name)
 245       ->select('.author-name')->replace_content($video->author)
 246       ->select('.bucket-link')->set_attribute(
 247           href => '../'
 248         )
 249       ->select('.bucket-name')->replace_content($video->bucket->name)
 250       ->select('.video-details')->replace_content($video->details)
 251       ->select('script')->template_text_raw({ video_url => $video_url });
 252   });
 253 }
 254
 255 sub html_response {
 256   my ($self, $template_name, $selectors) = @_;
 257   my $io = $self->_zoom_for($template_name => $selectors)->to_fh;
 258   return [ 200, [ 'Content-Type' => 'text/html' ], $io ]
 259 }
 260
 261 sub _template_filename_for {
 262   my ($self, $name) = @_;
 263   $self->{config}{template_dir}.'/'.$name.'.html';
 264 }
 265
 266 sub _layout_zoom {
 267   my $self = shift;
 268   $self->{layout_zoom} ||= HTML::Zoom->from_file(
 269     $self->_template_filename_for('layout')
 270   )
 271 }
 272
 273 sub _zoom_for {
 274   my ($self, $template_name, $selectors) = @_;
 275   ($self->{zoom_for_template}{$template_name} ||= do {
 276     my @body;
 277     HTML::Zoom->from_file(
 278                   $self->_template_filename_for($template_name)
 279                 )
 280               ->select('#main-content')->collect_content({ into => \@body })
 281               ->run;
 282     $self->_layout_zoom
 283          ->select('#main-content')->replace_content(\@body)
 284          ->memoize;
 285   })->apply($selectors);
 286 }
 287
 288 sub base_url {
 289   my $self = shift;
 290   $self->{base_url} ||= do {
 291     (my $u = $self->config->{base_url}) =~ s/\/$//;
 292     "${u}/";
 293   }
 294 }
 295
 296 sub _run_cli {
 297   my $self = shift;
 298   unless (@ARGV == 1 && $ARGV[0] eq 'import') {
 299     return $self->SUPER::_run_cli(@_);
 300   }
 301   $self->cli_import;
 302 }
 303
 304 sub _cli_usage {
 305   my $self = shift;
 306   "To import data into your idiotbox install, chdir into a directory\n".
 307   "containing video files and run:\n".
 308   "\n".
 309   "  $0 import\n".
 310   "\n".
 311   $self->SUPER::_cli_usage(@_);
 312 }
 313
 314 sub cli_import {
 315   my $self = shift;
 316   require App::IdiotBox::Importer;
 317   App::IdiotBox::Importer->run($self);
 318 }
 319
 320 1;