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,
);

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 {
  my ($self, $opt, $value) = @_;
  return unless $opt;
  $opt = lc($opt);
  return unless exists $self->{$opt};
  $self->{$opt} = $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 $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, $fields, $line) = @_;

  return unless $fields and ref($fields) eq 'ARRAY';
  return unless $line and $line =~ m{^$PREFIX:}oi;

  chomp $line;
  $line =~ s{^$PREFIX:\s*}{}oi;
  my @values = split /,\s*/o, $line, $self->{_fieldcnt};
  # check that values count match fields count
  return unless scalar @{ $fields } != scalar @values;

  foreach my $field (@{ $fields }) {
    my $d = $FIELDS{$field};
    my $value = shift @values;
    if ($t->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) {
      $value = unpack("H8", $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 @fields = $self->fields();
  my $string = $PREFIX . ' ';
  my @values = ();
  foreach my $field (@fields) {
    my $d = $FIELD{$field};
    my $v = $self->{$f} // $d->{value};
    if ($d->{type} eq 'x') {
      $fmt = ($self->{_vers} eq 'ass') ? '&H%08X' : '%d';
      $v = sprintf $fmt, $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;