diff --git a/lib/Subtitle/SSA/Event.pm b/lib/Subtitle/SSA/Event.pm index ec23e31..9999ff5 100644 --- a/lib/Subtitle/SSA/Event.pm +++ b/lib/Subtitle/SSA/Event.pm @@ -23,6 +23,34 @@ my %FIELDS = ( effect => { type => 's', value => '', name => 'Effect' }, text => { type => 's', value => '', name => 'Text' }, ); -my $PREFIX = 'Dialogue'; + +# options: +# * version - 'ssa' for v4 or 'ass' for v4+ +sub new { + my ($class, %opts) = @_; + my $self = { + _vers => 'ass', + _fields => \%FIELDS, + _format => \@FIELDS_ASS, + _prefix => 'Dialogue', + }; + + if (my $v = $opts{version}) { + if ($v =~ m{^(ass|ssa)$}oi) { + $self->{_vers} = lc($v); + } else { + die("unsupported event version $v"); + } + } + + $self->{_format} = \@FIELDS_SSA + if $self->{_vers} eq 'ssa'; + + my @fields = $self->{_fields}; + $self->{$_} = $FIELDS{$_}->{value} + foreach @fields; + + return bless($self, $class); +} 1; diff --git a/lib/Subtitle/SSA/Record.pm b/lib/Subtitle/SSA/Record.pm index cbdb051..c3543a7 100644 --- a/lib/Subtitle/SSA/Record.pm +++ b/lib/Subtitle/SSA/Record.pm @@ -6,50 +6,16 @@ use utf8; use Subtitle::Utils qw(:timing); -use overload => ( +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; + my ($self, $field, $value) = @_; + return unless $field; + $field = lc($field); + return unless exists $self->{$field}; + $self->{$field} = $value; return 1; } @@ -59,12 +25,12 @@ sub parse_format_line { return unless $line and $line =~ m{^Format:}oi; chomp $line; - $line =~ s{^Format:\s+}{}oi; + $line =~ s{^Format:\s*}{}oi; my @fields; foreach my $field (split(/,\s*/o, $line)) { $field = lc($field); - return unless exists $FIELDS{$field}; + return unless exists $self->{_fields}->{$field}; push @fields, $field; } @@ -79,22 +45,25 @@ sub parse_format_line { # 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) = @_; + 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 $format and ref($format) eq 'ARRAY'; chomp $line; $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 - return unless scalar @{ $fields } != scalar @values; + return if scalar @values != $fieldcnt; - foreach my $field (@{ $fields }) { - my $d = $FIELDS{$field}; + foreach my $field (@{ $format }) { + my $d = $self->{_fields}->{$field}; my $value = shift @values; - if ($t->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) { - $value = unpack("H8", $1); + if ($d->{type} eq 'x' and $value =~ m<&H([0-9a-f]{8})>oi) { + $value = hex($1); } elsif ($d->{type} eq 't') { $value = parse_timing($value); return if $value < 0; # parsing failure @@ -107,15 +76,13 @@ sub parse { sub to_string { my ($self) = @_; - my @fields = $self->fields(); - my $string = $PREFIX . ' '; + my $string = $self->{_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; + foreach my $field (@{ $self->{_fields} }) { + my $d = $self->{_fields}->{$field}; + my $v = $self->{$field} // $d->{value}; + if ($d->{type} eq 'x' and $self->{_vers} 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 diff --git a/lib/Subtitle/SSA/Style.pm b/lib/Subtitle/SSA/Style.pm index 79ba97d..9137074 100644 --- a/lib/Subtitle/SSA/Style.pm +++ b/lib/Subtitle/SSA/Style.pm @@ -37,6 +37,34 @@ my %FIELDS = ( alphalevel => { type => 'd', value => 0, name => 'AlphaLevel' }, encoding => { type => 'd', value => 204, name => 'Encoding' }, ); -my $PREFIX = 'Style'; + +# options: +# * version - 'ssa' for v4 or 'ass' for v4+ +sub new { + my ($class, %opts) = @_; + my $self = { + _vers => 'ass', + _fields => \%FIELDS, + _format => \@FIELDS_ASS, + _prefix => 'Style', + }; + + if (my $v = $opts{version}) { + if ($v =~ m{^(ass|ssa)$}oi) { + $self->{_vers} = lc($v); + } else { + die("unsupported event version $v"); + } + } + + $self->{_format} = \@FIELDS_SSA + if $self->{_vers} eq 'ssa'; + + my @fields = @{ $self->{_format} }; + $self->{$_} = $FIELDS{$_}->{value} + foreach @fields; + + return bless($self, $class); +} 1;