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