Adding support for video file sizes

diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm
index 88e90c6..3a62cc5 100644 (file)
--- a/lib/App/IdiotBox.pm
+++ b/lib/App/IdiotBox.pm
@@ -32,6 +32,8 @@ use List::Util qw(first);
   sub author { shift->{author} }
   sub details { shift->{details} }
   sub bucket { shift->{bucket} }
+  sub width { shift->{width} }
+  sub height { shift->{width} }
   sub file_name {
     (my $s = join(' ', @{+shift}{qw(author name)})) =~ s/ /-/g;
     $s;

diff --git a/lib/App/IdiotBox/Importer.pm b/lib/App/IdiotBox/Importer.pm
index b7ba153..b261174 100644 (file)
--- a/lib/App/IdiotBox/Importer.pm
+++ b/lib/App/IdiotBox/Importer.pm
@@ -8,6 +8,8 @@ use ExtUtils::MakeMaker qw(prompt);
 use File::Spec::Functions qw(catfile catdir);
 use POSIX qw(strftime);
 
+use Utils::PresentingPerl;
+
 sub log_info (&) { print $_[0]->(), "\n"; }
 
 sub run {
@@ -74,9 +76,12 @@ sub run {
         $info->{author} = $choice;
       }
     }
+    my $size = get_file_size($video_file . '.' .  $video_files->{$video_file}[0]);
     $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->{width} = prompt('What is the width of the video resolution?', $size->{width});
+    $info->{height} = prompt('What is the height of the video resolution?', $size->{height});
     $info->{bucket} = $bucket;
     $info->{announcement} = $ann;
     $videos{$video_file} = bless($info, 'App::IdiotBox::Video');
@@ -106,4 +111,17 @@ sub video_files_from_dir {
   \%videos;
 }
 
+sub get_video_size {
+    my ($filename) = @_;
+
+    my $size = {};
+    if($filename =~ /\.flv$/) {
+        eval { $size = Utils::PresentingPerl::get_flv_info($filename, [qw/width height/]);};
+        if($@) {
+            print "Looking for $filename size, failed, returning 0s\n";
+            return { width => 0, height => 0 };
+        }
+    }
+}
+
 1;

diff --git a/lib/Utils/PresentingPerl.pm b/lib/Utils/PresentingPerl.pm
new file mode 100644 (file)
index 0000000..97b9d0d
--- /dev/null
+++ b/lib/Utils/PresentingPerl.pm
@@ -0,0 +1,97 @@
+package Utils::PresentingPerl;
+
+use strict;
+use warnings;
+
+use FLV::File;
+#use Data::Dump::Streamer;
+use Carp;
+use English '-no_match_vars';
+use IO::Handle;
+
+# Given a filename, and an arrayref of information keys that we are interested in, returns a hashref with those keys filled in.
+# If it cannot determine the information asked for (including if the keys are unknown), it will eventually return a hashref without them filled in.
+# Known tags: 'width', 'height'.  Size of video frame.  Does not allow for changing size during the video.
+sub get_flv_info {
+  my ($filename, $wanted_info) = @_;
+
+  my $file = FLV::File->new;
+  
+  # We need to use a modified version of FLV::File::parse, or we'll end up parsing the whole file.
+  flv_parse($file, $filename);
+  
+  #Dump $file;
+  
+  my $info;
+  
+  # Now, we need to parse out the file, oen bit at at time, until we have what we wanted.
+  # This is from FLV::Body::parse
+  while (1) {
+    my $lastsize = $file->get_bytes(4);
+    
+    my $tag = FLV::Tag->new;
+    $tag->parse($file, {});
+    my $payload = $tag->get_payload;
+    
+    if ($payload->isa('FLV::VideoTag')) {
+      $info->{width} = $payload->{width};
+      $info->{height} = $payload->{height};
+    } else {
+      # For the time being, assume that other tags are unimportant.  
+      # Could, plasuably, tell somthing about the audio... but what do we care about?
+      # Much more plausably, if our file had metadata tags, then we could read them.
+      #die "No handler for payload $payload";
+    }
+    
+    for (@$wanted_info) {
+      next if !exists $info->{$_};
+    }
+    
+    last;
+  }
+
+  return $info;
+}
+
+sub flv_parse {
+  my $self  = shift;
+  my $input = shift;
+  my $opts  = shift;
+  $opts ||= {};
+  
+  $self->{header}     = undef;
+  $self->{body}       = undef;
+  $self->{filename}   = undef;
+  $self->{filehandle} = undef;
+  $self->{pos}        = 0;
+  
+  my $eval_result = eval {
+    if (ref $input) {
+      $self->{filehandle} = $input;
+    } else {
+      $self->{filename} = $input;
+      ## no critic (RequireBriefOpen)
+      open my $fh, '<', $self->{filename} or croak q{} . $OS_ERROR;
+      binmode $fh or croak 'Failed to set binary mode on file';
+      $self->{filehandle} = $fh;
+    }
+    
+    $self->{header} = FLV::Header->new();
+    $self->{header}->parse($self);    # might throw exception
+    
+    $self->{body} = FLV::Body->new();
+    # $self->{body}->parse($self, $opts);    # might throw exception
+    1;
+  };
+  if (!$eval_result) {
+    die 'Failed to read FLV file: ' . $EVAL_ERROR;
+  }
+  
+  #$self->{filehandle} = undef;              # implicitly close the filehandle
+  #$self->{pos}        = 0;
+  
+  return;
+}
+
+
+'done coding';

diff --git a/share/sql/idiotbox-2.0-3.0.sql b/share/sql/idiotbox-2.0-3.0.sql
new file mode 100644 (file)
index 0000000..5f18a17
--- /dev/null
+++ b/share/sql/idiotbox-2.0-3.0.sql
@@ -0,0 +1,2 @@
+ALTER TABLE videos ADD COLUMN width INTEGER NOT NULL DEFAULT 640;
+ALTER TABLE videos ADD COLUMN height INTEGER NOT NULL DEFAULT 480;

diff --git a/share/sql/idiotbox-3.0-sqlite.sql b/share/sql/idiotbox-3.0-sqlite.sql
new file mode 100644 (file)
index 0000000..8264667
--- /dev/null
+++ b/share/sql/idiotbox-3.0-sqlite.sql
@@ -0,0 +1,24 @@
+CREATE TABLE buckets (
+  slug TEXT NOT NULL PRIMARY KEY,
+  name TEXT NOT NULL
+);
+
+CREATE TABLE announcements (
+  id INTEGER NOT NULL PRIMARY KEY,
+  made_at DATETIME NOT NULL,
+  bucket_slug TEXT REFERENCES buckets(slug)
+);
+
+CREATE TABLE videos (
+  slug TEXT NOT NULL,
+  bucket_slug TEXT NOT NULL REFERENCES buckets(slug),
+  name TEXT NOT NULL,
+  author TEXT NOT NULL,
+  details TEXT NOT NULL DEFAULT '',
+  width INTEGER NOT NULL DEFAULT 640,
+  height INTEGER NOT NULL DEFAULT 480,
+  announcement_id INTEGER NOT NULL,
+  PRIMARY KEY (slug, bucket_slug),
+  FOREIGN KEY (announcement_id, bucket_slug)
+    REFERENCES announcements(id, bucket_slug)
+);