package Subtitle::SRT; use strict; use warnings; use feature qw(switch); use utf8; sub new { my ($class) = @_; my $self = { events => [], debug => 0, log => [] }; return bless($self, $class); } sub load { my ($self, $file) = @_; my $cnt = 0; return $cnt; } sub trim { my ($self, $line) = @_; return unless $line; return $line =~ s/(^\s+|\s+$)//or; } sub log { my ($self, $level, $msg) = @_; given ($level) { when ("error") { push @{ $self->{log} }, "E: $msg"; } when ("warn") { push @{ $self->{log} }, "W: $msg"; } when ("info") { push @{ $self->{log} }, "I: $msg"; } when ("debug") { push @{ $self->{log} }, "D: $msg" if $self->{debug}; } default { warn "Unknown loglevel $level of $msg\n"; } } return 1; } sub parse_timing { my ($self, $str) = @_; ... } sub new_event { return +{ id => undef, timing => undef, text => undef }; } sub parse { my ($self, $lines) = @_; my $expected = 'id'; my $linenum = 0; my $event; foreach my $line (@$lines) { $linenum++; unless ($line and $event) { $self->log(debug => "empty line and event"); next; } # expected: event id if ($line and not defined $event) { $event = $self->new_event; $event->{id} = $self->trim($line); $self->log(debug => "new event with id: $event->{id}"); } # expected: timing if ($event and not $event->{timing}) { my $timing = []; my ($start, $end, $rest) = ($line =~ m/(\S+)\s*-->\s*(\S+)(.*)/o); unless ($start and $end) { $self->log(warn => "expected timing but found `$line` at $linenum, skipped"); next; } unless ($timing->[0] = $self->parse_timing($start)) { $self->log(warn => "Can't parse timing at line $linenum: $start"); next; } unless ($timing->[1] = $self->parse_timing($end)) { $self->log(warn => "Can't parse timing at line $linenum: $end"); next; } $event->{timing} = $timing; next unless $rest; # extension: timing # example: X1:050 X2:669 Y1:234 Y2:436 if ($rest =~ m/([XY][12]:(\d+))/io) { foreach my $token (split(/\s+/, $rest)) { $event->{coords} //= {}; if ($token =~ m/([XY][12]):(\d+)/io) { $event->{coords}->{lc($1)} = $2; next; } $self->log(warn => "Garbage detected instead event coord: $token"); } unless (scalar @{ $event->{coords}} == 4) { delete $event->{coords}; $self->log(warn => "Incomplete coord set for event at line $linenum"); } next; } # extension: ssa-like style # example: SSA: Dialogue, Layer: 0, Style: Reply, Name: NTP, MarginL: 0300, MarginR: 0000, MarginV: 0300, Effect: !Effect ... } # expected: event text if ($event and $event->{timing}) { if ($event->{text}) { $event->{text} .= " " . $self->trim($line); } else { $event->{text} = $self->trim($line); } next; } # expected: empty line if ($event and not $line) { $self->log(debug => "finalize event line $linenum"); push @{ $self->{events} }, $event; undef $event; next; } die("unhandled line: $linenum:$line\n"); } return scalar @{ $self->{events} }; } 1;