File Coverage

blib/lib/Video/Subtitle/SRT.pm

Criterion	Covered	Total	%
statement	56	93	60.2
branch	12	30	40.0
condition	2	9	22.2
subroutine	10	16	62.5
pod	7	11	63.6
total	87	159	54.7

package Video::Subtitle::SRT;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw/srt_time_to_milliseconds milliseconds_to_srt_time
		make_subtitle/;
%EXPORT_TAGS = (
    all => \@EXPORT_OK,
);
use strict;
use warnings;
our $VERSION = '0.05';

use Carp;
use POSIX 'floor';
use Carp;

sub new {
    my ($class, $callback) = @_;
    bless { callback => $callback }, $class;
}

# Turn on/off debugging; return value is current debugging value.

sub debug
{
    my $self = shift;
    $self->{debug} = shift if @_;
    $self->{debug};
}

sub parse
{
    my ($self, $stuff) = @_;

    if (ref($stuff) && (UNIVERSAL::isa($stuff, 'IO::Handle') || ref($stuff) eq 'GLOB')) {
        $self->parse_fh($stuff);
    }
    else {
        open my $fh, "<", $stuff or croak "$stuff: $!";
        $self->parse_fh($fh);
	close $fh or die $!;
    }
}

# Read the SRT from file handle $fh.

sub parse_fh
{
    my ($self, $fh) = @_;

    binmode $fh, ":raw:crlf";
    local $/ = "\n\n";
    while (my $chunk = <$fh>) {
        my @chunk = split /\r?\n/, $chunk;
        if ($chunk[-1] eq "") {
            pop @chunk;
        }

        my $data = $self->parse_chunk(\@chunk, $chunk);
        if ($self->{callback}) {
            eval {
		$self->{callback}->($data)
	    };
            warn $@ if $@ && $self->{debug};
            return if $@;
        }
    }
}

sub parse_chunk
{
    my ($self, $chunk_ref, $chunk) = @_;

    if (@$chunk_ref < 3) {
        croak "Odd number of lines: \n$chunk";
    }

    my $data;
    if ($chunk_ref->[0] !~ /^\d+$/) {
        croak "Number must be digits: '$chunk_ref->[0]'";
    }
    $data->{number} = $chunk_ref->[0];

    my $time_re = '(\d{2}:\d{2}:\d{2}(?:,\d*)?)';
    unless ($chunk_ref->[1] =~ /^$time_re --> $time_re$/) {
        croak "Invalid time range: $chunk_ref->[1]";
    }
    $data->{start_time} = $1;
    $data->{end_time}   = $2;

    $data->{text} = join "\n", @{$chunk_ref}[2..$#$chunk_ref];

    return $data;
}

sub srt_time_to_milliseconds
{
    my ($time) = @_;
    if ($time !~ /^(\d\d):(\d\d):(\d\d)(?:,(\d*))?$/) {
        croak "Time '$time' does not match SRT format";
    }
    my $milliseconds = int ($4);
    $milliseconds += ($1 * 60 * 60 + $2 * 60 + $3) * 1000;
    return $milliseconds;
}

sub milliseconds_to_srt_time
{
    my ($milliseconds) = @_;

    my $seconds = floor ($milliseconds / 1000);
    my $minutes = floor ($seconds / 60);
    my $hours = floor ($minutes / 60);
    $milliseconds %= 1000;
    $seconds %= 60;
    $minutes %= 60;
    return sprintf "%02d:%02d:%02d,%03d",
        $hours, $minutes, $seconds, $milliseconds;
}

sub make_subtitle
{
    my ($data) = @_;
    my $output = "";
    for my $field (qw/number start_time end_time text/) {
	if (! $data->{$field}) {
	    croak "Missing $field";
	}
    }
    # Bug: should check that the output has all the fields here.
    $output .= $data->{number} . "\n";
    $output .= $data->{start_time} . " --> " . $data->{end_time} . "\n";
    $output .= $data->{text} . "\n";
    $output .= "\n";
    return $output;
}

sub add
{
    my ($object, $data) = @_;
    if (! defined $object->{number}) {
        $object->{number} = 0;
    }
    $object->{number}++;
    $data->{number} = $object->{number};
    $object->{subtitles} .= make_subtitle ($data);
}

sub write_file
{
    my ($object, $file_name) = @_;
    my $file;
    if ($file_name) {
        # Not finished.
        die;
    }
    else {
        $file = *STDOUT;
    }
    $object->{subtitles} =~ s/\n/\r\n/g;
    print $file $object->{subtitles};
}

# Set the verbosity of the output.

sub set_verbosity
{
    my ($object) = @_;
    $object->{verbosity} = 1;
}

1;

__END__