{
package App::IdiotBox::Announcement;
+ sub id { shift->{id} }
sub made_at { shift->{made_at} }
sub bucket { shift->{bucket} }
sub video_count { shift->{video_count} }
(my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g;
$s;
}
+ sub url_path {
+ join('/', $_[0]->bucket->slug, $_[0]->slug);
+ }
}
default_config(
store => 'SQLite',
db_file => 'var/lib/idiotbox.db',
base_url => 'http://localhost:3000/',
+ base_dir => do { use FindBin; $FindBin::Bin },
);
sub BUILD {
}
}
+method _run_cli {
+ unless (@ARGV == 1 && $ARGV[0] eq 'import') {
+ return $self->SUPER::_run_cli(@_);
+ }
+ $self->cli_import;
+}
+
+method _cli_usage {
+ "To import data into your idiotbox install, chdir into a directory\n".
+ "containing video files and run:\n".
+ "\n".
+ " $0 import\n".
+ "\n".
+ $self->SUPER::_cli_usage(@_);
+}
+
+method cli_import {
+ require App::IdiotBox::Importer;
+ App::IdiotBox::Importer->run($self);
+}
+
1;
sub _deflate {
my ($self, $obj) = @_;
- $self->_class->{deflate}->($self, $obj)
+ my $fat_raw = $self->_class->{deflate}->($self, $obj);
+ $self->_splat($fat_raw)
}
-sub _merge { die "no" }
+sub _splat {
+ my ($self, $fat) = @_;
+ my %raw;
+ foreach my $key (keys %$fat) {
+ my $v = $fat->{$key};
+ $v = { %$v } if blessed($v);
+ if (ref($v) eq 'HASH') {
+ #my $splat = $self->_splat($v);
+ my $splat = $v;
+ @raw{map "${key}.$_", keys %$splat} = values %$splat;
+ } else {
+ $raw{$key} = $v;
+ }
+ }
+ \%raw
+}
+
+sub _merge {
+ my ($self, $new, $to_merge) = @_;
+#require Carp; warn Carp::longmess; warn $new; warn $to_merge;
+ @{$new}{keys %$to_merge} = values %$to_merge;
+ return
+}
1;
--- /dev/null
+package App::IdiotBox::Importer;
+
+use strict;
+use warnings FATAL => 'all';
+use Cwd;
+use IO::All;
+use ExtUtils::MakeMaker qw(prompt);
+use File::Spec::Functions qw(catfile catdir);
+use POSIX qw(strftime);
+
+sub log_info (&) { print $_[0]->(), "\n"; }
+
+sub run {
+ my ($class, $ib) = @_;
+ my @buckets = $ib->buckets->flatten;
+ my %bucket_by_slug;
+ log_info { "Available buckets to import into:" };
+ foreach my $idx (0 .. $#buckets) {
+ my $bucket = $buckets[$idx];
+ $bucket_by_slug{$bucket->slug} = $bucket;
+ log_info { "(${idx}) ${\$bucket->slug} : ${\$bucket->name}" };
+ }
+
+ my $bucket;
+
+ CHOOSE: {
+ my $choice = prompt("Which bucket to import into (by number or slug) ?");
+ if ($choice =~ /^\d+$/) {
+ $bucket = $buckets[$choice];
+ } else {
+ $bucket = $bucket_by_slug{$choice};
+ }
+ unless ($bucket) {
+ log_info {
+ "No bucket for ${choice} - valid options are 0 to ${\$#buckets}"
+ ." or slug (e.g. ${\$buckets[0]->slug})"
+ };
+ redo CHOOSE;
+ }
+ }
+
+ my $ann = $ib->recent_announcements->add(bless({
+ bucket => $bucket,
+ made_at => strftime("%Y-%m-%d %H:%M:%S",localtime),
+ }, 'App::IdiotBox::Announcement'));
+
+ log_info { "Created new announcement, id ".$ann->id };
+
+ my $video_files = $class->video_files_from_dir(my $source_dir = cwd);
+
+ my %videos;
+
+ foreach my $video_file (keys %{$video_files}) {
+
+ log_info { "Processing file ${video_file}" };
+ my @parts = split(/[- ]+/, $video_file);
+ my @options;
+ foreach my $idx (1 .. $#parts) {
+ my @opt = @{$options[$idx] = [
+ join(' ', @parts[0..$idx-1]),
+ join(' ', @parts[$idx..$#parts]),
+ ]};
+ log_info { "(${idx}) ".join(' / ', @opt) };
+ }
+ my $info;
+ CHOICE: {
+ my $choice = prompt(
+ 'What author is this for (enter number for pre-selected combination) ?',
+ 2
+ );
+ if ($choice =~ /^\d+$/) {
+ @{$info}{qw(author name)} = @{$options[$choice] || redo CHOICE};
+ } else {
+ $info->{author} = $choice;
+ }
+ }
+ $info->{name} = prompt('What is the name of this talk?', $info->{name});
+ (my $slug = lc $info->{name}) =~ s/ /-/g;
+ $info->{slug} = prompt('What is the slug for this talk?', $slug);
+ $info->{bucket} = $bucket;
+ $info->{announcement} = $ann;
+ $videos{$video_file} = bless($info, 'App::IdiotBox::Video');
+ }
+ foreach my $video_file (keys %videos) {
+ my $video = $videos{$video_file};
+ my $target_dir = catdir($ib->config->{base_dir}, $video->url_path);
+ io($target_dir)->mkpath;
+ log_info { "Copying video files to ${target_dir}"};
+ foreach my $ext (@{$video_files->{$video_file}}) {
+ no warnings 'void';
+ io(catfile($target_dir, "${\$video->file_name}.${ext}"))
+ < io(catfile($source_dir, "${video_file}.${ext}"));
+ }
+ }
+
+ $bucket->videos->add($_) for values %videos;
+}
+
+sub video_files_from_dir {
+ my ($class, $dir) = @_;
+ my %videos;
+ foreach my $file (io($dir)->all_files) {
+ $file->filename =~ /^([^\.]+)\.([^\.]+)$/ or next;
+ push(@{$videos{$1}||=[]}, $2);
+ }
+ \%videos;
+}
+
+1;
deflate => sub {
my ($self, $obj) = @_;
my %raw = %$obj;
- delete $raw{bucket};
\%raw;
}
},
$obj->{videos} = _bind_set('bucket_videos',
{
raw_store => $self->_store->raw_store,
- implicit_arguments => { bucket_slug => $obj->{slug} },
+ implicit_arguments => { 'bucket.slug' => $obj->{slug} },
},
{
class => {
ORDER BY
announcement.made_at DESC
},
+ insert_command_constructor => sub {
+ require DBIx::Data::Store::Command::Insert::LastInsertId;
+ my $self = shift;
+ DBIx::Data::Store::Command::Insert::LastInsertId->new(
+ id_column => 'id',
+ raw_store => $self->raw_store,
+ insert_call_command => $self->raw_store->new_call_command(@_)
+ );
+ },
+ insert_sql => q{
+ INSERT INTO announcements
+ (bucket_slug, made_at)
+ VALUES
+ (?, ?)
+ },
+ insert_argument_order => [ qw(bucket.slug made_at) ],
},
buckets => {
select_column_order => [ qw(slug name) ],
FROM buckets
WHERE slug = ?
},
+ select_sql => q{
+ SELECT slug, name
+ FROM buckets
+ },
select_single_argument_order => [ 'slug' ],
},
bucket_videos => {
SELECT slug, name, author, details
FROM videos
WHERE bucket_slug = ?
+ ORDER BY name
},
- select_argument_order => [ 'bucket_slug' ],
+ select_argument_order => [ 'bucket.slug' ],
select_single_sql => q{
SELECT slug, name, author, details
FROM videos
WHERE bucket_slug = ? AND slug = ?
},
- select_single_argument_order => [ qw(bucket_slug slug) ],
+ select_single_argument_order => [ qw(bucket.slug slug) ],
+ insert_sql => q{
+ INSERT INTO videos
+ (announcement_id, bucket_slug, slug, name, author, details)
+ VALUES
+ (?, ?, ?, ?, ?, '')
+ },
+ insert_argument_order => [
+ qw(announcement.id bucket.slug slug name author)
+ ],
},
);
projects / catagits/App-IdiotBox.git / commitdiff