Don't import files if they don't have the supportted format extension,
[catagits/App-IdiotBox.git] / lib / App / IdiotBox / Importer.pm
1 package App::IdiotBox::Importer;
2
3 use strict;
4 use warnings FATAL => 'all';
5 use App::IdiotBox::Common qw(@SupportedFormats);
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
12 my $supported_formats_re = join('|', @SupportedFormats);
13
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;
85     $info->{announcement_id} = $ann->id; # Temp fix so INSERT behaves -- alh
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) {
107     $file->filename =~ /^([^\.]+)\.($supported_formats_re)$/ or next;
108     push(@{$videos{$1}||=[]}, $2);
109   }
110   \%videos;
111 }
112
113 1;