File Coverage

blib/lib/Video/Pattern.pm

Criterion	Covered	Total	%
statement	76	87	87.3
branch	21	28	75.0
condition	2	3	66.6
subroutine	14	14	100.0
pod	2	2	100.0
total	115	134	85.8

package Video::Pattern;

# Pragmas.
use strict;
use warnings;

# Modules.
use Class::Utils qw(set_params);
use Error::Pure qw(err);
use English;
use File::Basename qw(fileparse);
use File::Spec::Functions qw(catfile);
use Image::Random;
use Readonly;
use Video::Delay::Const;

# Constants.
Readonly::Scalar our $EMPTY_STR => q{};
Readonly::Scalar our $MILISECONDS_IN_SECOND => 1000;
Readonly::Scalar our $MINUTS_IN_HOUR => 60;
Readonly::Scalar our $SECONDS_IN_MINUTE => 60;

# Version.
our $VERSION = 0.08;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Delay generator.
	$self->{'delay_generator'} = Video::Delay::Const->new(
		'const' => 1000,
	);

	# Duration.
	$self->{'duration'} = 10000;

	# Frame per second.
	$self->{'fps'} = 60;

	# Image generator.
	$self->{'image_generator'} = undef;

	# Image type.
	$self->{'image_type'} = 'bmp';

	# Process params.
	set_params($self, @params);

	# Check fps value.
	if (! defined $self->{'fps'} || $self->{'fps'} !~ m/^\d+$/ms) {
		err "Parameter 'fps' must be numeric value.";
	}

	# Check and process duration value.
	$self->_check_and_process_duration;

	# Own image generator.
	if (! defined $self->{'image_generator'}) {
		$self->{'image_generator'} = Image::Random->new(
			'height' => 1080,
			'type' => $self->{'image_type'},
			'width' => 1920,
		);
	} else {
		$self->{'image_type'} = $self->{'image_generator'}->type;
	}

	# Object.
	return $self;
}

# Create images to output directory.
sub create {
	my ($self, $output_dir) = @_;
	my $delay = 0;
	my $image;
	foreach my $frame_num (0 .. $self->{'duration'} / 1000
		* $self->{'fps'}) {

		my $image_path = catfile($output_dir,
			(sprintf '%03d', $frame_num).'.'.
			$self->{'image_type'});

		# Create new image.
		if ($delay <= 0) {
			$self->{'image_generator'}->create($image_path);
			$image = $image_path;
			$delay = $self->{'delay_generator'}->delay;

		# Symlink to old image.
		} else {
			my ($image_filename) = fileparse($image);
			$self->_symlink($image_filename, $image_path);
		}

		# Decrement delay.
		$delay -= 1000 / $self->{'fps'};
	}
	return;
}

# Check and process duration.
sub _check_and_process_duration {
	my $self = shift;
	my $err = 0;
	if (! defined $self->{'duration'}) {
		$err = 1;
	} elsif ($self->{'duration'} =~ m/^(\d+)(\w*)$/ms) {
		my $duration_value = $1;
		my $duration_suffix = $2;
		if ($duration_suffix ne $EMPTY_STR) {
			if ($duration_suffix eq 's') {
				$self->{'duration'} = $duration_value
					* $MILISECONDS_IN_SECOND;
			} elsif ($duration_suffix eq 'ms') {
				$self->{'duration'} = $duration_value;
			} elsif ($duration_suffix eq 'min') {
				$self->{'duration'} = $duration_value
					* $MILISECONDS_IN_SECOND
					* $SECONDS_IN_MINUTE;
			} elsif ($duration_suffix eq 'h') {
				$self->{'duration'} = $duration_value
					* $MILISECONDS_IN_SECOND
					* $SECONDS_IN_MINUTE
					* $MINUTS_IN_HOUR;
			} else {
				$err = 1;
			}
		}
	} else {
		$err = 1;
	}

	if ($err) {
		err "Parameter 'duration' must be numeric value or numeric ".
			"value with time suffix.";
	}
	return;
}

# Symlink.
sub _symlink {
	my ($self, $from, $to) = @_;
	if ($OSNAME eq 'MSWin32') {
		eval {
			require Win32::Symlink;
		};
		my $has_symlink;
		if (! $EVAL_ERROR) {
			$has_symlink = eval {
				Win32::Symlink::symlink($from => $to);
			};
		}
		if (! $has_symlink) {
			require File::Copy;
			File::Copy::copy($from, $to);
		}
	} else {
		symlink $from, $to;
	}
}
1;

__END__