File Coverage

blib/lib/Time/Timecode.pm

Criterion	Covered	Total	%
statement	148	151	98.0
branch	46	54	85.1
condition	31	52	59.6
subroutine	41	41	100.0
pod	5	5	100.0
total	271	303	89.4

package Time::Timecode;

use strict;
use warnings;
use overload
    '+'   => '_add',
    '-'   => '_subtract',
    '*'   => '_multiply',
    '/'   => '_divide',
    'cmp' => '_compare',
    '<=>' => '_compare',
    '""'  => 'to_string';

use POSIX ();
use Carp ();

our $VERSION = '0.30';

our $DEFAULT_FPS = 29.97;
our $DEFAULT_DROPFRAME = 0;
our $DEFAULT_DELIMITER = ':';
our $DEFAULT_FRAME_DELIMITER = $DEFAULT_DELIMITER;
our $DEFAULT_TO_STRING_FORMAT = ''; # If not set $TO_STRING_FORMAT is used

my $SECONDS_PER_MINUTE = 60;
my $SECONDS_PER_HOUR   = $SECONDS_PER_MINUTE * 60;
my $TO_STRING_FORMAT = '%02s%s%02s%s%02s%s%02s'; #HH:MM:SS:FF

my $TIME_PART = qr|[0-5]\d|;
my $DROP_FRAME_DELIMITERS = '.;'; #, too?
my $FRAME_PART_DELIMITERS = "${DEFAULT_DELIMITER}${DROP_FRAME_DELIMITERS}";

{
  no strict 'refs';

  my @methods = qw|hours minutes seconds frames fps is_dropframe total_frames|;
  my %method_aliases = (
      hours   => ['hh', 'hrs'],
      minutes => ['mm', 'mins'],
      seconds => ['ss', 'secs'],
      frames  => ['ff']
  );

  for my $accessor (@methods) {
      *$accessor = sub { (shift)->{$accessor} };
      *$_ = \&$accessor for @{$method_aliases{$accessor}};
  }
}

sub new
{
    Carp::croak 'usage: Time::Timecode->new( TIMECODE [, OPTIONS ] )' if @_ < 2 || !defined($_[1]);

    my $class   = shift;
    my $options = ref($_[-1]) eq 'HASH' ? pop : {};
    my $self    = bless { is_dropframe    => $options->{dropframe},
                          frame_delimiter => $options->{frame_delimiter},
                          delimiter       => $options->{delimiter} || $DEFAULT_DELIMITER,
                          fps             => $options->{fps}       || $DEFAULT_FPS }, $class;

    Carp::croak "Invalid fps '$self->{fps}': fps must be >= 0" unless $self->{fps} =~ /\A\d+(?:\.\d+)?\z/;

    if(@_ == 1 && $_[0] !~ /^\d+$/) {
        $self->_timecode_from_string( shift );
    }
    else {
        # For string timecodes these can be derrived by their format
        $self->{is_dropframe} = $DEFAULT_DROPFRAME unless defined $self->{is_dropframe};
        $self->{frame_delimiter} ||= $DEFAULT_FRAME_DELIMITER;

        if(@_ == 1) {
	    $self->_timecode_from_total_frames( shift );
        }
        else {
	    # Add frames if necessary
	    push @_, 0 unless @_ == 4;
	    $self->_set_and_validate_time(@_);
	}
    }

    if ($self->_is_deprecated_dropframe_rate) {
      warn<
Time::Timecode warning: versions > 0.3X will not treat drop frame 30 and 60 like 29.97 and 59.94. Use an fps of 29.97 or 59.94 instead.
DEPRECATION
    }

    $self;
}

sub to_string
{
    my $self   = shift;
    my $format = shift || $DEFAULT_TO_STRING_FORMAT;
    my $tc     = sprintf $TO_STRING_FORMAT, $self->hours,
                                            $self->{delimiter},
                                            $self->minutes,
                                            $self->{delimiter},
                                            $self->seconds,
                                            $self->{frame_delimiter},
                                            $self->frames;

    if($format) {
        my @args;
        # TODO: Add %X too?
        my %formats = (H => $self->hours,
                       M => $self->minutes,
                       S => $self->seconds,
                       f => $self->frames,
                       r => $self->fps,
		       i => $self->total_frames,
		       s => sprintf("%02d", $self->frames/$self->fps*100),
                       T => $tc,
                       '%'=> '%');

        # Match printf style formats with optional width and alignment.
        ($tc = $format) =~ s/(%-?\d*)([HMSfrisT%])/sprintf "${1}s", $formats{$2}/ge
    }

    $tc;
}

sub convert
{
    my ($self, $fps, $options) = @_;

    $options ||= {};
    $options->{fps} = $fps;
    $options->{dropframe} ||= 0;
    $options->{delimiter} ||= $self->{delimiter};
    $options->{frame_delimiter} ||= $self->{frame_delimiter};

    Time::Timecode->new($self->to_non_dropframe->total_frames, $options);
}

sub to_dropframe
{
    my $self = shift;
    return $self if $self->is_dropframe;

    my $options = $self->_dup_options;
    $options->{dropframe} = 1;

    Time::Timecode->new($self->total_frames, $options);
}

sub to_non_dropframe
{
    my $self = shift;
    return $self unless $self->is_dropframe;

    my $options = $self->_dup_options;
    $options->{dropframe} = 0;

    Time::Timecode->new($self->total_frames, $options);
}

sub _add
{
    _handle_binary_overload(@_, sub {
        $_[0] + $_[1];
    });
}

sub _subtract
{
    _handle_binary_overload(@_, sub {
        $_[0] - $_[1];
    });
}

sub _multiply
{
    _handle_binary_overload(@_, sub {
        $_[0] * $_[1];
    });
}

sub _divide
{
    _handle_binary_overload(@_, sub {
        int($_[0] / $_[1]);
    });
}

sub _compare
{
    my ($lhs, $rhs) = _overload_order(@_);
    $lhs->total_frames <=> $rhs->total_frames;
}

sub _overload_order
{
    my ($lhs, $rhs, $reversed) = @_;
    $rhs = Time::Timecode->new($rhs) if !ref($rhs) or !$rhs->isa('Time::Timecode');
    ($lhs, $rhs) = ($rhs, $lhs) if $reversed;
    ($lhs, $rhs);
}

sub _handle_binary_overload
{
    my $fx = pop @_;
    my ($lhs, $rhs) = _overload_order(@_);
    Time::Timecode->new($fx->($lhs->total_frames, $rhs->total_frames), $lhs->_dup_options);
}

sub _dup_options
{
    my $self = shift;
    { fps       => $self->fps,
      dropframe => $self->is_dropframe,
      delimiter => $self->{delimiter},
      frame_delimiter => $self->{frame_delimiter} };
}

sub _frames_per_hour
{
    shift->_rounded_fps * $SECONDS_PER_HOUR;
}

sub _frames_per_minute
{
    shift->_rounded_fps * $SECONDS_PER_MINUTE;
}

sub _frames
{
    my ($self, $frames) = @_;
    $frames % $self->_rounded_fps;
}

sub _rounded_fps
{
    my $self = shift;
    $self->{rounded_fps} ||= POSIX::ceil($self->fps);
}

sub _hours_from_frames
{
    my ($self, $frames) = @_;
    int($frames / $self->_frames_per_hour);
}

sub _minutes_from_frames
{
    my ($self, $frames) = @_;
    int($frames % $self->_frames_per_hour / $self->_frames_per_minute);
}

sub _seconds_from_frames
{
    my ($self, $frames) = @_;
    int($frames % $self->_frames_per_minute / $self->_rounded_fps);
}

sub _valid_frames
{
    my ($part, $frames, $max) = @_;
    Carp::croak "Invalid frames '$frames': frames must be between 0 and ${ \int($max) }" unless $frames =~ /^\d+$/ && $frames >= 0 && $frames <= $max;
}

sub _valid_time_part
{
    my ($part, $value) = @_;
    Carp::croak "Invalid $part '$value': $part must be between 0 and 59" if !defined($value) || $value < 0 || $value > 59;
}

sub _set_and_validate_time_part
{
    my ($self, $part, $value, $validator) = @_;
    $validator->($part, $value, $self->fps);
    $self->{$part} = int($value); # Can be a string with a 0 prefix: 01, 02, etc...
}

sub _frames_to_drop {
  my $self = shift;

  if (!defined $self->{frames_to_drop}) {
    $self->{frames_to_drop} = $self->is_dropframe ? POSIX::ceil($self->{fps}*0.066666) : 0;
  }

  $self->{frames_to_drop};
}

sub _set_and_validate_time
{
    my ($self, $hh, $mm, $ss, $ff) = @_;
    $self->_set_and_validate_time_part('frames', $ff, \&_valid_frames);
    $self->_set_and_validate_time_part('seconds', $ss, \&_valid_time_part);
    $self->_set_and_validate_time_part('minutes', $mm, \&_valid_time_part);
    $self->_set_and_validate_time_part('hours', $hh, \&_valid_time_part);

    my $total = $self->frames;
    $total += $self->_rounded_fps * $ss;
    $total += $self->_frames_per_minute * $mm;
    $total += $self->_frames_per_hour * $hh;

    my $total_minutes = $SECONDS_PER_MINUTE * $hh + $mm;
    $total -= $self->_frames_to_drop * ( $total_minutes - int($total_minutes / 10) );

    Carp::croak "Invalid dropframe timecode: '$self'" unless $self->_valid_dropframe_timecode;
    $self->{total_frames} = $total;
}

sub _valid_dropframe_timecode
{
    my $self = shift;
    !($self->is_dropframe
      && $self->seconds == 0
      && ($self->frames == 0 || $self->frames == 1)
      && ($self->minutes % 10 != 0));
}

sub _set_timecode_from_frames
{
    my ($self, $frames) = @_;

    # We need the true frame rate here, not the rounded
    my $fps = $self->{fps};

    # Support drop frame calculations for known frame rates that don't support them :(
    # This is in place temporarily for backwards compatibility with $VERSION < 0.30 and will be removed in 0.40
    if ($self->_is_deprecated_dropframe_rate) {
        $fps = $self->{fps} == 30 ? 29.97 : 59.94;
    }

    #####
    # Algorithm from: http://www.davidheidelberger.com/blog/?p=29
    my $drop = $self->_frames_to_drop;

    my $frames_per_ten_minutes = $fps * $SECONDS_PER_MINUTE * 10;
    my $frames_per_minute = $self->_frames_per_minute - $drop;

    my $d = int($frames / $frames_per_ten_minutes);
    my $m = $frames % $frames_per_ten_minutes;

    if($m > $drop) {
        $frames += ($drop * 9 * $d) + $drop * int(($m - $drop) / $frames_per_minute);
    }
    else {
        $frames += $drop * 9 * $d;
    }
    #####

    $self->_set_and_validate_time_part('frames', $self->_frames($frames), \&_valid_frames);
    $self->_set_and_validate_time_part('seconds', $self->_seconds_from_frames($frames), \&_valid_time_part);
    $self->_set_and_validate_time_part('minutes', $self->_minutes_from_frames($frames), \&_valid_time_part);
    $self->_set_and_validate_time_part('hours', $self->_hours_from_frames($frames), \&_valid_time_part);
}

sub _is_deprecated_dropframe_rate
{
  my $self = shift;
  $self->is_dropframe && ($self->{fps} == 30 || $self->{fps} == 60);
}

sub _timecode_from_total_frames
{
    my ($self, $frames) = @_;
    $self->{total_frames} = $frames;
    $self->_set_timecode_from_frames($frames);
}

# Close your eyes, it's about to get ugly...
sub _timecode_from_string
{
    my ($self, $timecode) = @_;
    #[\Q$self->{delimiter}$DEFAULT_DELIMITER\E]
    my $delim = '[' . quotemeta("$self->{delimiter}$DEFAULT_DELIMITER") . ']';
    my $frame_delim = $FRAME_PART_DELIMITERS;

    $frame_delim .= $self->{frame_delimiter} if defined $self->{frame_delimiter};
    $frame_delim = '[' . quotemeta("$frame_delim") . ']';

    if($timecode =~ /^\s*($TIME_PART)$delim($TIME_PART)$delim($TIME_PART)($frame_delim)([0-5]\d)\s*([NDPF])?\s*$/) {
        #TODO: Use suffix after frames to determine drop/non-drop -and possibly other things
        if(!defined $self->{is_dropframe}) {
            $self->{is_dropframe} = index($DROP_FRAME_DELIMITERS, $4) != -1 ? 1 : $DEFAULT_DROPFRAME;
        }

        $self->{frame_delimiter} = $4 unless defined $self->{frame_delimiter};
        $self->_set_and_validate_time($1, $2, $3, $5);
    }
    else {
        Carp::croak "Can't create timecode from '$timecode'";
    }
}

1;

__END__