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
  22   my $bucket;
  23
  24   BUCKETS: {
  25     foreach my $idx (0 .. $#buckets) {
  26       my $bucket = $buckets[$idx];
  27       $bucket_by_slug{$bucket->slug} = $bucket;
  28       log_info { "(${idx}) ${\$bucket->slug} : ${\$bucket->name}" };
  29     }
  30     log_info { sprintf("(%d) new : Create new bucket\n", $#buckets + 1) };
  31
  32     CHOOSE: {
  33       my $choice = prompt("Which bucket to import into (by number or slug) ?");
  34       if ($choice =~ /^\d+$/) {
  35         $bucket = $buckets[$choice];
  36       } else {
  37         $bucket = $bucket_by_slug{$choice};
  38       }
  39
  40       if (!$bucket && ($choice eq 'new' || $choice eq $#buckets + 1)) {
  41         my $sn = prompt("What's the new short name (url path) for the slug ?");
  42         my $ln = prompt("What's the new long name (description) for the slug ?");
  43
  44         my ($nb, $err) = App::IdiotBox::Bucket->create(
  45           slug => $sn,
  46           name => $ln,
  47         );
  48
  49         if ($err) {
  50           log_info { "Error creating new bucket: $err" };
  51           redo CHOOSE;
  52         }
  53
  54         my $rnb = $ib->buckets->add($nb);
  55
  56         log_info { "Created new bucket" };
  57         push @buckets, $rnb;
  58         redo BUCKETS;
  59       }
  60
  61       unless ($bucket) {
  62         log_info {
  63            "No bucket for ${choice} - valid options are 0 to ${\$#buckets + 1}"
  64            ." or slug (e.g. ${\$buckets[0]->slug})"
  65          };
  66          redo CHOOSE;
  67       }
  68     }
  69   }
  70   my $ann = $ib->recent_announcements->add(bless({
  71     bucket => $bucket,
  72     made_at => strftime("%Y-%m-%d %H:%M:%S",localtime),
  73   }, 'App::IdiotBox::Announcement'));
  74
  75   log_info { "Created new announcement, id ".$ann->id };
  76
  77   my $video_files = $class->video_files_from_dir(my $source_dir = cwd);
  78
  79   my %videos;
  80
  81   foreach my $video_file (keys %{$video_files}) {
  82
  83     log_info { "Processing file ${video_file}" };
  84     my @parts = split(/[- ]+/, $video_file);
  85     my @options;
  86     foreach my $idx (1 .. $#parts) {
  87       my @opt = @{$options[$idx] = [
  88         join(' ', @parts[0..$idx-1]),
  89         join(' ', @parts[$idx..$#parts]),
  90       ]};
  91       log_info { "(${idx}) ".join(' / ', @opt) };
  92     }
  93     my $info;
  94     CHOICE: {
  95       my $choice = prompt(
  96         'What author is this for (enter number for pre-selected combination) ?',
  97         2
  98       );
  99       if ($choice =~ /^\d+$/) {
 100         @{$info}{qw(author name)} = @{$options[$choice] || redo CHOICE};
 101       } else {
 102         $info->{author} = $choice;
 103       }
 104     }
 105     $info->{name} = prompt('What is the name of this talk?', $info->{name});
 106     (my $slug = lc $info->{name}) =~ s/ /-/g;
 107     $info->{slug} = prompt('What is the slug for this talk?', $slug);
 108     $info->{bucket} = $bucket;
 109     $info->{announcement} = $ann;
 110     $info->{announcement_id} = $ann->id; # Temp fix so INSERT behaves -- alh
 111     $videos{$video_file} = bless($info, 'App::IdiotBox::Video');
 112   }
 113   foreach my $video_file (keys %videos) {
 114     my $video = $videos{$video_file};
 115     my $target_dir = catdir($ib->config->{base_dir}, $video->url_path);
 116     io($target_dir)->mkpath;
 117     log_info { "Copying video files to ${target_dir}"};
 118     foreach my $ext (@{$video_files->{$video_file}}) {
 119       no warnings 'void';
 120       io(catfile($target_dir, "${\$video->file_name}.${ext}"))
 121         < io(catfile($source_dir, "${video_file}.${ext}"));
 122     }
 123   }
 124
 125   $bucket->videos->add($_) for values %videos;
 126 }
 127
 128 sub video_files_from_dir {
 129   my ($class, $dir) = @_;
 130   my %videos;
 131   foreach my $file (io($dir)->all_files) {
 132     $file->filename =~ /^([^\.]+)\.($supported_formats_re)$/ or next;
 133     push(@{$videos{$1}||=[]}, $2);
 134   }
 135   \%videos;
 136 }
 137
 138 1;