FFmpeg - Perl interface to FFmpeg, a video converter

  use FFmpeg;

  my @media = qw(my.mpg my.avi my.mov my.mp2 my.mp3);

  #instantiate a new FFmpeg object.
  my $ff = FFmpeg->new();

  foreach my $media (@media){
    #load each media file
    $ff->input_file($media);

    #or from a URL.  note that input_url
    #enables use of other input_url_* args
    $ff->input_url('http://wherever.org/whatever.mpg');
    $ff->input_url_referrer('http://somewhere.org/overtherainbow');
    $ff->input_url_max_size('5000'); #in bytes

    #and create the stream info, accessible in a
    #FFmpeg::StreamGroup object.
    my $sg = $ff->create_streamgroup();

    #we're only interested in StreamGroups with
    #a visual component
    next unless $sg->has_video;

    #capture a frame at offset 30s into the video
    #stream in jpeg format, and get a filehandle on
    #the jpeg data stream.
    my $fh = $sg->capture_frame(
               image_format => $ff->image_format('jpeg'),
               start_time => '00:00:30'
             );

    #write the jpeg to a file.
    open(JPEG, ">$media.jpg");
    print JPEG $_ while <$fh>;
    close(JPEG);
  }

# Let the code begin...


package FFmpeg;
use strict;
use vars qw($VERSION);

$VERSION = '6036';

use Data::Dumper;
use File::Temp qw(tempfile);
use HTTP::Request;
use LWP::UserAgent;
#use Time::Piece;

use FFmpeg::Codec;
use FFmpeg::Stream::Audio;
use FFmpeg::Stream::Data;
use FFmpeg::Stream::Unknown;
use FFmpeg::Stream::Video;
use FFmpeg::FileFormat;
use FFmpeg::ImageFormat;
use FFmpeg::StreamGroup;

BOOT_XS: {
	# If I inherit DynaLoader then I inherit AutoLoader
	require DynaLoader;

	# DynaLoader calls dl_load_flags as a static method.
	*dl_load_flags = DynaLoader->can('dl_load_flags');

	do {__PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap}->(__PACKAGE__,$VERSION);
}

sub new {
  my($class,%arg) = @_;

  my $self = bless {}, $class;
  $self->init(%arg);

  return $self;
}

sub init {
  my($self,%arg) = @_;

  #this does some FFmpeg-internal setup.
  #loading codecs, etc.
  $self->_init_ffmpeg();

  #turn off verbosity
  $self->verbose(-1);

  #turn off overwrite prompting
  $self->_set_overwrite(1);

  foreach my $arg (keys %arg){
    $self->$arg($arg{$arg}) if $self->can($arg);
  }

  if($self->input_url && $self->input_file){
    warn "input_url and input_file both defined, using input_file"
  } elsif($self->input_url){
    my($fh,$file) = tempfile(CLEANUP=>1);
#warn $file;
    my $ua1 = LWP::UserAgent->new();
    $ua1->max_size($self->input_url_max_size);
    my $req = HTTP::Request->new('GET',$self->input_url);
    $req->header('Referer' => $self->input_url_referrer()) if $self->input_url_referrer();
    my $res = $ua1->request($req);
    if($res->is_success){
      print $fh $res->content();
      close($fh);
      $self->input_file($file);

      #now HEAD for true file size
      if($self->input_url_max_size){
        my $ua2 = LWP::UserAgent->new();
        my $req = HTTP::Request->new('HEAD',$self->input_url);
        $req->header('Referer' => $self->input_url_referrer()) if $self->input_url_referrer();
        my $res = $ua2->request($req);
        if($res->is_success){
          $self->{'input_url_content_length'} = $res->header('Content-Length');
        } else {
          warn "problem HEADing ".$self->input_url.', got error: '.$res->status_line;
        }
      }
    } else {
      warn "problem downloading ".$self->input_url.', got error: '.$res->status_line;
      $self->input_file('/dev/null');
    }
  }

  #initialize fileformat and imageformat objects
  $self->file_formats();
  $self->image_formats();

  return 1;
}

sub create_streamgroup {
  my ($self) = @_;

  if(!$self->input_file){
    warn "no valid input_file, refusing to construct an FFmpeg::StreamGroup";
    return undef;
  }

  my $avfc = $self->_init_AVFormatContext;

  my $i = $self->_init_streamgroup($avfc,$self->input_file);

  my %init = ();
  if($i){
    %init = %{ $i }
  } else {
    warn "failed to initialize file ". $self->input_url || $self->input_file;
    return undef;
  }
#warn "D";

  warn "unknown initialization error: ".$init{'error'} and return undef if $init{'error'};

  my($width,$height);
  if(ref($init{stream}) eq 'HASH'){ #has streams
    foreach my $stream (keys %{ $init{stream} }){
      next unless ref($init{stream}{$stream}) eq 'HASH';

      $height ||= $init{stream}{$stream}{height};
      $width  ||= $init{stream}{$stream}{width};
      last if defined($width) and defined($height);
    }
  }

  my $video_rate;
  if(ref($init{stream}) eq 'HASH') {
    foreach my $stream (keys %{ $init{stream} }) {
      next unless ref($init{stream}{$stream}) eq 'HASH';
      my ($fr_base, $fr) = (0,0);
      $fr ||= $init{stream}{$stream}{real_frame_rate};
      #warn Dumper(\%init);
      $fr_base ||= $init{stream}{$stream}{real_frame_rate_base};

      if($fr_base > 0){
        $video_rate = $fr/$fr_base;
      }
      last if defined $video_rate;
    }
  }

  ###FIXME clean this up, i have no idea what it does anymore!
  my $nullsite = index($init{format},chr(0));
  if($nullsite != -1){
    warn "HACK WTF IS GOING ON HERE?";
    warn index($init{format},chr(0));
    warn $init{format};
    $init{format} = substr($init{format}, 0, $nullsite);
    warn $init{format};
  }

  my($duration,$h,$m,$s) = ($init{duration},0,0,0);
  $duration ||= 0;
  $init{AV_TIME_BASE} ||= 1_000_000; #1,000,000 from avcodec.h

  #time parsing is borked on max_size requests for some reason
  if($self->{input_url_max_size}){
    if($init{bit_rate}){ #we can infer duration
      $duration = int(10 * ( ($self->{input_url_content_length} || 0) / $init{bit_rate})); #FIXME is this right?

      $s = $duration ;#/ 100_000; #FIXME is this right?
      $m = int($duration / 60);
      $s %= 60;
      $h = int($m / 60);
      $m %= 60;
    }
  }

  #this special case uses the Content-Length header to set size.
  $init{file_size} = $self->{input_url_max_size} if $self->{input_url_max_size};

  #warn "\n".Data::Dumper::Dumper(\%init)."\n";
  #warn "A $duration $init{duration} $init{AV_TIME_BASE}";

  my $group = FFmpeg::StreamGroup->new(
                                       file_size   => $init{file_size},
                                       data_offset => $init{data_offset},
                                       bit_rate    => $init{bit_rate},
                                       track       => $init{track},
                                       copyright   => $init{copyright},
                                       author      => $init{author},
                                       duration    => ($duration / $init{AV_TIME_BASE}),
                                       genre       => $init{genre},
                                       album       => $init{album},
                                       comment     => $init{comment},
                                       format      => $self->file_format($init{format}),
                                       url         => $init{url},
                                       year        => $init{year},
                                       video_rate  => $video_rate,
                                       width       => $width,
                                       height      => $height,
                                       _ffmpeg     => $self,
                                      );

  foreach my $s (sort keys %{ $init{stream} }){

    # audio codecs are difficult to determine sometimes, see
    # libavcodec/dvdata.h, libavcodec/mpegaudiodectab.h, and
    # libavcodec/wmadata.h
    #
    # the best method i can see to handle this right now,
    # short of doing a lookup in these matrices (that i don't
    # understand anyway) is to leave the codec as undef.
    #
    # not the ideal solution :( FIXME

#    my $stream = FFmpeg::Stream->new(
#                                     fourcc => join('',map {chr($_)} (unpack('c*',pack('I',$init{stream}{$s}{codec_tag})))),
#                                     codec_tag => $init{stream}{$s}{codec_tag},
#                                     codec => $self->codec($init{stream}{$s}{codec_id}),
#                                    );

    my $video_rate = $init{stream}{$s}{video_rate};
    if($init{stream}{$s}{real_frame_rate_base} > 0 and defined $init{stream}{$s}{real_frame_rate}){
      #$frame_rate = $init{stream}{$s}{real_frame_rate} / $init{stream}{$s}{real_frame_rate_base};
      $video_rate = $init{stream}{$s}{real_frame_rate};
    }

    my $streamclass = 'FFmpeg::Stream::Unknown';

    my $codec_id = $init{stream}{$s}{codec_id};

    if(defined($self->codec($codec_id)) && $self->codec($codec_id)->is_video){
      $streamclass = 'FFmpeg::Stream::Video';
    } elsif(defined($self->codec($codec_id)) && $self->codec($codec_id)->is_audio){
       $streamclass = 'FFmpeg::Stream::Audio';
    }

    my $stream = $streamclass->new(
                                   bit_rate      => $init{stream}{$s}{bit_rate},
                                   channels      => $init{stream}{$s}{channels},
                                   codec         => $self->codec($init{stream}{$s}{codec_id}),
                                   codec_tag     => $init{stream}{$s}{codec_tag},
                                   duration      => ($init{stream}{$s}{duration} / $init{AV_TIME_BASE}), ###FIXME is this correct to divide?
                                   fourcc        => join('',map {chr($_)} (unpack('c*',pack('I',$init{stream}{$s}{codec_tag})))),
                                   video_rate    => $video_rate,
                                   height        => $init{stream}{$s}{height},
                                   quality       => $init{stream}{$s}{quality},
                                   sample_format => $init{stream}{$s}{sample_format},
                                   sample_rate   => $init{stream}{$s}{sample_rate},
                                   start_time    => ($init{stream}{$s}{start_time} / $init{AV_TIME_BASE}), ###FIXME is this correct to divide?
                                   width         => $init{stream}{$s}{width},
                                  );
    $group->_add_stream($stream);
  }

  #FIXME do we still need these?
  $self->_free_AVFormatContext($avfc);

  return $group;
}

sub codec {
  my $self = shift;
  my $codec_name = shift;

  if($codec_name =~ /^\d+$/){
    #TODO: flip name/id hash keying if this is called more often
    foreach my $codec ($self->codecs){
      return $codec if $codec->id == $codec_name;
    }

    return undef;
  }

  return $self->{'_codecs'}{$codec_name};
}

sub codecs {
  my ($self) = @_;

  if(! $self->{'_codecs'}){
    my %codecs = %{ $self->_codecs() };

    foreach my $cname (keys %codecs){
      my($id) = $codecs{$cname} =~ /^\[(.+)\]/;
      my $c = FFmpeg::Codec->new(
                                        id => hex($id),
                                        name => $cname,
                                        can_read  => ($codecs{$cname} =~ /D/ ? 1 : 0),
                                        can_write => ($codecs{$cname} =~ /E/ ? 1 : 0),
                                        is_audio  => ($codecs{$cname} =~ /A/ ? 1 : 0),
                                        is_video  => ($codecs{$cname} =~ /V/ ? 1 : 0),
                                       );

      $self->{'_codecs'}{$cname} = $c;
    }
  }


  return values %{ $self->{'_codecs'} };
}

sub format_duration_HMS {
  my($self,$duration) = @_;
  #warn join "\n",caller();
  my($h,$m,$s) = (0,0,0);
  $s = $duration ;#/ 100_000; #FIXME is this right?
  $m = int($duration / 60);
  $s %= 60;
  $h = int($m / 60);
  $m %= 60;
  return sprintf('%02d:%02d:%02d',$h,$m,$s);
}

sub create_timepiece {
  my ($self,$time) = @_;
warn join "\n",caller();
warn $time;
  if(ref($time) and $time->isa('Time::Piece')){
    return $time;
  } else {
    return Time::Piece->strptime($time, "%T");
  }
}

sub file_format {
  my $self = shift;
  my $file_formatname = shift;

  return $self->{'_file_formats'}{$file_formatname};
}

sub file_formats {
  my ($self) = @_;

  if(! $self->{'_file_formats'}){
    my %formats = %{ $self->_file_formats() };

    foreach my $fname (keys %formats){
      my $f = FFmpeg::FileFormat->new(
                                      name => $formats{$fname}{name},
                                      description => $formats{$fname}{description},
                                      mime_type => $formats{$fname}{mime_type},
                                      extensions => [ split(',', $formats{$fname}{extensions} || '') ],
                                      can_read  => ($formats{$fname}{capabilities} =~ /D/ ? 1 : 0),
                                      can_write => ($formats{$fname}{capabilities} =~ /E/ ? 1 : 0),
                                     );

      $self->{'_file_formats'}{$fname} = $f;
    }
  }

  return values %{ $self->{'_file_formats'} };
}

sub force_format {
  my $self = shift;
  my $format = shift;
  $self->_set_format($format) if $format;

}

sub image_format {
  my $self = shift;
  my $image_format_name = shift;

  return $self->{'_image_formats'}{$image_format_name};
}

sub image_formats {
  my ($self) = @_;

  if(! $self->{'_image_formats'}){
    my %formats = %{ $self->_image_formats() };

    foreach my $fname (keys %formats){
      my $f = FFmpeg::ImageFormat->new(
                                              name => $fname,
                                              can_read  => ($formats{$fname} =~ /D/ ? 1 : 0),
                                              can_write => ($formats{$fname} =~ /E/ ? 1 : 0),
                                             );

      $self->{'_image_formats'}{$fname} = $f;
    }
  }

  return values %{ $self->{'_image_formats'} };
}

sub input_file {
  my $self = shift;
  my $file = shift;

  if(defined($file) and ! -f $file){
    warn qq(couldn't use file "$file": $!);
    return undef;
  }

  return $self->{'input_file'} = $file if defined($file);
  return $self->{'input_file'};
}

sub input_url {
  my $self = shift;
  my $file = shift;

  return $self->{'input_url'} = $file if defined($file);
  return $self->{'input_url'};
}

sub input_url_max_size {
  my $self = shift;
  my $file = shift;

  return $self->{'input_url_max_size'} = $file if defined($file);
  return $self->{'input_url_max_size'};
}

sub input_url_referrer {
  my $self = shift;
  my $file = shift;

  return $self->{'input_url_referrer'} = $file if defined($file);
  return $self->{'input_url_referrer'};
}

sub toggle_stderr {
  my ($self,$arg) = @_;

  if($arg){
    open(TERR,">&STDERR");
    close(STDERR);
    open(STDERR,'>/dev/null');
  } else {
    close(STDERR);
    open(STDERR,">&TERR");
    close(TERR);
  }
}

sub toggle_stdout {
  my ($self,$arg) = @_;

  if($arg){
    open(TOUT,">&STDOUT");
    close(STDOUT);
    open(STDOUT,'>/dev/null');
  } else {
    close(STDOUT);
    open(STDOUT,">&TOUT");
    close(TOUT);
  }
}

sub verbose {
  my $self = shift;
  my $val  = shift;

  $self->{'verbose'} = $val if defined($val);
  $self->_set_verbose(int($self->{'verbose'}));
  return $self->{'verbose'};
}

sub _AVFormatContext {
  my $self = shift;

  return $self->{'_AVFormatContext'} = shift if @_;
  return $self->{'_AVFormatContext'};
}

1;