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_timing
);

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


## string sunctions

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

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

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

## 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);
}

sub parse_timing {
  my ($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) {
    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;
}

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);
  chomp($line1, $line2);

In-place strips newlines (CR/LF) from line.

=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

=cut