Browse Source

* Subtitle::SSA::Record : generalize parse() & to_string()

master
Alex 'AdUser' Z 9 years ago
parent
commit
9e362e20ad
  1. 67
      lib/Subtitle/SSA/Record.pm
  2. 53
      lib/Subtitle/SSA/Style.pm

67
lib/Subtitle/SSA/Record.pm

@ -4,10 +4,15 @@ use strict;
use warnings; use warnings;
use utf8; use utf8;
use Subtitle::Utils qw(:timing);
use overload => ( use overload => (
'""' => \&to_string, '""' => \&to_string,
); );
my %FIELDS = (); # must be redefined in subclass
my $PREFIX = ''; # must be redefined in subclass
# options: # options:
# * version - 'ssa' for v4 or 'ass' for v4+ # * version - 'ssa' for v4 or 'ass' for v4+
sub new { sub new {
@ -47,4 +52,66 @@ sub set {
return 1; 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; 1;

53
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_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); 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: # see parse() description for available type's
# 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
my %FIELDS = ( my %FIELDS = (
name => { type => 's', value => 'Default', name => 'Name' }, name => { type => 's', value => 'Default', name => 'Name' },
fontname => { type => 's', value => 'Arial' , name => 'Fontname' }, fontname => { type => 's', value => 'Arial' , name => 'Fontname' },
@ -42,50 +37,6 @@ my %FIELDS = (
alphalevel => { type => 'd', value => 0, name => 'AlphaLevel' }, alphalevel => { type => 'd', value => 0, name => 'AlphaLevel' },
encoding => { type => 'd', value => 204, name => 'Encoding' }, encoding => { type => 'd', value => 204, name => 'Encoding' },
); );
my $PREFIX = 'Style';
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;
}
1; 1;

Loading…
Cancel
Save