libsubtitle-perl/lib/Subtitle/Format/SSA/Event.pm

package Subtitle::Format::SSA::Event;

use strict;
use warnings;
use utf8;

use base qw(Subtitle::Event Subtitle::Format::SSA::Record);

my @FIELDS_SSA = qw(marked start end style name marginl marginr marginv effect text);
my @FIELDS_ASS = qw(layer  start end style name marginl marginr marginv effect text);

# see parse() description for available type's
my %FIELDS = (
  marked  => { type => 's', value => 'Marked=0', name => 'Marked'  },
  layer   => { type => 'd', value =>  0,         name => 'Layer'   },
  start   => { type => 't', value =>  0,         name => 'Start'   },
  end     => { type => 't', value =>  0,         name => 'End'     },
  style   => { type => 's', value => 'Default',  name => 'Style'   },
  name    => { type => 's', value => '',         name => 'Name'    },
  marginl => { type => 'z', value => 0,          name => 'MarginL' },
  marginr => { type => 'z', value => 0,          name => 'MarginR' },
  marginv => { type => 'z', value => 0,          name => 'MarginV' },
  effect  => { type => 's', value => '',         name => 'Effect'  },
  text    => { type => 's', value => '',         name => 'Text'    },
);

# options:
#  * type - 'ssa' for v4 or 'ass' for v4+
sub new {
  my ($class, %opts) = @_;
  my $self = {
    _type   => 'ass',
    _fields => \%FIELDS,
    _format => \@FIELDS_ASS,
    _prefix => qr/(Dialogue|Comment|Picture|Sound|Movie|Command)/,
  };

  if (my $t = $opts{type}) {
    if ($t =~ m{^(ass|ssa)$}oi) {
      $self->{_type} = lc($t);
    } else {
      die("unsupported event type $t");
    }
  }

  $self->{_format} = \@FIELDS_SSA
    if $self->{_type} eq 'ssa';

  my @fields = @{ $self->{_format} };
  $self->{$_} = $FIELDS{$_}->{value}
    foreach @fields;

  return bless($self, $class);
}

1;