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