* Subtitle::SRT->parse : draft

lib/Subtitle/SRT.pm

@@ -2,11 +2,12 @@ package Subtitle::SRT;
 
 use strict;
 use warnings;
+use feature qw(switch);
 use utf8;
 
 sub new {
   my ($class) = @_;
-  my $self = { events => [] };
+  my $self = { events => [], debug => 0, log => [] };
 
   return bless($self, $class);
 }
@@ -18,4 +19,110 @@ sub load {
   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;