libsubtitle-perl/lib/Subtitle/BASE.pm

package Subtitle::BASE;

use strict;
use warnings;
use feature qw(switch);
use utf8;

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 chomp {
  my ($self, $line) = @_;
  return unless defined $line;
  return $line =~ s/(^\xEF\xBB\xBF|[\r\n]+$)//ogr;
}

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);
  if ($msec < 0 or $msec > 999) {
    $self->log(warn => "wrong mseconds part of timing: $msec");
    return;
  }
  if ($sec < 0 or $sec > 59) {
    $self->log(warn => "wrong seconds part of timing: $sec");
    return;
  }
  if ($min < 0 or $min > 59) {
    $self->log(warn => "wrong minutes part of timing: $sec");
    return;
  }
  if ($hrs < 0) {
    $self->log(warn => "wrong minutes part of timing: $sec");
    return;
  }
  given (length("$msec")) {
    when ("3") { $time += $msec * 0.001; }
    when ("2") { $time += $msec * 0.01; }
    when ("1") { $time += $msec * 0.1; }
    default {
      $self->log(error => "abnormal length of mseconds part");
      return;
    }
  }
  $time += $sec;
  $time += $min * 60;
  $time += $hrs * 60 * 60;
  return $time;
}

sub build_timing {
  my ($self, $time, $prec) = @_;
  $prec //= 2;
  my ($hrs, $min, $sec, $msec, $rest);
  $hrs  = int($time / 3600);
  $rest =     $time - ($hrs * 3600);
  $min  = int($rest / 60);
  $rest =     $rest - ($min * 60);
  $sec  = int($rest / 1);
  $msec = sprintf "%.${prec}f", ($rest - ($sec * 1));
  $msec =~ s/^0\.//o;
  return sprintf($self->{timing_fmt}, $hrs, $min, $sec, $msec);
}

sub trim {
  my ($self, $line) = @_;
  return unless defined $line;
  return $line =~ s/(^\s+|\s+$)//or;
}

sub events {
  my ($self) = @_;

  return wantarray ? @{ $self->{events} } : $self->{events};
}

sub parse { return "Unimplemented by subclass"; }
sub build { return "Unimplemented by subclass"; }

1;