libsubtitle-perl/lib/Subtitle/SSA/Record.pm

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;
  $self->{_prefix} = $1
    if ref($self->{_prefix}) eq 'Regexp';
  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;