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.

124 lines
3.1 KiB

package Subtitle::SSA::Record;
use strict;
use warnings;
use utf8;
use Subtitle::Utils qw(:timing);
use overload
'""' => \&to_string,
;
sub error {
my ($self, $text) = @_;
if (defined $text) {
$self->{_error} = $text;
return;
}
return $self->{_error};
}
sub set {
my ($self, $field, $value) = @_;
return unless $field;
$field = lc($field);
return unless exists $self->{$field};
$self->{$field} = $value;
return 1;
}
sub parse_format_line {
my ($self, $line) = @_;
return $self->error("not looks like Format line")
unless $line and $line =~ m{^Format:}oi;
chomp $line;
$line =~ s{^Format:\s*}{}oi;
my @fields;
foreach my $field (split(/,\s*/o, $line)) {
$field = lc($field);
return $self->error("unknown field: $field")
unless exists $self->{_fields}->{$field};
push @fields, $field;
}
return [ @fields ];
}
# formats:
# s - string, use as is
# d - decimal, no-zero pad
# t - timing, like H:MM:SS.MSEC
# f - float, 6.01 or 6 if no fractional part
# x - hex-number, &H00AABBCC for ASS or decimal number for SSA
# special cases:
# b - boolean, 0 as false, -1 as true (used in styles)
# z - same as decimal, but zero-padded to 4 digits (used in dialigue, for offset in pixels)
sub parse {
my ($self, $line, $format) = @_;
$format //= $self->{_format};
my $PREFIX = $self->{_prefix};
return $self->error("not looks like $PREFIX line")
unless $line and $line =~ m{^$PREFIX:}oi;
return $self->error("passed custom fields order not ARRAY ref")
unless $format and ref($format) eq 'ARRAY';
chomp $line;
$line =~ s{^$PREFIX:\s*}{}oi;
my $fieldcnt = scalar @{ $format };
my @values = split /,\s*/o, $line, $fieldcnt;
# check that values count match fields count
return $self->error("number of fields less than expected count")
if scalar @values < $fieldcnt;
foreach my $field (@{ $format }) {
my $d = $self->{_fields}->{$field};
my $value = shift @values;
if ($d->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) {
$value = hex($1);
} elsif ($d->{type} eq 'z') {
$value = int($value);
} elsif ($d->{type} eq 't') {
$value = parse_timing($value);
return $self->error("can't parse timing: $value")
if $value < 0; # parsing failure
}
$self->set($field => $value);
}
return 1;
}
sub to_string {
my ($self) = @_;
my $string = $self->{_prefix} . ' ';
my @values = ();
foreach my $field (@{ $self->{_fields} }) {
my $d = $self->{_fields}->{$field};
my $v = $self->{$field} // $d->{value};
if ($d->{type} eq 'x' and $self->{_vers} eq 'ass') {
$v = sprintf '&H%08X', $v;
} elsif ($d->{type} eq 'f') {
$v = sprintf "%.2f", $v;
# hack: make decimal from float if fractional part is zero after round up
$v =~ s{\.00$}{}oi;
} elsif ($d->{type} eq 'z') {
$v = sprintf "%04d", $v;
} elsif ($d->{type} eq 't') {
my ($h, $m, $s, $ms) = make_timing($v);
$v = sprintf("%d:%02d:%02d.%02d", $h, $m, $s, int($ms / 10));
} else {
# use as is
}
push @values, $v;
}
$string .= join(',', @values);
return $string;
}
1;