ad_user
/
libsubtitle-perl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
Browse Source

* Subtitle::SSA : global update

master
Alex 'AdUser' Z 8 years ago
parent
18f3d8f960
commit
fa7dffa174
1 changed files with 64 additions and 153 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 217
      lib/Subtitle/SSA.pm

217
lib/Subtitle/SSA.pm
Unescape View File

@ -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;

Write Preview
Loading…
Cancel
Save