All pastes #2047277 Raw Edit

Anonymous

public text v1 · immutable
#2047277 ·published 2011-04-16 22:30 UTC
rendered paste body
; TODO
; - Use command-line flags.
; - Argument for quality should be a flag.
; - Whether or not to clobber files should be a flag.
; - Some basic sanity checks, like don't create the target directory if the
;   source doesn't exist, etc.
; - Check the return value on system calls and bomb when pipelines fail.

(require-extension posix)
(require-extension files)
(require-extension format)

(define quality (or (get-environment-variable "QUALITY") "6"))

(define (pathname-last path)
  (let-values (((o d e) (decompose-directory path)))
    (if (not e)
      #f
      (list-ref e (- (length e) 1)))))

(define (flac->ogg source target)
  ;(printf "flac -o - \"~A\"|oggenc -q ~A -o \"~A\" -"
  ;        source quality target)
  (system (format "flac -o - \"~A\"|oggenc -q ~A -o \"~A\" -"
                  source quality target)))

(define (ape->ogg source target)
  (system (format "mac \"~A\" - -d|oggenc -q ~A -o \"~A\" -"
                  source quality target)))

(define (mp3->ogg source target)
  (system (format "lame --decode \"~A\" -|oggenc -q ~A -o \"~A\" -"
                  source quality target)))

(define (ogg->ogg source target)
  (system (format "oggdec -q -o - \"~A\"|oggenc -q ~A -o \"~A\" -"
                  source quality target)))

(define (mpc->ogg source target)
  (system (format "mpcdec \"~A\" -|oggenc -q ~A -o \"~A\" -"
                  source quality target)))

(define (wav->ogg source target)
  (system (format "oggenc -q ~A -o \"~A\" \"~A\""
                  quality target source)))

(define (schlup-file file-source dir-target)
  (let* ((file-target (make-pathname dir-target (pathname-file file-source)))
         (ogg-target (pathname-replace-extension file-target "ogg"))
         (ext (or (pathname-extension file-source) "")))
    (cond ((string-ci=? "flac" ext) (flac->ogg file-source ogg-target))
          ((string-ci=? "ape" ext) (ape->ogg file-source ogg-target))
          ((string-ci=? "ogg" ext) (ogg->ogg file-source ogg-target))
          ((string-ci=? "mp3" ext) (mp3->ogg file-source ogg-target))
          ((string-ci=? "mpc" ext) (mpc->ogg file-source ogg-target))
          ((string-ci=? "wav" ext) (wav->ogg file-source ogg-target))
          ((or (string-ci=? "m4a" ext)
               (string-ci=? "aac" ext)
               (string-ci=? "wma" ext)
               (string-ci=? "wv" ext))
           (printf "**** ERROR ****~%")
           (printf "  Unsupported file type: ~A~%" ext)
           (printf "  File: ~A~%" file))
          (else
           (file-copy file-source file-target #t)))))

(define (schlup-directory source target)
  (set! target (make-pathname target (pathname-last source)))
  (if (not (directory? target))
    (create-directory target))
  (for-each (lambda (ent)
              (set! ent (make-pathname source ent))
              (if (directory? ent)
                (schlup-directory ent target)
                (schlup-file ent target)))
            (sort (directory source) string<?)))

; FIXME
(let ((args (command-line-arguments)))
  (if (not (= 2 (length args)))
    (printf "Usage: schlup source-dir target-dir~%")
    (schlup-directory (car args) (cadr args))))