You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
130 lines
2.5 KiB
130 lines
2.5 KiB
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
|
|
|