From fa7dffa1745b483cc582e9efef042cf562716bdf Mon Sep 17 00:00:00 2001 From: Alex 'AdUser' Z Date: Wed, 6 Jul 2016 17:39:02 +1000 Subject: [PATCH] * Subtitle::SSA : global update --- lib/Subtitle/SSA.pm | 217 +++++++++++++------------------------------- 1 file changed, 64 insertions(+), 153 deletions(-) diff --git a/lib/Subtitle/SSA.pm b/lib/Subtitle/SSA.pm index 66bb5f7..20428de 100644 --- a/lib/Subtitle/SSA.pm +++ b/lib/Subtitle/SSA.pm @@ -4,119 +4,31 @@ use strict; use warnings; use utf8; -use Subtitle::Utils qw(:string :timing); +use Subtitle::SSA::Header; +use Subtitle::SSA::Style; +use Subtitle::SSA::Event; -use base 'Subtitle::BASE'; - -use constant SSA_STYLE_FMT => [qw(Name Fontname Fontsize PrimaryColour SecondaryColour - TertiaryColour BackColour Bold Italic - BorderStyle Outline Shadow Alignment MarginL MarginR MarginV AlphaLevel Encoding)]; - -use constant ASS_STYLE_FMT => [qw(Name Fontname Fontsize PrimaryColour SecondaryColour - OutlineColour BackColour Bold Italic Underline Strikeout ScaleX ScaleY Spacing Angle - BorderStyle Outline Shadow Alignment MarginL MarginR MarginV Encoding)]; +use Subtitle::Utils qw(:string); -use constant SSA_EVENT_FMT => [qw(Marked Start End Style Name MarginL MarginR MarginV Effect Text)]; -use constant ASS_EVENT_FMT => [qw(Layer Start End Style Name MarginL MarginR MarginV Effect Text)]; +use base 'Subtitle::BASE'; sub new { my ($class, %args) = @_; my $self = { - debug => 0, - eol => "\n", - type => undef, + debug => 0, + eol => "\n", + type => undef, %args, + h_order => [], # headers order headers => {}, styles => [], events => [], log => [], - timing_fmt => "%d:%02d:%02d.%s", }; return bless($self, $class); } -sub parse_header { - my ($self, $linenum, $line) = @_; - - return if $line =~ m/^\s*;/; # comment - - my ($name, $value) = ($line =~ m/^(.+):\s*(.*)$/o); - if ($name and not defined $value) { - $self->log(debug => "Header line with empty value at $linenum, skipped: $line"); - return; - } - unless ($name) { - $self->log(debug => "Can't parse header line at $linenum: $line"); - return; - } - $self->log(warn => "Duplicate header $name at line $linenum, overwriting") - if (exists $self->{headers}->{$name}); - - $self->{headers}->{$name} = $value; - if (lc($name) eq 'scripttype') { - $self->{type} = (lc($value) eq 'v4.00+') ? 'ass' : 'ssa'; - $self->log(debug => "Set type to $self->{type} because of line $linenum: $line"); - } - return; -} - -sub parse_style { - my ($self, $linenum, $line) = @_; - - my ($rest) = ($line =~ m/^\s*Style:\s*(.+)/oi); - unless ($rest) { - $self->log(warn => "Can't parse style at line $linenum: $line"); - return; - } - - my $fields = scalar @{ $self->{style_fmt} }; - my @values = split /\s*,\s*/, $rest; - if($fields != scalar @values) { - $self->log(warn => "Style line fields at $linenum not equals number of style format fields"); - return; - } - - my $style = {}; - for (my $i = 0; $i < $fields; $i++) { - $style->{$self->{style_fmt}->[$i]} = $values[$i]; - } - push @{ $self->{styles} }, $style; - - return; -} - -sub parse_event { - my ($self, $linenum, $line) = @_; - - my ($type, $rest) = ($line =~ m/^\s*(Dialogue):\s*(.+)/oi); - unless ($rest) { - $self->log(warn => "Can't parse style at line $linenum: $line"); - return; - } - - my $fields = scalar @{ $self->{event_fmt} }; - my @values = split /\s*,\s*/, $rest, $fields; - if($fields > scalar @values) { - $self->log(warn => "Event line fields at $linenum less than number of style format fields ($fields)"); - return; - } - - my $event = { type => lc($type) }; - for (my $i = 0; $i < $fields; $i++) { - $event->{$self->{event_fmt}->[$i]} = $values[$i]; - } - foreach my $key (qw(start end)) { - next unless $event->{$key}; - $event->{$key} = parse_timing($event->{$key}); - } - $event->{marked} =~ s/^Marked=\s*//oi - if ($self->{type} eq 'ssa'); - - push @{ $self->{events} }, $event; - return; -} - sub new_event { ... } sub parse { @@ -145,57 +57,65 @@ sub parse { $self->log(warn => "Set type to $self->{type} because of $linenum (fallback mode)"); } } else { + undef $section; $self->log(debug => "Unknown section at line $linenum: $line"); } next; } # unless ($section) { - $self->log(warn => "Line $linenum outside any section: $line"); + $self->log(warn => "Line $linenum outside any section, skip"); next; } + # TODO: fonts section + # skip comments + next if $line =~ m{^ \s* ;}xo; if ($section eq 'header') { - $self->parse_header($linenum, $line); + my $header = Subtitle::SSA::Header->new; + unless ($header->parse($line)) { + $self->log(error => "Can't parse header at line $linenum: $line"); + next; + } + my $key = $header->hash_key(); + if (exists $self->{headers}->{$key}) { + $self->log(warn => "Duplicate header at line $linenum: $header->{name}, replacing"); + } else { + push @{ $self->{h_order} }, $key; + } + $self->{headers}->{$key} = $header; next; + if ($key eq 'scripttype') { + my $type = index($header->{type}, "+") >= 0 ? 'ass' : 'ssa'; + $self->log(info => "File recognized as '$type' type from header at $linenum"); + $self->{type} = $type; + } } if ($section eq 'styles') { - if ($line =~ m/^\s*Format:\s*(.*)/oi) { - if ($self->{style_fmt}) { - $self->log(error => "Style format found at line $linenum, but already set before"); - next; - } - my @fmt = map { lc($_) } split(/\s*,\s*/o, $1); - $self->{style_fmt} = \@fmt; + if ($line =~ m/^\s*Format:/oi) { $self->log(debug => "Set style format from line $linenum"); next; } - unless ($self->{style_fmt}) { - $self->log(warn => "Style format still not set, assuming default for $self->{type} type"); - my @fmt = ($self->{type} and $self->{type} eq 'ass') - ? ASS_STYLE_FMT : SSA_STYLE_FMT; - $self->{style_fmt} = [ map { lc($_) } @fmt ] ; + my $style = Subtitle::SSA::Style->new(type => $self->{type}); + if ($style->parse($line)) { + push @{ $self->{styles} }, $style; + } else { + my $error = $style->error(); + $self->log(error => "Can't parse style at line $linenum: $error"); } - $self->parse_style($linenum, $line); next; } if ($section eq 'events') { - if ($line =~ m/^\s*Format:\s*(.*)/oi) { - if ($self->{event_fmt}) { - $self->log(error => "Event format found at line $linenum, but already set before"); - next; - } - my @fmt = map { lc($_) } split(/\s*,\s*/o, $1); - $self->{event_fmt} = \@fmt; + if ($line =~ m/^\s*Format:/oi) { $self->log(debug => "Set event format from line $linenum"); next; } - unless ($self->{event_fmt}) { - $self->log(warn => "Event format still not set, assuming default for $self->{type} type"); - my @fmt = ($self->{type} and $self->{type} eq 'ass') - ? ASS_EVENT_FMT : SSA_EVENT_FMT; - $self->{event_fmt} = [ map { lc($_) } @fmt ]; + my $event = Subtitle::SSA::Event->new(type => $self->{type}); + if ($event->parse($line)) { + push @{ $self->{events} }, $event; + } else { + my $error = $event->error(); + $self->log(error => "Can't parse event at line $linenum: $error"); } - $self->parse_event($linenum, $line); next; } $self->log(warn => "unrecognized line at $linenum: $line"); @@ -206,49 +126,40 @@ sub parse { sub build { my ($self) = @_; - my $out = "[Script Info]\n"; + my (@lines, $out); # headers - foreach my $h (sort keys(%{ $self->{headers} })) { - $out .= sprintf "%s: %s\n", $h, $self->{headers}->{$h}; + push @lines, "[Script Info]"; + push @lines, "; generated with Subtitle::SSA"; + foreach my $key (@{ $self->{h_order} }) { + my $h = $self->{headers}->{$key}; + push @lines, $h->to_string(); } - $out .= "\n"; + push @lines, ""; # styles if ($self->{type} eq 'ass') { - $out .= "[V4+ Styles]\n"; - $out .= sprintf "Format: %s\n", join(', ' => @{ $self->ASS_STYLE_FMT }); + push @lines, "[V4+ Styles]"; } else { - $out .= "[V4 Styles]\n"; - $out .= sprintf "Format: %s\n", join(', ' => @{ $self->SSA_STYLE_FMT }); + push @lines, "[V4 Styles]"; } - my @fields = @{ $self->{style_fmt} }; + push @lines, Subtitle::SSA::Style->new(type => $self->{type})->get_format_line(); foreach my $s (@{ $self->{styles} }) { - $out .= sprintf "Style: %s\n", join(",", @{$s}{@fields}); + push @lines, $s->to_string(); } - $out .= "\n"; + push @lines, ""; # events - $out .= "[Events]\n"; - if ($self->{type} eq 'ass') { - $out .= sprintf "Format: %s\n", join(', ' => @{ $self->ASS_EVENT_FMT }); - } else { - $out .= sprintf "Format: %s\n", join(', ' => @{ $self->SSA_EVENT_FMT }); - } - @fields = @{ $self->{event_fmt} }; - my ($hrs, $min, $sec, $msec); + push @lines, "[Events]"; + push @lines, Subtitle::SSA::Event->new(type => $self->{type})->get_format_line(); foreach my $e (@{ $self->{events} }) { - my %event = %{$e}; - ($hrs, $min, $sec, $msec) = make_timing($e->{start}); - $event{start} = sprintf $self->{timing_fmt}, $hrs, $min, $sec, int($msec / 10); - ($hrs, $min, $sec, $msec) = make_timing($e->{end}); - $event{end} = sprintf $self->{timing_fmt}, $hrs, $min, $sec, int($msec / 10); - $event{marked} =~ s/^/Marked=/o if $self->{type} eq 'ssa'; - $out .= sprintf "%s: %s\n", ucfirst($e->{type}), join(',' => @event{@fields}); + push @lines, $e->to_string(); } - $out .= "\n"; + push @lines, ""; + + # TODO: fonts - return $out; + return join($self->{eol}, @lines); } 1;