From: David Thompson Date: Sat, 7 Feb 2015 20:42:52 +0000 (-0500) Subject: Modularize! X-Git-Url: https://jxself.org/git/?p=srt2vtt.git;a=commitdiff_plain;h=b965a6d6326e67df0b0909065119c59563da8db2 Modularize! * .gitignore: Ignore build artifacts. * Makefile.am: Compile Guile modules. * bootstrap: New file. * configure.ac: Create pre-inst-env. * pre-inst-env.in: New file. * scripts/srt2vtt: New file. * srt2vtt: Remove. * srt2vtt.scm: New file. * srt2vtt/subrip.scm: New file. * srt2vtt/ui.scm: New file. * srt2vtt/webvtt.scm: New file. --- diff --git a/.gitignore b/.gitignore index fc022ad..5034dba 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +*.go /Makefile.in /Makefile /aclocal.m4 @@ -6,3 +7,4 @@ /config.log /config.status /configure +/pre-inst-env diff --git a/Makefile.am b/Makefile.am index 014d4e9..94108ef 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1 +1,32 @@ -bin_SCRIPTS = srt2vtt +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +CLEANFILES = $(GOBJECTS) +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +moddir=$(prefix)/share/guile/site/2.0 +godir=$(libdir)/guile/2.0/ccache + +SOURCES = \ + srt2vtt.scm \ + srt2vtt/subrip.scm \ + srt2vtt/webvtt.scm \ + srt2vtt/ui.scm + +EXTRA_DIST += pre-inst-env.in + +dist_bin_SCRIPTS = scripts/srt2vtt diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..57fb32a --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#!/bin/sh + +autoreconf -vfi diff --git a/configure.ac b/configure.ac index 20d3e3b..6048a1c 100644 --- a/configure.ac +++ b/configure.ac @@ -6,6 +6,7 @@ AM_INIT_AUTOMAKE([foreign]) AM_SILENT_RULES([yes]) AC_CONFIG_FILES([Makefile]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) GUILE_PROGS([2.0.5]) diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..6ac5ee1 --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,29 @@ +#!/bin/sh + +# 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 . + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir/scripts:$PATH" +export PATH + +exec "$@" diff --git a/scripts/srt2vtt b/scripts/srt2vtt new file mode 100755 index 0000000..1916e1c --- /dev/null +++ b/scripts/srt2vtt @@ -0,0 +1,26 @@ +#!/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 . + +(use-modules (ice-9 match) + (srt2vtt ui)) + +(match (command-line) + ((arg0 args ...) + (main args))) diff --git a/srt2vtt b/srt2vtt deleted file mode 100755 index a4cb576..0000000 --- a/srt2vtt +++ /dev/null @@ -1,198 +0,0 @@ -#!/usr/bin/guile --*- 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) - "Parse the SubRip formatted timestamp in the string S into a 4 -element list. Valid input looks like '00:00:03.417'." - (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) - "Parse the SubRip formatted time span in the string S and return -two values: the start time and the end time. Valid input looks like -'00:00:03.417 --> 00:00:04.936'." - (let ((match (regexp-exec regexp s))) - (values (parse-time (match:substring match 1)) - (parse-time (match:substring match 2))))))) - -(define (read-sub-rip port) - "Read a SubRip formatted subtitle from 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 (or (eof-object? line) - (and (string-null? line) - ;; A subtitle may be a blank line! - (not (null? lines)))) - lines - (loop (cons line lines))))))) - (make-subtitle id start end lines))) - -(define (read-sub-rips port) - "Read all SubRip formatted subtitles from PORT." - (reverse - (let loop ((subs '())) - (if (eof-object? (peek-char port)) - subs - (loop (cons (read-sub-rip port) subs)))))) - -(define (write-time time port) - "Write TIME as a WebVTT formatted timestamp to PORT." - (match time - ((h m s ms) - (format port "~a:~a:~a.~a" h m s ms)))) - -(define (write-web-vtt subtitle port) - "Write SUBTITLE as a WebVTT formatted subtitle to 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) - "Write all SUBTITLES as WebVTT formatted subtitles to PORT." - (format port "WEBVTT~%~%") - (for-each (cut write-web-vtt <> port) subtitles)) - -(define (convert input-port output-port) - "Read the SubRip formatted subtitles from INPUT-PORT and write the -WebVTT equivalents to 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) - "Create a new procedure that accepts two arguments: a port or file, -and a procedure. When the returned procedure is called with a port as -the first argument, the second argument is simply applied with that -port. If the first argument is a string, the second argument is -applied with the port corresponding to the file name contained in the -string as opened by 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) - "Parse the list of ARGS and return a list of option/value pairs. -When an option isn't specified in ARGS, it defaults to the value in -'%default-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) - "srt2vtt entry point." - (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))) diff --git a/srt2vtt.scm b/srt2vtt.scm new file mode 100644 index 0000000..1decdf4 --- /dev/null +++ b/srt2vtt.scm @@ -0,0 +1,32 @@ +;;; 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 . + +(define-module (srt2vtt) + #:use-module (srfi srfi-9) + #:export (make-subtitle + subtitle? + subtitle-id + subtitle-start + subtitle-end + subtitle-text)) + +(define-record-type + (make-subtitle id start end text) + subtitle? + (id subtitle-id) + (start subtitle-start) + (end subtitle-end) + (text subtitle-text)) diff --git a/srt2vtt/subrip.scm b/srt2vtt/subrip.scm new file mode 100644 index 0000000..167aff8 --- /dev/null +++ b/srt2vtt/subrip.scm @@ -0,0 +1,66 @@ +;;; 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 . + +(define-module (srt2vtt subrip) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srt2vtt) + #:export (read-subrip + read-subrips)) + +(define parse-time + (let ((regexp (make-regexp "([0-9]+):([0-9]+):([0-9]+),([0-9]+)"))) + (lambda (s) + "Parse the SubRip formatted timestamp in the string S into a 4 +element list. Valid input looks like '00:00:03.417'." + (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) + "Parse the SubRip formatted time span in the string S and return +two values: the start time and the end time. Valid input looks like +'00:00:03.417 --> 00:00:04.936'." + (let ((match (regexp-exec regexp s))) + (values (parse-time (match:substring match 1)) + (parse-time (match:substring match 2))))))) + +(define (read-subrip port) + "Read a SubRip formatted subtitle from 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 (or (eof-object? line) + (and (string-null? line) + ;; A subtitle may be a blank line! + (not (null? lines)))) + lines + (loop (cons line lines))))))) + (make-subtitle id start end lines))) + +(define (read-subrips port) + "Read all SubRip formatted subtitles from PORT." + (reverse + (let loop ((subs '())) + (if (eof-object? (peek-char port)) + subs + (loop (cons (read-subrip port) subs)))))) diff --git a/srt2vtt/ui.scm b/srt2vtt/ui.scm new file mode 100644 index 0000000..607c49e --- /dev/null +++ b/srt2vtt/ui.scm @@ -0,0 +1,112 @@ +;;; 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 . + +(define-module (srt2vtt ui) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (srt2vtt subrip) + #:use-module (srt2vtt webvtt) + #:export (main)) + +(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) + "Create a new procedure that accepts two arguments: a port or file, +and a procedure. When the returned procedure is called with a port as +the first argument, the second argument is simply applied with that +port. If the first argument is a string, the second argument is +applied with the port corresponding to the file name contained in the +string as opened by 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) + "Parse the list of ARGS and return a list of option/value pairs. +When an option isn't specified in ARGS, it defaults to the value in +'%default-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 (convert input-port output-port) + "Read the SubRip formatted subtitles from INPUT-PORT and write the +WebVTT equivalents to OUTPUT-PORT." + (write-webvtts (read-subrips input-port) output-port)) + +(define (main args) + "srt2vtt entry point." + (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))))))) diff --git a/srt2vtt/webvtt.scm b/srt2vtt/webvtt.scm new file mode 100644 index 0000000..f4cd91b --- /dev/null +++ b/srt2vtt/webvtt.scm @@ -0,0 +1,45 @@ +;;; 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 . + +(define-module (srt2vtt webvtt) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srt2vtt) + #:export (write-webvtt + write-webvtts)) + +(define (write-time time port) + "Write TIME as a WebVTT formatted timestamp to PORT." + (match time + ((h m s ms) + (format port "~a:~a:~a.~a" h m s ms)))) + +(define (write-webvtt subtitle port) + "Write SUBTITLE as a WebVTT formatted subtitle to PORT." + (format port "~a~%" (subtitle-id subtitle)) + (write-time (subtitle-start subtitle) port) + (display " --> " port) + (write-time (subtitle-end subtitle) port) + (newline port) + (format port "~a~%" (string-join (subtitle-text subtitle) "\n")) + (newline port)) + +(define (write-webvtts subtitles port) + "Write all SUBTITLES as WebVTT formatted subtitles to PORT." + (format port "WEBVTT~%~%") + (for-each (cut write-webvtt <> port) subtitles))