From 9e362e20ad29f561475d955dd8ec1f24b04717e4 Mon Sep 17 00:00:00 2001 From: Alex 'AdUser' Z Date: Thu, 30 Jun 2016 16:27:05 +1000 Subject: [PATCH] * Subtitle::SSA::Record : generalize parse() & to_string() --- lib/Subtitle/SSA/Record.pm | 67 ++++++++++++++++++++++++++++++++++++++ lib/Subtitle/SSA/Style.pm | 53 ++---------------------------- 2 files changed, 69 insertions(+), 51 deletions(-) diff --git a/lib/Subtitle/SSA/Record.pm b/lib/Subtitle/SSA/Record.pm index f8778a7..ace5df8 100644 --- a/lib/Subtitle/SSA/Record.pm +++ b/lib/Subtitle/SSA/Record.pm @@ -4,10 +4,15 @@ 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 { @@ -47,4 +52,66 @@ sub set { return 1; } +# 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; diff --git a/lib/Subtitle/SSA/Style.pm b/lib/Subtitle/SSA/Style.pm index 89988b3..79ba97d 100644 --- a/lib/Subtitle/SSA/Style.pm +++ b/lib/Subtitle/SSA/Style.pm @@ -9,12 +9,7 @@ use base 'Subtitle::SSA::Record'; my @FIELDS_SSA = qw(name fontname fontsize primarycolour secondarycolour tertiarycolour backcolour bold italic borderstyle outline shadow alignment marginl marginr marginv alphalevel encoding); my @FIELDS_ASS = qw(name fontname fontsize primarycolour secondarycolour outlinecolour backcolour bold italic underline strikeout scalex scaley spacing angle borderstyle outline shadow alignment marginl marginr marginv encoding); -# formats: -# s - string, use as is -# d - decimal, no-zero pad -# b - boolean, 0 as false, -1 as true -# f - float, 6.01 or 6 if no fractional part -# x - hex-number, &H00AABBCC for ASS or decimal number for SSA +# see parse() description for available type's my %FIELDS = ( name => { type => 's', value => 'Default', name => 'Name' }, fontname => { type => 's', value => 'Arial' , name => 'Fontname' }, @@ -42,50 +37,6 @@ my %FIELDS = ( alphalevel => { type => 'd', value => 0, name => 'AlphaLevel' }, encoding => { type => 'd', value => 204, name => 'Encoding' }, ); - -sub parse { - my ($self, $fields, $line) = @_; - - return unless $fields and ref($fields) eq 'ARRAY'; - return unless $line and $line =~ m{^Style:}oi; - - chomp $line; - $line =~ s{^style:\s+}{}oi; - my @values = split /,\s*/o, $line; - # check that values count match fields count - return unless scalar @{ $fields } != scalar @values; - - foreach my $field (@{ $fields }) { - my $value = shift @values; - $self->set($field => $value); - } - - return 1; -} - -sub to_string { - my ($self) = @_; - my @fields = $self->fields(); - my $string = "Style: "; - 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; - } else { - # use as is - } - push @values, $v; - } - $string .= join(',', @values); - - return $string; -} +my $PREFIX = 'Style'; 1;