srttidy

#!/usr/bin/perl -CA

use strict;
use warnings;
use utf8;
no warnings 'utf8';

use Getopt::Std;

my $USAGE = <<"USAGE";
Usage: srttidy [OPTIONS] SRT-FILE [...]
   or: srttidy [OPTIONS] < IN-SRT-FILE > OUT-SRT-FILE

Options
  -t                      show subtitle texts only
  -c COLOR                specify default subtitle font color
  -r                      remove srttidy-specified font color
  -s SECOND[,COND]        shift timestamps by given time in seconds
  -l TIME-MAP             correct timestamps linearly by given time map
  -p FRAMERATE-MAP        correct timestamps linearly by given frame rate map
  -n                      remove empty subtitles, and reorder lefts one-by-one
  -d PATTERN              remove subtitles including given pattern
  -g PATTERN              show subtitles including given pattern
  -f CONDITION            show subtitles matching given condition
  -m DURATION,GAP[;COND]  change timestamps by given minimum duration, gap
                          in seconds, and condition
  -b                      remove carriage returns and BOM
  -y                      remove unnecessary whitespace
  -1                      make each subtitle one line

Examples
  srttidy -t < my.srt > my.txt
  srttidy -c silver *.srt
  srttidy -r < old.srt > new.srt
  srttidy -s -8.26 < old.srt > new.srt
  srttidy -s -8.26,260.3 < old.srt > new.srt
  srttidy -b -l "00:00:19,145-00:00:22,189 02:39:17,715-02:39:18,390" my.srt
  srttidy -p "23.976-24" my.srt
  srttidy -n -d '(yts|sub2smi|elsubtitle)' *.srt
  srttidy -b -n Movies/*/*.srt
  srttidy -g '(yts|sub2smi|elsubtitle)' *.srt
  srttidy -f '(lc=1 and cc>15) or cc>20 or dt>3.5' < old.srt
  srttidy -m 1.0,0.1 my.srt
  srttidy -m '3,0.1;cc>20 and dt<2' my.srt
  srttidy -1 -t < my.srt > my.txt
  srttidy -yb < my.srt > my.txt

See <https://github.com/9beach/srt-tools> for updates and bug reports
USAGE

my $QR_BOM = qr/^\x{FEFF}/;
my $QR_DECIMAL = qr/[+-]?\d+\.?\d*/;
my $QR_DECIMAL_DECIMAL = qr/[+-]?\d+\.?\d*,\d+\.?\d*/;
my $QR_TIME = qr/[0-9][0-9]:[0-9][0-9]:[0-9][0-9],[0-9][0-9][0-9]/;
my $QR_DURATION = qr/${QR_TIME} *--> *${QR_TIME} *\r?\n/;
my $QR_TIMEMAP = qr/${QR_TIME}->?${QR_TIME}( |\+)+${QR_TIME}->?${QR_TIME}/;
my $QR_FRAMERATEMAP = qr/\d+\.?\d* *->? *\d+\.?\d*/;

my %opts = ();

# Defines submodules below
#
# Prints message to STDERR
sub say {
    my $out = shift;
    print STDERR "$out\n";
}

# Checks if key is defined in %opts
sub has {
    my $key = shift;
    return defined $opts{$key};
}

# Evaluates expression with given duration, line count, and character count
# for example, `say "hello" if matched("dt > 3 and lc < 5", 4, 1, 3);`
sub matched {
    my ($expr, $dt, $lc, $cc) = @_;

    for ($expr) {
        s/\bdt\b/$dt/gi;
        s/\blc\b/$lc/gi;
        s/\bcc\b/$cc/gi;
    }
    return eval $expr;
}

# Checks if valid SubRip
sub valid_srt {
    my $srt = shift;
    return $srt =~ /${QR_BOM}?[0-9]+ *\r?\n\s*${QR_DURATION}/m;
}

# Gets line count and character count of text
sub text_counts {
    my $text = shift;
    for ($text) {
        s/<\/? *[a-zA-Z]*[^>]*>//gm;
        s/^\s*//gm;
    }
    my $lc = $text =~ tr/\n//;
    $text =~ tr/- \/\t\r\n&#@…⋮!,\.:;—*"'“”¿?¡!()[]<>『』《》｢｣≪≫《》〈〉//d;
    my $cc = length $text;
    $lc = 0 if $cc == 0;

    return ($lc, $cc);
}

# Dies with message if two exclusive options are given
sub error_exclusive {
    my ($l, $r) = @_;
    die "Cannot use both -$l and -$r at the same time\n" if has $l and has $r;
}

# Decodes to UTF-8
sub conv {
    my $buf = shift;

    if (not utf8::decode $buf) {
        require Encode;
        require Encode::Guess;

        my $decoder = Encode::Guess::guess_encoding($buf, qw/cp949 euc-kr/);
        if (ref $decoder) {
            $buf = $decoder->decode($buf);
        } else {
            # Fairly often it works
            $buf = Encode::decode("CP949", $buf);
        }
    }
    return $buf;
}

# Converts "00:01:19,145" to "79.145"
sub to_s {
    my $fmt = shift;
    $fmt =~ s/,/./;
    my @hms = split ":", $fmt;
    return $hms[0] * 3600 + $hms[1] * 60 + $hms[2];
}

# Converts "79145" to "00:01:19,145"
sub to_hms {
    my $millisec = shift;
    $millisec = 0 if ($millisec < 0);

    my $seconds = $millisec / 1000;
    my $ms = $millisec % 1000;
    my $s = $seconds % 60;
    my $m = ($seconds / 60) % 60;
    my $h = ($seconds / 3600) % 60;

    return sprintf "%02d:%02d:%02d,%03d", $h, $m, $s, $ms;
}

# Checks if condition (from -f or -m) is valid
sub valid_condition {
    my $condition = shift;
    return 1 unless length $condition;

    my $buf = $condition;
    for ($buf) {
        s/\b(or|and|lc|cc|dt)\b//gi;
        s/${QR_DECIMAL}//gi;
        s/[ \+\*\/\-()<>=]//gi;
    }
    return 0 unless $buf eq '';

    for ($condition) {
        s/\bcc\b/(-1.324)/gi;
        s/\blc\b/(-9.234762)/gi;
        s/\bdt\b/(0.123124)/gi;
    }
    eval $condition;

    return not $@;
}

# Processes each option
sub tidy {
    my ($content, $opts) = @_;

    # Removes BOM and CR
    if (has "b") {
        $content =~ tr/\r//d;
        $content =~ s/${QR_BOM}//;
    }

    # Removes unnecessary whitespace
    if (has "y") {
        $content =~ s/^\s*\n//mg;
        $content =~ s/(?<=\n)(\d+\n\d{2}:\d{2}:\d{2})/\n$1/xgm;
        $content =~ s/\n\n+/\n\n/xgm;
    }
 
    # Deletes subtitles including given pattern
    if (has "d") {
        my $opt = $opts{d};
        for ($content) {
            # \x08, \x09: boundary delimiters for text replacement
            s/(${QR_BOM}?[0-9]+) *(\r?\n)+(${QR_DURATION})/\x08$1$2$3\x09/gm;
            # Removes a subtitle matching pattern in boundary
            s/\x08[^\x09]*\x09[^\x08\x09]*$opt[^\x08]*//gmi;
            tr/\x08\x09//d;
        }
    }

    # Shows subtitles including given pattern
    if (has "g") {
        my $opt = $opts{g};
        my $buf = $content; $content = "";
        # \x08, \x09: boundary delimiters for text replacement
        $buf =~ s/(${QR_BOM}?[0-9]+) *(\r?\n)+\s*(${QR_DURATION})
                /\x08$1$2$3\x09/xgm;
        while ($buf =~ /\x08[^\x09]*\x09[^\x08\x09]*$opt[^\x08]*/gmi) {
            $content .= $&;
        }
        $content =~ tr/\x08\x09//d;
    }

    # Shows subtitles matching given condition
    if (has "f") {
        my $expr = $opts{f};
        my $buf = $content; $content = "";
        # \x08, \x09: boundary delimiters for text replacement
        $buf =~ s/${QR_BOM}?([0-9]+) *(\r?\n)+\s*(${QR_DURATION})
                /\x09$1$2$3/xgm;

        while ($buf =~ /
                \x09([0-9]+)(\r?\n)(${QR_TIME})[[:blank:]]*-->[[:blank:]]*
                (${QR_TIME})([^\x09]*)/xgm) {
            my ($lc, $cc) = text_counts $5;
            my $ok = matched $expr, to_s($4)-to_s($3), $lc, $cc;
            $content .= "$1$2$3 --> $4$5" if $ok;
        }
        $content =~ tr/\x08\x09//d;
    }

    # Removes blank subtitles, and reorder lefts one by one
    if (has "n") {
        my $n = 0;
        for ($content) {
            # Removes black lines
            s/^\s*(\r?\n)+//gm;
            # Inserts line before each order
            s/(.)(\r?\n)([0-9]+\s*\n${QR_TIME} *-->)/$1$2$2$3/gm;
            # Removes order and timestamp with blank text
            s/${QR_BOM}?[0-9]+\s*\n${QR_DURATION}((\r?\n)+|\z)//gm;
            # Reorders one by one
            s/${QR_BOM}?[0-9]+ *(\r?\n)+\s*(${QR_DURATION})/${\++$n}$1$2/gm;
        }
    }

    # Specifies default font color
    if (has "c") {
        my $opt = $opts{c};
        for ($content) {
            s/<font color[^>]* x=keep-it>//g;
            s/(^${QR_DURATION})([^\r\n])/$1<font color=$opt x=keep-it>$2/gm;
        }
    }

    # Resets specified font colors
    if (has "r") {
        $content =~ s/<font color[^>]* x=keep-it>//g;
    }

    # Shifts timestamp by given time in seconds
    if (has "s") {
        sub s_shift {
            my ($t, $s) = @_;
            return to_hms((to_s($t) + $s) * 1000);
        }

        my ($sec, $start_seconds) = split /,/, $opts{s};
        $start_seconds = $start_seconds if defined $start_seconds;

        $content =~ s/(${QR_TIME})[[:blank:]]*-->[[:blank:]]*(${QR_TIME})/
            !defined $start_seconds || to_s($1) > $start_seconds
                ? "${\s_shift($1, $sec)} --> ${\s_shift($2, $sec)}"
                : "$1 --> $2"
            /xeg;

    }

    # Corrects timestamps linearly
    if (has "l") {
        # Gets slope $a and intercept $b for y = ax + b
        sub slope_intercept {
            my $opt = shift; $opt =~ s/(->?|\+)/ /g;
            my @s = map { to_s $_ } split(/  */, $opt);
            my $a = ($s[3] - $s[1]) / ($s[2] - $s[0]);
            my $b = $s[1] - $a * $s[0];

            return ($a, $b);
        }

        # Shifts timestamp lenearly by slope and intercept
        sub l_shift {
            my ($t, $a, $b) = @_;
            return to_hms((to_s($t) * $a + $b) * 1000);
        }

        my ($a, $b) = slope_intercept $opts{l};
        $content =~ s/(${QR_TIME})[[:blank:]]*-->[[:blank:]]*(${QR_TIME})
                    /${\l_shift $1, $a, $b} --> ${\l_shift $2, $a, $b}/xg;
    }
    
    # Corrects timestamps linearly by frame rate-map
    if (has "p") {
        # Gets slope $a for y = ax
        sub slope {
            my $opt = shift;
            my @s = split(/ *->? */, $opt);
            my $a = $s[0] / $s[1];

            return $a;
        }

        # Shifts timestamp lenearly by slope and intercept
        sub fps_shift {
            my ($t, $a) = @_;
            return to_hms(to_s($t) * $a * 1000);
        }

        my $a = slope $opts{p};
        $content =~ s/(${QR_TIME})[[:blank:]]*-->[[:blank:]]*(${QR_TIME})
                    /${\fps_shift $1, $a} --> ${\fps_shift $2, $a}/xg;
    }

    # Changes timestamps by given minimum duration and gap, and reports them
    if (has "m") {
        my ($md, $mg, $expr) = ($opts{"md"}, $opts{"mg"}, $opts{"expr"});
        my $ncontent = "";
        my $lf = "\n";

        # Checks timestamps, and changes them to -m option
        sub analyze {
            my (
                $porder, $pfrom, $pfrom_s, $pto, $pto_s, $ptext,
                $from, $from_s, $to, $to_s, $md, $mg, $lf, $lc, $cc,
            ) = @_;

            # Prints duration update info
            sub say_timestamps_info {
                my ($order, $state, $text) = @_;

                for ($text) { s/^/  /mg; tr/\r//d; s/\s*\z/\n/m; }

                say '* '.$order.': '.$state;
                say $text;
            }

            my $pduration = $pto_s - $pfrom_s;

            # Checks if duration is short, or timestamps are overlapped
            if ($pduration < $md or $pto_s > $from_s) {
                my $state = 'SHORT';
                $state = 'OVERLAPPED' if $pto_s > $from_s;

                my $new_pto_s = 0;

                if ($pfrom_s + $md + $mg < $from_s) {
                    if ($state eq 'SHORT') {
                        $new_pto_s = $md + $pfrom_s;
                    } else {
                        $new_pto_s = $from_s - $mg;
                    }
                    $state .= '/FIXED';
                } elsif ($pto_s + $mg < $from_s) {
                    $new_pto_s = $from_s - $mg;
                    $state .= '/FIXED BUT SHORT';
                }

                my $dur_state;
                if ($new_pto_s) {
                    $dur_state =
                    sprintf '%.3f -> %.3f', $pduration, $new_pto_s - $pfrom_s;
                } else {
                    $dur_state = sprintf '%.3f', $pduration;
                }

                say_timestamps_info(
                    "$porder $lc,$cc",
                    "$state ($dur_state)",
                    "$pfrom --> $pto$ptext",
                );

                if ($new_pto_s) {
                    $pto_s = $new_pto_s;
                    $pto = to_hms($pto_s * 1000);
                }
            }
            return "$porder$lf$pfrom --> $pto$ptext";
        }

        for ($content) {
            # Gets my CRLF
            /${QR_BOM}?[0-9]+ *(\r?\n)/m; $lf = $1;
            # Inserts delimiter (\x09) for each order, timestamp, and text
            s/${QR_BOM}?([0-9]+)\s*\n\s*(${QR_DURATION})/\x09$1\n$2/gm;
            # We need dummy last element for time gap
            s/\z/\x091000000\n99990:00:00,000 --> 99999:00:00,000\n/m;
        }

        my ($porder, $pfrom, $pfrom_s, $pto, $pto_s, $ptext) = ("");

        # Iterates for each delimiter
        my $QR_MTIME = qr/[0-9]+:[0-9][0-9]:[0-9][0-9],[0-9][0-9][0-9]/;
        while ($content =~ /
                \x09([0-9]+)\n(${QR_MTIME})[[:blank:]]*-->[[:blank:]]*
                (${QR_MTIME})([^\x09]*)/xgm) {
            my (
                $order, $from, $from_s, $to, $to_s, $text,
            ) = ($1, $2, to_s($2), $3, to_s($3), $4);

            unless ($porder eq "") {
                my $ok = 1;
                my ($lc, $cc) = text_counts $ptext;

                $ok = matched $expr, $pto_s-$pfrom_s, $lc, $cc if length $expr;
                if ($ok) {
                    $ncontent .= analyze(
                        ($porder, $pfrom, $pfrom_s, $pto, $pto_s, $ptext),
                        ($from, $from_s, $to, $to_s), ($md, $mg, $lf),
                        ($lc, $cc),
                    );
                } else {
                    $ncontent .= "$porder$lf$pfrom --> $pto$ptext";
                }
            }
            ($porder, $pfrom, $pfrom_s, $pto, $pto_s, $ptext) =
                ($order, $from, $from_s, $to, $to_s, $text);
        }

        $content = $ncontent;
    }

    # Makes each subtitle one line
    if (has "1") {
        my $buf = $content; $content = "";
        # \x08, \x09: boundary delimiters for text replacement
        $buf =~ s/(${QR_BOM}?[0-9]+) *(\r?\n)+\s*(${QR_DURATION})
                /\x08$1$2$3\x09/xgm;
        while ($buf =~ /(\x08[^\x09]*\x09)([^\x08\x09]*)/gm) {
            my ($t, $s) = ($1, $2);
            $s =~ s/\n/ /gm;
            $s =~ s/  / /g;
            $content .= $t.$s."\n\n";
        }
        $content =~ tr/\x08\x09\r//d;
    }

    # Displays subtitle texts only
    if (has "t") {
        for ($content) {
            s/${QR_BOM}?[0-9]+\s*\r?\n\s*${QR_DURATION}//gm;
            s/<\/? *[a-zA-Z]*[^>]*>//gm;
            s/^\s*//gm;
            s/ +/ /g;
        }

        # Not srt so return
        return $content;
    }
 
    # Removes additional '\n' when final subtitle was empty
    $content =~ s/(\r?\n)+\z/$1/m;
    return $content;
}

# Starts main routine
#
# Checks the constraints of opts
die $USAGE unless getopts "1f:bytm:c:rg:d:nl:p:s:h", \%opts;

error_exclusive "c", "r";
error_exclusive "s", "l";
error_exclusive "t", "c";
error_exclusive "t", "r";
error_exclusive "t", "b";
error_exclusive "t", "y";
error_exclusive "t", "s";
error_exclusive "t", "l";
error_exclusive "t", "p";
error_exclusive "t", "n";
error_exclusive "m", "t";
error_exclusive "m", "f";
error_exclusive "m", "g";

die $USAGE if (
    has "h" or
    (not -t STDOUT and $#ARGV >= 0) or
    (-t STDIN and $#ARGV < 0) or
    (not -t STDIN and $#ARGV >= 0)
);
if ($#ARGV > 0 and (has "s" or has "l")) {
    die "Cannot use -s or -l with multiple files\n";
}
if (has "l" and not $opts{l} =~ /^${QR_TIMEMAP}$/) {
    die "'$opts{l}' is not valid time-map\n"
}
if (has "p" and not $opts{p} =~ /^${QR_FRAMERATEMAP}$/) {
    die "'$opts{p}' is not valid frame rate-map\n"
}
if (has "s" and $opts{s} !~ /^${QR_DECIMAL}$/ and $opts{s} !~ /^${QR_DECIMAL_DECIMAL}$/) {
    die "'$opts{s}' is not a decimal number\n"
}
if (has "f") {
    my $expr = $opts{f};
    # Converts '=' to '=='
    $expr =~ s/([^><=]=)([^=])/$1=$2/g;
    die "'$opts{f}' is not valid condition\n" unless valid_condition $expr;
    $opts{f} = $expr;
}
# Gets $opts{"expr"}, $opts{"md"}, and $opts{"mg"}
if (has "m") {
    my ($md_mg, $expr) = split ";", $opts{m};
    $expr = "" unless length $expr;
    for ($expr) {
        # Converts '=' to '=='
        s/([^><=]=)([^=])/$1=$2/g;
        # Removes whitespace
        s/^\s*$//;
    }
    die "'$opts{m}' is not valid\n" unless valid_condition $expr;
    $opts{"expr"} = $expr;

    if ($md_mg =~ /^(\d+\.?\d*) *, *(\d+\.?\d*)$/) {
        $opts{"md"} = $1;
        $opts{"mg"} = $2;
    } else {
        die "'$opts{m}' is not valid\n";
    }
}

# Reads from pipe
if ($#ARGV < 0) {
    my $content; { local $/; $content = <STDIN> };
    $content = conv $content;
    die "invalid content\n" unless valid_srt $content;

    $content = tidy $content, %opts;
    print $content;

    exit 0;
}

my $err = 0;

# Reads ARGV files
foreach my $srt (@ARGV) {
    my $nsrt = $srt;
    $nsrt =~ s/\.[^\/\.]*$//;
    $nsrt .= has("t") ? "-tidy.txt" : "-tidy.srt";

    unless (open SRT, '<', $srt) {
        $err = -1;
        say "failed to open: ${srt}";
        next;
    }
    unless (open NSRT, '>', $nsrt) {
        $err = -1;
        say "failed to open: ${nsrt}";
        close SRT;
        next;
    }

    my $content; { local $/; $content = <SRT> };
    $content = conv $content;

    unless (valid_srt $content) {
        $err = -1;
        say "invalid content: ${srt}";
        next;
    }

    # Shows file name on analysis with -m
    say "tidying: $nsrt" if has "m";

    $content = tidy $content, %opts;
    if ($content eq "") {
        say "empty content: ${srt}";
        close SRT;
        close NSRT;
        unlink $nsrt;
    } else {
        say "created: ${nsrt}";
        print NSRT $content;
        close SRT;
        close NSRT;
    }
}

exit $err;