libsubtitle-perl/lib/Subtitle/Utils.pm

package Subtitle::Utils;

use strict;
use warnings;

use base 'Exporter';

our @EXPORT_OK = qw(
  chomp_all strip_bom trim
  make_timing parse_timeshift parse_timing
  round
);

our %EXPORT_TAGS = (
  string => [qw(chomp_all strip_bom trim)],
  timing => [qw(make_timing parse_timeshift parse_timing)],
);

## string functions

sub chomp_all {
  return unless $_[0];
  $_[0] =~ s/[\r\n]+$//o;
}

sub strip_bom {
  return unless @_;
  return $_[0] =~ s/^\xEF\xBB\xBF//o;
}

sub trim {
  return unless $_[0];
  $_[0] =~ s/(^\s+|\s+$)//go;
}

## timing functions

sub make_timing {
  my ($time) = @_;
  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 "%.0f", (($rest - $sec) * 1000);
  return ($hrs, $min, $sec, $msec);
}

# recognized format [+-][[hh:]mm:]ss[.ms]
sub parse_timeshift {
  my ($str) = @_;
  my $ts = { sign => '+', hrs => 0, min => 0, sec => 0 };

  return unless defined $str;

  while(1) {
    if ($str =~ s<^([+-])><>o)                     { $ts->{sign} = $1; }
    if ($str =~ s<^([0-9](?:\.\d{1,3})?)$><>o)     { $ts->{sec}  = $1; }
    if ($str =~ s<([0-5][0-9](?:\.\d{1,3})?)$><>o) { $ts->{sec}  = $1; }
    if ($str =~ s<^([0-9]):$><>o)                  { $ts->{min}  = $1; }
    if ($str =~ s<([0-5][0-9]):$><>o)              { $ts->{min}  = $1; }
    if ($str =~ s<^(\d+):$><>o)                    { $ts->{hrs}  = $1; }
    last;
  };

  if ($str or $ts->{min} >= 60 or $ts->{sec} >= 60.0) {
    return; # wrong time format
  }
  my $time = $ts->{sec} + $ts->{min} * 60 + $ts->{hrs} * 3600;
  $time *= -1 if $ts->{sign} eq '-';
  return $time;
}

sub parse_timing {
  my ($str) = @_;
  my $time = 0.0;
  return unless $str =~ m/(\d+):(\d+):(\d+)[.,](\d+)/o;
  my ($hrs, $min, $sec, $msec) = ($1, $2, $3, $4);
  if ($msec < 0 or $msec > 999) {
    return -1; # wrong mseconds part of timing
  }
  if ($sec < 0 or $sec > 59) {
    return -1; # wrong seconds part of timing
  }
  if ($min < 0 or $min > 59) {
    return -1; # wrong minutes part of timing
  }
  if ($hrs < 0) {
    return -1; # wrong minutes part of timing
  }
  my $msec_len = length $msec;
  if    ($msec_len == 3) { $time += $msec * 0.001; }
  elsif ($msec_len == 2) { $time += $msec * 0.01;  }
  elsif ($msec_len == 1) { $time += $msec * 0.1;   }
  else  { return -1; } # abnormal length of mseconds part
  $time += $sec;
  $time += $min * 60;
  $time += $hrs * 60 * 60;
  return $time;
}

## misc

sub round {
  my ($value, $n) = @_;
  return sprintf "%.${n}f", $value;
}

1;

=pod

=head1 NAME

Subtitle::Utils -- usefull generic routines

=head1 SYNOPSYS

  use Subtitle::Utils qw(:all);

=head1 FUNCTIONS / STRINGS

  use Subtitle::Utils qw(:string);

=head2 C<chomp_all>

  chomp($line);

In-place strips newlines (CR/LF) from line.
Differs from standart chomp() than strips '\r', '\n' and it's combinaion, disregarding $/

=head2 C<strip_bom>

  strip_bom($line);

In-place strips Unicode's BOM (Byte Order Mark) from line.

=head2 C<trim>

  trim($line);

In-place strips leading and trailing spaces from the given string

=head1 FUNCTIONS / TIMING

=head2 C<make_timing>

  my ($hrs, $min, $sec, $msec) = make_timing($time);
  printf "%d:%02d:02d.%s", $hrs, $min, $sec, $msec;

Takes float number of seconds and returns array with components of timing split by units.

=head2 C<parse_timing>

  my $time = parse_timing($string);

Takes string like "HH:MM:SS.MSEC" and returns float number of seconds

On parse error returns -1

=head1 FUNCTIONS / MISC

=head2 C<round>

  say round(3.6, 0); # 4
  say round(3.6, 1); # 4.1

Self-descriptive

=cut