Commit | Line | Data |
ebba317f |
1 | package App::IdiotBox::Importer; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
625f105e |
5 | use App::IdiotBox::Common qw(@SupportedFormats); |
ebba317f |
6 | use Cwd; |
7 | use IO::All; |
8 | use ExtUtils::MakeMaker qw(prompt); |
9 | use File::Spec::Functions qw(catfile catdir); |
10 | use POSIX qw(strftime); |
11 | |
625f105e |
12 | my $supported_formats_re = join('|', @SupportedFormats); |
13 | |
ebba317f |
14 | sub log_info (&) { print $_[0]->(), "\n"; } |
15 | |
16 | sub run { |
17 | my ($class, $ib) = @_; |
18 | my @buckets = $ib->buckets->flatten; |
19 | my %bucket_by_slug; |
20 | log_info { "Available buckets to import into:" }; |
21 | foreach my $idx (0 .. $#buckets) { |
22 | my $bucket = $buckets[$idx]; |
23 | $bucket_by_slug{$bucket->slug} = $bucket; |
24 | log_info { "(${idx}) ${\$bucket->slug} : ${\$bucket->name}" }; |
25 | } |
26 | |
27 | my $bucket; |
28 | |
29 | CHOOSE: { |
30 | my $choice = prompt("Which bucket to import into (by number or slug) ?"); |
31 | if ($choice =~ /^\d+$/) { |
32 | $bucket = $buckets[$choice]; |
33 | } else { |
34 | $bucket = $bucket_by_slug{$choice}; |
35 | } |
36 | unless ($bucket) { |
37 | log_info { |
38 | "No bucket for ${choice} - valid options are 0 to ${\$#buckets}" |
39 | ." or slug (e.g. ${\$buckets[0]->slug})" |
40 | }; |
41 | redo CHOOSE; |
42 | } |
43 | } |
44 | |
45 | my $ann = $ib->recent_announcements->add(bless({ |
46 | bucket => $bucket, |
47 | made_at => strftime("%Y-%m-%d %H:%M:%S",localtime), |
48 | }, 'App::IdiotBox::Announcement')); |
49 | |
50 | log_info { "Created new announcement, id ".$ann->id }; |
51 | |
52 | my $video_files = $class->video_files_from_dir(my $source_dir = cwd); |
53 | |
54 | my %videos; |
55 | |
56 | foreach my $video_file (keys %{$video_files}) { |
57 | |
58 | log_info { "Processing file ${video_file}" }; |
59 | my @parts = split(/[- ]+/, $video_file); |
60 | my @options; |
61 | foreach my $idx (1 .. $#parts) { |
62 | my @opt = @{$options[$idx] = [ |
63 | join(' ', @parts[0..$idx-1]), |
64 | join(' ', @parts[$idx..$#parts]), |
65 | ]}; |
66 | log_info { "(${idx}) ".join(' / ', @opt) }; |
67 | } |
68 | my $info; |
69 | CHOICE: { |
70 | my $choice = prompt( |
71 | 'What author is this for (enter number for pre-selected combination) ?', |
72 | 2 |
73 | ); |
74 | if ($choice =~ /^\d+$/) { |
75 | @{$info}{qw(author name)} = @{$options[$choice] || redo CHOICE}; |
76 | } else { |
77 | $info->{author} = $choice; |
78 | } |
79 | } |
80 | $info->{name} = prompt('What is the name of this talk?', $info->{name}); |
81 | (my $slug = lc $info->{name}) =~ s/ /-/g; |
82 | $info->{slug} = prompt('What is the slug for this talk?', $slug); |
83 | $info->{bucket} = $bucket; |
84 | $info->{announcement} = $ann; |
ce2b1e73 |
85 | $info->{announcement_id} = $ann->id; # Temp fix so INSERT behaves -- alh |
ebba317f |
86 | $videos{$video_file} = bless($info, 'App::IdiotBox::Video'); |
87 | } |
88 | foreach my $video_file (keys %videos) { |
89 | my $video = $videos{$video_file}; |
90 | my $target_dir = catdir($ib->config->{base_dir}, $video->url_path); |
91 | io($target_dir)->mkpath; |
92 | log_info { "Copying video files to ${target_dir}"}; |
93 | foreach my $ext (@{$video_files->{$video_file}}) { |
94 | no warnings 'void'; |
95 | io(catfile($target_dir, "${\$video->file_name}.${ext}")) |
96 | < io(catfile($source_dir, "${video_file}.${ext}")); |
97 | } |
98 | } |
99 | |
100 | $bucket->videos->add($_) for values %videos; |
101 | } |
102 | |
103 | sub video_files_from_dir { |
104 | my ($class, $dir) = @_; |
105 | my %videos; |
106 | foreach my $file (io($dir)->all_files) { |
625f105e |
107 | $file->filename =~ /^([^\.]+)\.($supported_formats_re)$/ or next; |
ebba317f |
108 | push(@{$videos{$1}||=[]}, $2); |
109 | } |
110 | \%videos; |
111 | } |
112 | |
113 | 1; |