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:}i; return $self->error("passed custom fields order not ARRAY ref") unless $format and ref($format) eq 'ARRAY'; chomp $line; $line =~ s{^$PREFIX:\s*}{}i; 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->{_format} }) { my $d = $self->{_fields}->{$field}; my $v = $self->{$field} // $d->{value}; if ($d->{type} eq 'x' and $self->{_type} 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{[\.]?0*$}{}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; } sub get_format_line { my ($self) = @_; my @keys = @{ $self->{_format} }; my @names = map { $self->{_fields}->{$_}->{name} } @keys; my $line = 'Format: ' . join(', ' => @names); return $line; } 1;