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

* Subtitle::SSA : first working version

master
Alex 'AdUser' Z 10 years ago
parent
829337a72f
commit
8f1e59f67b
1 changed files with 172 additions and 5 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. 177
      lib/Subtitle/SSA.pm

177
lib/Subtitle/SSA.pm
Unescape View File

@ -7,14 +7,28 @@ use utf8;
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 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)];
sub new {
my ($class, %args) = @_;
my $self = {
debug => 0,
eol => "\n",
type => undef,
%args,
events => [],
log => [],
headers => {},
styles => [],
events => [],
log => [],
};
return bless($self, $class);
@ -22,7 +36,6 @@ sub new {
sub parse_timing {
my ($self, $str) = @_;
...
my $time = 0.0;
return unless $str =~ m/(\d+):(\d+):(\d+)([.,])(\d+)/oi;
my ($hrs, $min, $sec, $delim, $msec) = ($1, $2, $3, $4, $5);
@ -54,14 +67,168 @@ sub parse_timing {
return $time;
}
sub new_event { return +{ id => undef, timing => undef, style => undef, text => undef }; }
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} = $self->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 {
my ($self, $lines) = @_;
my $linenum = 0;
my $event;
my $section;
foreach my $line (@$lines) {
$linenum++;
$line = $self->chomp($line);
$line = $self->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");
}
}
next;
}
#
unless ($section) {
$self->log(warn => "Line $linenum outside any section: $line");
next;
}
if ($section eq 'header') {
$self->parse_header($linenum, $line);
next;
}
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;
$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");
$self->{style_fmt} = ($self->{type} and $self->{type} eq 'ass')
? ASS_STYLE_FMT : SSA_STYLE_FMT;
}
$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;
$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");
$self->{event_fmt} = ($self->{type} and $self->{type} eq 'ass')
? ASS_EVENT_FMT : SSA_EVENT_FMT;
}
$self->parse_event($linenum, $line);
next;
}
$self->log(warn => "unrecognized line at $linenum: $line");
}
return scalar @{ $self->{events} };

Write Preview
Loading…
Cancel
Save