libsubtitle-perl/lib/Subtitle/SRT.pm

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;