|
|
|
package Subtitle::SSA::Record;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
use utf8;
|
|
|
|
|
|
|
|
use Subtitle::Utils qw(:timing);
|
|
|
|
|
|
|
|
use overload
|
|
|
|
'""' => \&to_string,
|
|
|
|
;
|
|
|
|
|
|
|
|
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 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 unless exists $self->{_fields}->{$field};
|
|
|
|
push @fields, $field;
|
|
|
|
}
|
|
|
|
|
|
|
|
return [ @fields ];
|
|
|
|
}
|
|
|
|
|
|
|
|
# formats:
|
|
|
|
# s - string, use as is
|
|
|
|
# d - decimal, no-zero pad
|
|
|
|
# b - boolean, 0 as false, -1 as true
|
|
|
|
# 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
|
|
|
|
sub parse {
|
|
|
|
my ($self, $line, $format) = @_;
|
|
|
|
$format //= $self->{_format};
|
|
|
|
|
|
|
|
my $PREFIX = $self->{_prefix};
|
|
|
|
return unless $line and $line =~ m{^$PREFIX:}oi;
|
|
|
|
return 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 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 't') {
|
|
|
|
$value = parse_timing($value);
|
|
|
|
return 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 '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;
|