view release on metacpan or  search on metacpan

lib/Automate/Animate/FFmpeg.pm  view on Meta::CPAN

package Automate::Animate::FFmpeg;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.13';

use utf8; # filenames can be in utf8

binmode STDERR, ':encoding(UTF-8)';
binmode STDOUT, ':encoding(UTF-8)';

use File::Temp;
use File::Find::Rule;
use IPC::Run;
use Text::ParseWords;
use Encode;
use Data::Roundtrip qw/perl2dump no-unicode-escape-permanently/;
use Cwd::utf8 qw/abs_path cwd/;

sub	new {
	my $class = $_[0];
	my $params = $_[1];

	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];

	my $self = {
		'input-images' => [],
		'output-filename' => undef,
		'verbosity' => 0,
		# params to ffmpeg must be given as an arrayref
		# these are our standard params, they are read only and must
		# be supplied here as an ARRAYref
		'ffmpeg-standard-params' => ['-c', 'copy', '-c:v', 'copy', '-c:a', 'copy', '-q:a', '0', '-q:v', '1'],
		# extra params to ffmpeg can be specified by the caller
		# we store this as an ARRAYref, each option and value is an item of its own
		'ffmpeg-extra-params' => [],
		# the duration of each frame in seconds (fractional supported)
		# or <=0 for using FFmpeg's defaults
		'frame-duration' => 0,
		# this will be modified during perl Makefile.PL
		'ffmpeg-executable' => '/usr/local/bin/ffmpeg', # specify fullpath if not in path
		# end this will be modified during perl Makefile.PL
	};
	bless $self, $class;

	my $ak;

	# sort out the easy params
	my $verbos = 0;
	$ak = 'verbosity';
	if( exists($params->{$ak}) && defined($verbos=$params->{$ak}) ){ $self->verbosity($verbos) }

	for $ak (qw/
		output-filename
		frame-duration
	/){
		if( exists($params->{$ak}) && defined($params->{$ak}) ){
			$self->{$ak} = $params->{$ak};
			if( $verbos > 1 ){ print "${whoami} (via $parent), line ".__LINE__." : parameter '$ak' set to : ".$params->{$ak}."\n"; }
		}
	}

	# specify input images as scalar, arrayref or hashref (values)
	$ak = 'input-images';
	if( exists($params->{$ak}) && defined($params->{$ak})
		&& scalar($params->{$ak})
	){
		$self->input_images($params->{$ak});
	}

	# input image filenames are read from specified file (one filename per line)
	$ak = 'input-images-from-file';
	if( exists($params->{$ak}) && defined($params->{$ak})
		&& scalar($params->{$ak})
	){
		if( ! $self->input_file_with_images($params->{$ak}) ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, failed to load input images from file containing their pathnames: '".$params->{$ak}."'.\n"; return un...
	}

	# input images can be specified via a pattern and a search dir
	# like : 'input-pattern' => ['*.png', '/x/y/searchdir']
	$ak = 'input-pattern';
	if( exists($params->{$ak}) && defined($params->{$ak}) ){
		if( ref($params->{$ak})ne'ARRAY' ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, the argument to '$ak' must be an ARRAYref of 1 or 2 items: the pattern and optionally the search dir. See above for what...
		if( ! $self->input_pattern($params->{$ak}) ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, failed to find input files based on the above pattern and search dir.\n"; return undef }
	}
	# or via multiple patterns (an ARRAY of ARRAY patterns, as above)
	$ak = 'input-patterns';
	if( exists($params->{$ak}) && defined($params->{$ak}) ){
		if( ref($params->{$ak})ne'ARRAY' ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, the argument to '$ak' must be an ARRAYref of one or more ARRAYrefs each of 1 or 2 items: the pattern and optionally the ...
		if( ! $self->input_patterns($params->{$ak}) ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, failed to find input files based on the above pattern and search dir.\n"; return undef }
	}

	# specify output filename
	$ak = 'output-filename';
	if( exists($params->{$ak}) && defined($params->{$ak}) ){
		$self->output_filename($params->{$ak});
		if( $verbos > 1 ){ print "${whoami} (via $parent), line ".__LINE__." : parameter '$ak' set to : ".$params->{$ak}."\n"; }
	}
	# any extra ffmpeg params?
	# these are cmdline options to FFmpeg and must be
	# passed as an ARRAY, each flag, option and parameter is
	# a single array item, for example
	# ['-i', 'inputfile', '-o', 'out', '-p', '1', '2']
	# note that above -p is used as in -p 1 2
	$ak = 'ffmpeg-extra-params';
	if( exists($params->{$ak}) && defined($params->{$ak}) ){
		if( ! defined($self->ffmpeg_extra_params($params->{$ak})) ){ print STDERR perl2dump($params->{$ak})."${whoami} (via $parent), line ".__LINE__." : error, failed to parse/verify the above params to ffmpeg via '--ffmpeg-extra-params'.\n"; return undef...
		if( $verbos > 1 ){ print "${whoami} (via $parent), line ".__LINE__." : parameter '$ak' set to : ".$params->{$ak}."\n"; }
	}

	return $self
}
# it spawns ffmpeg as external command via IPC::Run::run(@cmd)
# requires that at least 1 input image was specified before.
# returns 0 on failure, 1 on success
sub	make_animation {
	my $self = $_[0];
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();

	my $cmdret = $self->_build_ffmpeg_cmdline();
	if( ! defined $cmdret ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, failed to build ffmpeg command line, call to ".'_build_ffmpeg_cmdline()'." has failed.\n"; return 0 }
	my $cmdline = $cmdret->{'cmdline'};
	my $tmpfile = $cmdret->{'tmpfile'};
	if( $verbos > 0 ){ print "${whoami} (via $parent), line ".__LINE__." : executing system command:\n".join(' ',@$cmdline)."\n" }
	my ($in, $out, $err);
	my $ret = IPC::Run::run($cmdline, \$in, \$out, \$err);
	if( ! $ret ){ 
		print STDERR "$out\n$err\n${whoami} (via $parent), line ".__LINE__." : error, executing this command has failed (the list of input files is in '$tmpfile', you may delete it when you are done):\n  ".join(' ', @$cmdline)."\n";
		return 0
	}
	if( $verbos > 0 ){
		if( $verbos > 1 ){ print $out."\n" }
		print "${whoami} (via $parent), line ".__LINE__." : done, success. Output animation of ".$self->num_input_images()." input images is in '".$self->output_filename()."'.\n"
	}
	unlink($tmpfile);

	return 1;
}
sub	_build_ffmpeg_cmdline {
	my $self = $_[0];
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();

	if( $self->num_input_images() == 0 ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, no input images in store.\n"; return undef }
	if( ! defined $self->output_filename() ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, no output filename specified.\n"; return undef }

	my $execu = $self->ffmpeg_executable();
	if( ! defined $execu ){ print STDERR "$whoami() (via $parent), line ".__LINE__." : error, the path to the ffmpeg executable is undefined. That means that the external, 3rd-party dependency 'ffmpeg' was not located during installation. First you need...

	# get a tmp file - only drawback is it is in current working dir
	# but on the other hand we do not want caller to delete a directory!
	my ($fh, $tmpfile) = File::Temp::tempfile('XXXXXXXXXXXX', SUFFIX => '.txt');
	my $duration_str = $self->frame_duration() > 0 ? "duration ".$self->frame_duration()."\n" : "";
	binmode $fh, ':encoding(UTF-8)';
	print $fh "file '".$_."'\n"
			  .${duration_str}
	for @{$self->{'input-images'}};
	close $fh;

	my @cmdline = (
		$execu,
		# the extra params to FFmpeg is just a command-line args style
		@{ $self->ffmpeg_extra_params() },
		# and the concats etc.
		'-f', 'concat',
		'-y',
		# this is about accepting relative filepaths to images
		'-safe', '0',
		# all images filepathas are in this file (one in each line)
		'-i', $tmpfile,
		@{ $self->ffmpeg_standard_params() },
		$self->output_filename()
	);
	return {
		'cmdline' => \@cmdline,
		# this can be unlinked by caller if needed
		'tmpfile' => $tmpfile
	}
}
# set the executable only via the constructor
sub	ffmpeg_executable { return $_[0]->{'ffmpeg-executable'} }
sub	verbosity {
	my $self = $_[0];
	my $m = $_[1];
	return $self->{'verbosity'} unless defined $m;
	$self->{'verbosity'} = $m;
	return $m
}
sub	frame_duration {
	my $self = $_[0];
	my $m = $_[1];
	return $self->{'frame-duration'} unless defined $m;
	$self->{'frame-duration'} = $m;
	return $m
}

# note: when setting an output filename, make sure you
# specify the extension and it does make sense to FFmpeg (e.g. mp4)
sub	output_filename {
	my $self = $_[0];
	my $outfile = $_[1];
	return $self->{'output-filename'} unless defined $outfile;
	$self->{'output-filename'} = $outfile;
	return $outfile
}
sub	_cmdline2argsarray {
	my $m = $_[0];
	if( ref($m) eq 'ARRAY' ){
		return [ @$m ]
	} elsif( ref($m) eq '' ){
		return Text::ParseWords::shellwords($m)
	} elsif( ref($m) eq 'HASH' ){
		return [ %$m ];
	}
	print STDERR "_cmdline2argsarray() : error, an ARRAYref/HASHref/String-scalar containing command-line arguments was expected, not ".ref($m)."\n";
	return undef
}
sub	ffmpeg_extra_params {
	my $self = $_[0];
	my $m = $_[1];
	return $self->{'ffmpeg-extra-params'} unless defined $m;
	my $ret = _cmdline2argsarray($self->{'ffmpeg-extra-params'});
	if( ! defined $ret ){ print STDERR perl2dump($ret)."ffmpeg_extra_params() : error, failed to pass above arguments.\n"; return undef }
	$self->{'ffmpeg-extra-params'} = $ret;
	return $ret
}
sub	ffmpeg_standard_params { return $_[0]->{'ffmpeg-standard-params'} }
sub	num_input_images { return scalar @{$_[0]->{'input-images'}} }
# specify a text file which holds image filenames, one per line to be added
# hash-comments are understood, empty/only-space lines are removed
# returns 1 on success, 0 on failure
sub	input_file_with_images {
	my ($self, $infile) = @_;
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();
	if( ! defined $infile ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, an input filename of input image filenames is expected.\n"; return 0 }
	my $fh;
	if( ! open($fh, '<:encoding(UTF-8)', $infile) ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, could not open input file '$infile' for reading, $!\n"; return 0 }
	while( <$fh> ){
		chomp;
		s/#.*$//;
		s/^\s*$//;
		$self->input_images($_) unless /^\s*$/;
	} close $fh;
	return 1
}
sub	clear_input_images { $#{ $_[0]->{'input-images'} } = -1 }
# Add using a single pattern/searchdir
# add image files via a pattern and an input dir, e.g. '*.png', '/x/y/z/'
# make sure that the order you expect is what you get during the pattern materialisation
# the search dir is optional, default is Cwd::cwd
sub	input_pattern {
	my ($self, $params) = @_;
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();
	my ($_pattern, $indir) = @$params;
	my $indir_need_encode_utf8 = 0;
	if( ! defined $indir ){
		$indir = _my_cwd();
		if( $verbos > 0 ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : warning, no search dir was specified and using current dir '$indir'.\n" }
	} else { $indir_need_encode_utf8 = 1 }
	my $pattern;
	# allows for /pattern/modifiers
	if( $_pattern =~ m!^regex\(/(.*?)/(.*?)\)$! ){
		# see https://www.perlmonks.org/?node_id=1210675
		my $pa = $1; my $mo = $2;
		if( $mo!~/^[msixpodualn]+$/ ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, illegal modifiers ($mo) to the specified regex detected.\n"; return 0 }
		# the modifiers are entered as (?...) before the regex pattern
		$pattern = qr/(?${mo})${pa}/;
	} else { $pattern = $_pattern }
	if( $verbos > 1 ){ print "${whoami} (via $parent), line ".__LINE__." : searching under dir '$indir' with pattern '".$pattern."' ...\n" }

	if( ! defined $self->input_images([
		# this little piglet does not support unicode
		# or, rather, readdir() needs some patching
		# additionally, it fails in M$ as the unicoded
		# filenames get doubly encoded, let's see if this will fix it:
		($^O eq 'MSWin32')
			?
			    File::Find::Rule
				->file()
				->name($pattern)
				->in($indir)
			:
			    map { Encode::decode_utf8($_) }
			    File::Find::Rule
				->file()
				->name($pattern)
				->in(Encode::encode_utf8($indir))
	]) ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, call to input_images() has failed.\n"; return 0 }

	return 1 # success
}
# This adds many patterns:
# the input is an ARRAY of 1-or-2-item arrays
# each subarray must consist of a pattern and optionally a search dir (else current dir will be used)
sub	input_patterns {
	my ($self, $specs) = @_;
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();
	for my $as (@$specs){
		if( (scalar(@$as)==0)
		 || (scalar(@$as)>2)
		){ print STDERR perl2dump($as)."${whoami} (via $parent), line ".__LINE__." : error, the spec must contain at least a pattern and optionally a search-dir as an array, see above.\n"; return 0; }
		if( ! $self->input_pattern($as) ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : error, call to input_pattern() has failed for this spec: @$as\n"; return 0 }
	}
	return 1 # success
}
# if no parameter is specified then it returns the current list of input images as an arrayref
# Otherwise:
# specify one or more input filenames (of images) via a single scalar, an arrayref or
# a hashref whose values are image filenames, to convert them into video
# in this case returns undef on failure or the current, updated list of input images on success
sub	input_images {
	my ($self, $m) = @_;
	if( ! defined $m ){ return $self->{'input-images'} }
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];
	my $verbos = $self->verbosity();
	if( $verbos > 0 ){
		if( $verbos > 1 ){ print STDOUT perl2dump($m)."${whoami} (via $parent), line ".__LINE__." : called with input images as shown above ...\n" }
		else { print STDOUT "${whoami} (via $parent), line ".__LINE__." : called ...\n" }
	}
	# NOTE: Cwd::abs_path() messes up on unicode filenames and requires Encode::decode_utf8()
	# but there is also Cwd::utf8 to consider sometime...
	my $rf = ref $m;
	if( $rf eq 'ARRAY' ){
		for my $af (@$m){
			if( ! -e $af ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : warning/1, input image '$af' does not exist on disk and will be ignored.\n"; next }
			push @{$self->{'input-images'}}, _my_abs_path($af);
		}
	} elsif( $rf eq 'HASH' ){
		for my $af (values %$m){
			if( ! -e $af ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : warning/2, input image '$af' does not exist on disk and will be ignored.\n"; next }
			push @{$self->{'input-images'}}, _my_abs_path($af);
		}		
	} elsif( $rf eq '' ){
		if( ! -e $m ){ print STDERR "${whoami} (via $parent), line ".__LINE__." : warning/3, input image '$m' does not exist on disk and will be ignored.\n"; }
		else { push @{$self->{'input-images'}}, _my_abs_path($m) }
	} else { print STDERR "${whoami} (via $parent), line ".__LINE__." : error, input can be an arrayref of input image filenames, a hashref whose values are filenames or a single filename in the form of a scalar."; return undef }
	if( $verbos > 1 ){ print STDOUT perl2dump($self->{'input-images'})."${whoami} (via $parent), line ".__LINE__." : called and added some images, above is a list of all input images to create the animation.\n" }
	return $self->{'input-images'}
}

sub _my_cwd {
	return cwd()
}
# NOTE: unicode filenames may not be canonicalised
# e.g. iota-including-accent and iota with separate accent.
# the OS will not care but if you do comparisons you will fail
# So, consider canonicalising the filenames if you are doing comparison
# e.g. in the tests
# see https://perlmonks.org/?node_id=11156629
# Also, Cwd needs utf8 decode but Cwd::utf8 doesn't
# And File::Find::Rule needs also utf8 decoce unless it is chained to abs_path
sub _my_abs_path {
	#return Encode::decode_utf8(abs_path($_[0])) # for plain Cwd
	return abs_path($_[0]) # for Cwd::utf8
}

# that's the end, pod now starts

=pod

=encoding UTF-8

=head1 NAME

Automate::Animate::FFmpeg - Create animation from a sequence of images using FFmpeg

=head1 VERSION

Version 0.13


=head1 SYNOPSIS

This module creates an animation from a sequence of input