|
|
@ -6,50 +6,16 @@ use utf8; |
|
|
|
|
|
|
|
|
|
|
|
use Subtitle::Utils qw(:timing); |
|
|
|
use Subtitle::Utils qw(:timing); |
|
|
|
|
|
|
|
|
|
|
|
use overload => ( |
|
|
|
use overload |
|
|
|
'""' => \&to_string, |
|
|
|
'""' => \&to_string, |
|
|
|
); |
|
|
|
; |
|
|
|
|
|
|
|
|
|
|
|
my %FIELDS = (); # must be redefined in subclass |
|
|
|
|
|
|
|
my $PREFIX = ''; # must be redefined in subclass |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# options: |
|
|
|
|
|
|
|
# * version - 'ssa' for v4 or 'ass' for v4+ |
|
|
|
|
|
|
|
sub new { |
|
|
|
|
|
|
|
my ($class, %opts) = @_; |
|
|
|
|
|
|
|
my $self = { |
|
|
|
|
|
|
|
_vers => 'ass', |
|
|
|
|
|
|
|
}; |
|
|
|
|
|
|
|
bless($self, $class); |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if ($opts{version} and $opts{version} =~ m{^(ass|ssa)$}oi) { |
|
|
|
|
|
|
|
$self->{_vers} = lc($opts{version}); |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
my @fields = $self->fields(); |
|
|
|
|
|
|
|
$self->{_fieldcnt} = scalar @fields; |
|
|
|
|
|
|
|
foreach my $field (@fields) { |
|
|
|
|
|
|
|
$self->{$field} = ($opts{defaults}) |
|
|
|
|
|
|
|
? $FIELDS{$field}->{value} |
|
|
|
|
|
|
|
: undef; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
return $self; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub fields { |
|
|
|
|
|
|
|
my ($self) = @_; |
|
|
|
|
|
|
|
return ($self->{_vers} eq 'ssa') |
|
|
|
|
|
|
|
? @FIELDS_SSA |
|
|
|
|
|
|
|
: @FIELDS_ASS; |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub set { |
|
|
|
sub set { |
|
|
|
my ($self, $opt, $value) = @_; |
|
|
|
my ($self, $field, $value) = @_; |
|
|
|
return unless $opt; |
|
|
|
return unless $field; |
|
|
|
$opt = lc($opt); |
|
|
|
$field = lc($field); |
|
|
|
return unless exists $self->{$opt}; |
|
|
|
return unless exists $self->{$field}; |
|
|
|
$self->{$opt} = $value; |
|
|
|
$self->{$field} = $value; |
|
|
|
return 1; |
|
|
|
return 1; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -59,12 +25,12 @@ sub parse_format_line { |
|
|
|
return unless $line and $line =~ m{^Format:}oi; |
|
|
|
return unless $line and $line =~ m{^Format:}oi; |
|
|
|
|
|
|
|
|
|
|
|
chomp $line; |
|
|
|
chomp $line; |
|
|
|
$line =~ s{^Format:\s+}{}oi; |
|
|
|
$line =~ s{^Format:\s*}{}oi; |
|
|
|
|
|
|
|
|
|
|
|
my @fields; |
|
|
|
my @fields; |
|
|
|
foreach my $field (split(/,\s*/o, $line)) { |
|
|
|
foreach my $field (split(/,\s*/o, $line)) { |
|
|
|
$field = lc($field); |
|
|
|
$field = lc($field); |
|
|
|
return unless exists $FIELDS{$field}; |
|
|
|
return unless exists $self->{_fields}->{$field}; |
|
|
|
push @fields, $field; |
|
|
|
push @fields, $field; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -79,22 +45,25 @@ sub parse_format_line { |
|
|
|
# f - float, 6.01 or 6 if no fractional part |
|
|
|
# f - float, 6.01 or 6 if no fractional part |
|
|
|
# x - hex-number, &H00AABBCC for ASS or decimal number for SSA |
|
|
|
# x - hex-number, &H00AABBCC for ASS or decimal number for SSA |
|
|
|
sub parse { |
|
|
|
sub parse { |
|
|
|
my ($self, $fields, $line) = @_; |
|
|
|
my ($self, $line, $format) = @_; |
|
|
|
|
|
|
|
$format //= $self->{_format}; |
|
|
|
|
|
|
|
|
|
|
|
return unless $fields and ref($fields) eq 'ARRAY'; |
|
|
|
my $PREFIX = $self->{_prefix}; |
|
|
|
return unless $line and $line =~ m{^$PREFIX:}oi; |
|
|
|
return unless $line and $line =~ m{^$PREFIX:}oi; |
|
|
|
|
|
|
|
return unless $format and ref($format) eq 'ARRAY'; |
|
|
|
|
|
|
|
|
|
|
|
chomp $line; |
|
|
|
chomp $line; |
|
|
|
$line =~ s{^$PREFIX:\s*}{}oi; |
|
|
|
$line =~ s{^$PREFIX:\s*}{}oi; |
|
|
|
my @values = split /,\s*/o, $line, $self->{_fieldcnt}; |
|
|
|
my $fieldcnt = scalar @{ $format }; |
|
|
|
|
|
|
|
my @values = split /,\s*/o, $line, $fieldcnt; |
|
|
|
# check that values count match fields count |
|
|
|
# check that values count match fields count |
|
|
|
return unless scalar @{ $fields } != scalar @values; |
|
|
|
return if scalar @values != $fieldcnt; |
|
|
|
|
|
|
|
|
|
|
|
foreach my $field (@{ $fields }) { |
|
|
|
foreach my $field (@{ $format }) { |
|
|
|
my $d = $FIELDS{$field}; |
|
|
|
my $d = $self->{_fields}->{$field}; |
|
|
|
my $value = shift @values; |
|
|
|
my $value = shift @values; |
|
|
|
if ($t->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) { |
|
|
|
if ($d->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) { |
|
|
|
$value = unpack("H8", $1); |
|
|
|
$value = hex($1); |
|
|
|
} elsif ($d->{type} eq 't') { |
|
|
|
} elsif ($d->{type} eq 't') { |
|
|
|
$value = parse_timing($value); |
|
|
|
$value = parse_timing($value); |
|
|
|
return if $value < 0; # parsing failure |
|
|
|
return if $value < 0; # parsing failure |
|
|
@ -107,15 +76,13 @@ sub parse { |
|
|
|
|
|
|
|
|
|
|
|
sub to_string { |
|
|
|
sub to_string { |
|
|
|
my ($self) = @_; |
|
|
|
my ($self) = @_; |
|
|
|
my @fields = $self->fields(); |
|
|
|
my $string = $self->{_prefix} . ' '; |
|
|
|
my $string = $PREFIX . ' '; |
|
|
|
|
|
|
|
my @values = (); |
|
|
|
my @values = (); |
|
|
|
foreach my $field (@fields) { |
|
|
|
foreach my $field (@{ $self->{_fields} }) { |
|
|
|
my $d = $FIELD{$field}; |
|
|
|
my $d = $self->{_fields}->{$field}; |
|
|
|
my $v = $self->{$f} // $d->{value}; |
|
|
|
my $v = $self->{$field} // $d->{value}; |
|
|
|
if ($d->{type} eq 'x') { |
|
|
|
if ($d->{type} eq 'x' and $self->{_vers} eq 'ass') { |
|
|
|
$fmt = ($self->{_vers} eq 'ass') ? '&H%08X' : '%d'; |
|
|
|
$v = sprintf '&H%08X', $v; |
|
|
|
$v = sprintf $fmt, $v; |
|
|
|
|
|
|
|
} elsif ($d->{type} eq 'f') { |
|
|
|
} elsif ($d->{type} eq 'f') { |
|
|
|
$v = sprintf "%.2f", $v; |
|
|
|
$v = sprintf "%.2f", $v; |
|
|
|
# hack: make decimal from float if fractional part is zero after round up |
|
|
|
# hack: make decimal from float if fractional part is zero after round up |
|
|
|