You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

141 lines
3.8 KiB

package Subtitle::Format::SRT;
10 years ago
use strict;
use warnings;
use utf8;
use Subtitle::Event;
use Subtitle::Utils qw(:string :timing);
use base 'Subtitle::Format';
10 years ago
sub new {
my ($class, %args) = @_;
my $self = {
debug => $args{debug} || 0,
eol => $args{eol} || "\n",
events => [],
log => [],
timing_fmt => "%02d:%02d:%02d,%03d",
};
10 years ago
return bless($self, $class);
}
sub new_event { return Subtitle::Event->new; }
sub parse {
my ($self, $lines) = @_;
my $linenum = 0;
my $event;
foreach my $line (@{ $lines }) {
$linenum++;
chomp_all($line);
# expected: event id
if ($line and not $event) {
$event = $self->new_event;
trim($line);
$event->{id} = $line;
$self->log(debug => "New event with id: $event->{id}");
next;
}
# expected: timing
if ($line and $event and not ($event->t_start or $event->t_end)) {
$self->log(debug => "Expecting timing line at $linenum");
my @t;
my ($start, $end, $rest) = ($line =~ m/(\S+)\s*-->\s*(\S+)(.*)/o);
unless ($start and $end) {
$self->log(warn => "Expected timing but found `$line` at $linenum, skipped");
next;
}
$t[0] = parse_timing($start);
unless ($t[0] >= 0) {
$self->log(warn => "Can't parse timing at line $linenum: $start");
next;
}
$t[1] = parse_timing($end);
unless ($t[1] >= 0) {
$self->log(warn => "Can't parse timing at line $linenum: $end");
next;
}
$event->t_start($t[0]);
$event->t_end ($t[1]);
trim($rest);
next unless $rest;
# extension: timing
# example: X1:050 X2:669 Y1:234 Y2:436
if ($rest =~ m/([XY][12]:(\d+))/io) {
foreach my $token (split(/\s+/, $rest)) {
$event->{coords} //= {};
if ($token =~ m/([XY][12]):(\d+)/io) {
$event->{coords}->{lc($1)} = $2;
next;
}
$self->log(warn => "Garbage detected instead event coord: $token");
}
unless (scalar keys %{ $event->{coords} } == 4) {
delete $event->{coords};
$self->log(warn => "Incomplete coord set for event at line $linenum");
}
next;
}
# extension: ssa-like style
# example: SSA: Dialogue, Layer: 0, Style: Reply, Name: NTP, MarginL: 0300, MarginR: 0000, MarginV: 0300, Effect: !Effect
if ($rest =~ m/SSA:\s*\S+,\s*(.+)/o) {
$rest = $1;
foreach my $token (split(/\s*,\s*/, $rest)) {
next unless $token =~ m/^(\S+):\s*(.+)/o;
trim($2);
$event->{style} //= {};
$event->{style}->{lc($1)} = $2;
}
next;
}
$self->log(warn => "garbage after timing at line $linenum: $rest");
next;
}
# expected: empty line
if ($event and not $line) {
$self->log(debug => "Empty line at line $linenum -> finalize");
push @{ $self->{events} }, $event;
undef $event;
next;
}
# expected: event text
if ($line and $event and ($event->t_start or $event->t_end)) {
trim($line);
$self->log(debug => "Text line at $linenum -> append");
my $text = $event->text;
$text .= $self->{eol} if $text;
$text .= $line;
$event->text($text);
next;
}
} # foreach @lines
# finalize last event
if ($event and $event->text and ($event->t_start or $event->t_end)) {
push @{ $self->{events} }, $event;
}
return scalar @{ $self->{events} };
}
sub build {
my ($self) = @_;
my (@lines, $out);
foreach my $e (@{ $self->{events} }) {
push @lines, $e->{id};
my $start = sprintf $self->{timing_fmt}, make_timing($e->t_start);
my $end = sprintf $self->{timing_fmt}, make_timing($e->t_end);
push @lines, sprintf "%s --> %s", $start, $end;
push @lines, $e->text;
push @lines, "";
}
return join($self->{eol} => @lines);
}
10 years ago
1;