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