From: markie Date: Mon, 1 Mar 2010 03:10:02 +0000 (-0800) Subject: add importing support to idiotbox X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FApp-IdiotBox.git;a=commitdiff_plain;h=ebba317f0281d7818fff5584f3b202e30c53182f add importing support to idiotbox --- diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm index dff116b..0f28b4a 100644 --- a/lib/App/IdiotBox.pm +++ b/lib/App/IdiotBox.pm @@ -9,6 +9,7 @@ use HTML::Zoom::FilterBuilder::Template; { package App::IdiotBox::Announcement; + sub id { shift->{id} } sub made_at { shift->{made_at} } sub bucket { shift->{bucket} } sub video_count { shift->{video_count} } @@ -35,6 +36,9 @@ use HTML::Zoom::FilterBuilder::Template; (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g; $s; } + sub url_path { + join('/', $_[0]->bucket->slug, $_[0]->slug); + } } default_config( @@ -42,6 +46,7 @@ default_config( store => 'SQLite', db_file => 'var/lib/idiotbox.db', base_url => 'http://localhost:3000/', + base_dir => do { use FindBin; $FindBin::Bin }, ); sub BUILD { @@ -165,4 +170,25 @@ method base_url { } } +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; diff --git a/lib/App/IdiotBox/DataSet.pm b/lib/App/IdiotBox/DataSet.pm index b238364..0057d13 100644 --- a/lib/App/IdiotBox/DataSet.pm +++ b/lib/App/IdiotBox/DataSet.pm @@ -22,9 +22,32 @@ sub _inflate { 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; diff --git a/lib/App/IdiotBox/Importer.pm b/lib/App/IdiotBox/Importer.pm new file mode 100644 index 0000000..b7ba153 --- /dev/null +++ b/lib/App/IdiotBox/Importer.pm @@ -0,0 +1,109 @@ +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; diff --git a/lib/App/IdiotBox/Store/SQLite.pm b/lib/App/IdiotBox/Store/SQLite.pm index 377c87b..accf668 100644 --- a/lib/App/IdiotBox/Store/SQLite.pm +++ b/lib/App/IdiotBox/Store/SQLite.pm @@ -21,7 +21,6 @@ my (%BIND, %SQL); deflate => sub { my ($self, $obj) = @_; my %raw = %$obj; - delete $raw{bucket}; \%raw; } }, @@ -36,7 +35,7 @@ my (%BIND, %SQL); $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 => { @@ -97,6 +96,22 @@ my (%BIND, %SQL); 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) ], @@ -105,6 +120,10 @@ my (%BIND, %SQL); FROM buckets WHERE slug = ? }, + select_sql => q{ + SELECT slug, name + FROM buckets + }, select_single_argument_order => [ 'slug' ], }, bucket_videos => { @@ -113,14 +132,24 @@ my (%BIND, %SQL); 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) + ], }, );