#!/usr/bin/guile --no-auto-compile -*- scheme -*- !# ;;; srt2vtt --- SRT to WebVTT converter ;;; Copyright © 2015 David Thompson ;;; ;;; srt2vtt is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; srt2vtt is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with srt2vtt. If not, see . ;;; Commentary: ;; ;; Convert SRT formatted subtitles to WebVTT format. ;; ;;; Code: (use-modules (ice-9 format) (ice-9 match) (ice-9 rdelim) (ice-9 regex) (srfi srfi-1) (srfi srfi-9) (srfi srfi-11) (srfi srfi-26) (srfi srfi-37)) (define-record-type (make-subtitle id start end text) subtitle? (id subtitle-id) (start subtitle-start) (end subtitle-end) (text subtitle-text)) (define parse-time (let ((regexp (make-regexp "([0-9]+):([0-9]+):([0-9]+),([0-9]+)"))) (lambda (s) (let ((match (regexp-exec regexp s))) (map (cut match:substring match <>) '(1 2 3 4)))))) (define parse-time-span (let ((regexp (make-regexp "([0-9:,]+) --> ([0-9:,]+)"))) (lambda (s) (let ((match (regexp-exec regexp s))) (values (parse-time (match:substring match 1)) (parse-time (match:substring match 2))))))) (define (read-sub-rip port) (let-values (((id) (string->number (read-line port))) ((start end) (parse-time-span (read-line port))) ((lines) (let loop ((lines '())) (let ((line (read-line port))) (if (string-null? line) lines (loop (cons line lines))))))) (make-subtitle id start end lines))) (define (read-sub-rips port) (reverse (let loop ((subs '())) (if (eof-object? (peek-char port)) subs (loop (cons (read-sub-rip port) subs)))))) (define (write-time time port) (match time ((h m s ms) (format port "~a:~a:~a.~a" h m s ms)))) (define (write-web-vtt subtitle port) (match subtitle (($ id start end text) (format port "~a~%" id) (write-time start port) (display " --> " port) (write-time end port) (newline port) (format port "~a~%" (string-join text "\n")) (newline port)))) (define (write-web-vtts subtitles port) (display "WEBVTT\n" port) (for-each (cut write-web-vtt <> port) subtitles)) (define (convert input-port output-port) (write-web-vtts (read-sub-rips input-port) output-port)) (define (show-help-and-exit) (format #t "Usage: srt2vtt [OPTIONS] Convert SubRip formatted subtitles to WebVTT format.~%") (display " -h, --help display this help and exit") (display " -v, --version display version and exit") (display " -i, --input=FILE-NAME read input from FILE-NAME") (display " -o, --output=FILE-NAME write output to FILE-NAME") (newline) (exit 0)) (define (show-version-and-exit) (format #t "srt2vtt 0.1~%") (exit 0)) (define (show-usage-and-exit) (format #t "Try `srt2vtt --help' for more information.~%") (exit 1)) (define (show-wrong-args-and-exit) (format #t "Invalid arguments~%") (show-usage-and-exit)) (define %default-args `((input . ,(current-input-port)) (output . ,(current-output-port)))) (define %options (list (option '(#\h "help") #f #f (lambda (opt name arg args) (show-help-and-exit))) (option '(#\v "version") #f #f (lambda (opt name arg args) (show-version-and-exit))) (option '(#\i "input") #t #f (lambda (opt name arg args) (alist-cons 'input arg args))) (option '(#\o "output") #t #f (lambda (opt name arg args) (alist-cons 'output arg args))))) (define (make-call-with-port-or-file file-proc) (lambda (port-or-file proc) (if (port? port-or-file) (proc port-or-file) (file-proc port-or-file proc)))) (define call-with-port-or-input-file (make-call-with-port-or-file call-with-input-file)) (define call-with-port-or-output-file (make-call-with-port-or-file call-with-output-file)) (define (parse-opts args) (args-fold args %options (lambda (opt name arg args) (error "Unrecognized option '~a'" name)) (lambda (arg args) (error "Extraneous argument '~a'" arg)) %default-args)) (define (main args) (let ((opts (parse-opts args))) (call-with-port-or-input-file (assoc-ref opts 'input) (lambda (input-port) (call-with-port-or-output-file (assoc-ref opts 'output) (lambda (output-port) (convert input-port output-port))))))) (match (command-line) ((arg0 args ...) (main args)))