From 8f1e59f67bf0f611da26c51b642c125b85047301 Mon Sep 17 00:00:00 2001 From: Alex 'AdUser' Z Date: Fri, 20 Feb 2015 17:44:46 +1000 Subject: [PATCH] * Subtitle::SSA : first working version --- lib/Subtitle/SSA.pm | 177 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 172 insertions(+), 5 deletions(-) diff --git a/lib/Subtitle/SSA.pm b/lib/Subtitle/SSA.pm index c9d4c61..e057310 100644 --- a/lib/Subtitle/SSA.pm +++ b/lib/Subtitle/SSA.pm @@ -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} };