|
|
|
@ -2,9 +2,10 @@ package Subtitle::SSA;
|
|
|
|
|
|
|
|
|
|
use strict; |
|
|
|
|
use warnings; |
|
|
|
|
use feature qw(switch); |
|
|
|
|
use utf8; |
|
|
|
|
|
|
|
|
|
use Subtitle::Utils qw(:string :timing); |
|
|
|
|
|
|
|
|
|
use base 'Subtitle::BASE'; |
|
|
|
|
|
|
|
|
|
use constant SSA_STYLE_FMT => [qw(Name Fontname Fontsize PrimaryColour SecondaryColour |
|
|
|
@ -107,7 +108,7 @@ sub parse_event {
|
|
|
|
|
} |
|
|
|
|
foreach my $key (qw(start end)) { |
|
|
|
|
next unless $event->{$key}; |
|
|
|
|
$event->{$key} = $self->parse_timing($event->{$key}); |
|
|
|
|
$event->{$key} = parse_timing($event->{$key}); |
|
|
|
|
} |
|
|
|
|
$event->{marked} =~ s/^Marked=\s*//oi |
|
|
|
|
if ($self->{type} eq 'ssa'); |
|
|
|
@ -125,27 +126,26 @@ sub parse {
|
|
|
|
|
|
|
|
|
|
foreach my $line (@$lines) { |
|
|
|
|
$linenum++; |
|
|
|
|
$line = $self->chomp($line); |
|
|
|
|
$line = $self->trim($line); |
|
|
|
|
chomp_all($line); |
|
|
|
|
trim($line); |
|
|
|
|
next unless $line; |
|
|
|
|
study $line; |
|
|
|
|
|
|
|
|
|
# check section switch |
|
|
|
|
if ($line =~ m/^\s*\[(.+)\]\s*/o) { |
|
|
|
|
my $name = $1; |
|
|
|
|
given ($name) { |
|
|
|
|
when (m/script\s+info/oi) { $section = "header"; } |
|
|
|
|
when (m/events/oi) { $section = "events"; } |
|
|
|
|
when (m/v4(\+)?\s+styles/oi) { |
|
|
|
|
$section = "styles"; |
|
|
|
|
unless ($self->{type}) { |
|
|
|
|
$self->{type} = ($1) ? 'ass' : 'ssa'; |
|
|
|
|
$self->log(warn => "Set type to $self->{type} because of $linenum (fallback mode)"); |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
default { |
|
|
|
|
$self->log(debug => "Unknown section at line $linenum: $line"); |
|
|
|
|
if ($name =~ m{script \s+ info}oix) { |
|
|
|
|
$section = 'header'; |
|
|
|
|
} elsif ($name =~ m{events}oi) { |
|
|
|
|
$section = 'events'; |
|
|
|
|
} elsif ($name =~ m{v4(\+)? \s+ styles}oix) { |
|
|
|
|
$section = 'styles'; |
|
|
|
|
unless ($self->{type}) { |
|
|
|
|
$self->{type} = ($1) ? 'ass' : 'ssa'; |
|
|
|
|
$self->log(warn => "Set type to $self->{type} because of $linenum (fallback mode)"); |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
$self->log(debug => "Unknown section at line $linenum: $line"); |
|
|
|
|
} |
|
|
|
|
next; |
|
|
|
|
} |
|
|
|
@ -209,7 +209,7 @@ sub build {
|
|
|
|
|
my $out = "[Script Info]\n"; |
|
|
|
|
|
|
|
|
|
# headers |
|
|
|
|
foreach my $h (sort keys($self->{headers})) { |
|
|
|
|
foreach my $h (sort keys(%{ $self->{headers} })) { |
|
|
|
|
$out .= sprintf "%s: %s\n", $h, $self->{headers}->{$h}; |
|
|
|
|
} |
|
|
|
|
$out .= "\n"; |
|
|
|
@ -236,10 +236,13 @@ sub build {
|
|
|
|
|
$out .= sprintf "Format: %s\n", join(', ' => @{ $self->SSA_EVENT_FMT }); |
|
|
|
|
} |
|
|
|
|
@fields = @{ $self->{event_fmt} }; |
|
|
|
|
my ($hrs, $min, $sec, $msec); |
|
|
|
|
foreach my $e (@{ $self->{events} }) { |
|
|
|
|
my %event = %{$e}; |
|
|
|
|
$event{start} = $self->build_timing($event{start}); |
|
|
|
|
$event{end} = $self->build_timing($event{end}); |
|
|
|
|
($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}); |
|
|
|
|
} |
|
|
|
|