package Subtitle::SSA; use strict; use warnings; use utf8; use Subtitle::SSA::Header; use Subtitle::SSA::Style; use Subtitle::SSA::Event; use Subtitle::Utils qw(:string); use base 'Subtitle::BASE'; sub new { my ($class, %args) = @_; my $self = { debug => 0, eol => "\n", type => undef, %args, h_order => [], # headers order headers => {}, styles => [], events => [], log => [], }; return bless($self, $class); } sub new_event { ... } sub parse { my ($self, $lines) = @_; my $linenum = 0; my $section; foreach my $line (@$lines) { $linenum++; chomp_all($line); trim($line); next unless $line; study $line; # check section switch if ($line =~ m/^\s*\[(.+)\]\s*/o) { my $name = $1; 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 { undef $section; $self->log(debug => "Unknown section at line $linenum: $line"); } next; } # unless ($section) { $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') { 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:/oi) { $self->log(debug => "Set style format from line $linenum"); next; } 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"); } next; } if ($section eq 'events') { if ($line =~ m/^\s*Format:/oi) { $self->log(debug => "Set event format from line $linenum"); next; } 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"); } next; } $self->log(warn => "unrecognized line at $linenum: $line"); } return scalar @{ $self->{events} }; } sub build { my ($self) = @_; my (@lines, $out); # headers 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(); } push @lines, ""; # styles if ($self->{type} eq 'ass') { push @lines, "[V4+ Styles]"; } else { push @lines, "[V4 Styles]"; } push @lines, Subtitle::SSA::Style->new(type => $self->{type})->get_format_line(); foreach my $s (@{ $self->{styles} }) { push @lines, $s->to_string(); } push @lines, ""; # events push @lines, "[Events]"; push @lines, Subtitle::SSA::Event->new(type => $self->{type})->get_format_line(); foreach my $e (@{ $self->{events} }) { push @lines, $e->to_string(); } push @lines, ""; # TODO: fonts return join($self->{eol}, @lines); } 1;