#!/usr/bin/sbcl --noinform
;;; A script for maintaing a mirror of a music collection with the following rules
;;; Converts flac files to ogg (default quality 5, 160kbps)
;;; Hardlinks ogg, mp3 etc..
;;; The purpose is to have music files suitable for a portable device with
;;; low disk capacity, f.ex. 2gb.
;;; Usage: ./converter.lisp basedir targetdir quality
;;; The quality argument is optional and defaults to 5 when run from the command line
;;; Example: ./converter.lisp /media/sda4/musikk/ /media/sda4/ogg-musikk/ 5

(defpackage #:converter
  (:use #:cl #:asdf))

(in-package #:converter)

(defun action-hardlink(filename target)
	(let ((shell-command (format nil "ln \"~A\" \"~A\"" filename target)))
		(asdf:run-shell-command shell-command :output t)))

(defun action-convert-to-ogg(filename target quality)
		(let ((shell-command (format nil "sox \"~A\" -C ~A \"~A\"" filename quality target)))
			(format t "~A~%" shell-command)
			(asdf:run-shell-command shell-command :output t)))

(defun action(filename target quality)
	(ensure-directories-exist  target); Shell commands might fail because of missing directories without this
	(unless (probe-file target) ; NB! probe-file supposedly not portable between CL implementations, see PCL p174
		(if (string= (pathname-type filename) "flac")
				(action-convert-to-ogg filename target quality)
				(action-hardlink filename target))))

(defun new-suffix(filename)
	(let ((ftype (pathname-type filename)))
		(if (string= ftype "flac") "ogg" ftype)))

;; Remove ftype from filename, add .ogg
(defun target-filename(targetdir filename)
	(make-pathname :defaults targetdir :type (new-suffix filename) :name (pathname-name filename)))

;; The following two functions are from PCL chapter 15 (Practical: A portable pathname library)
(defun component-present-p (value)
	(and value (not (eql value :unspecific))))

(defun directory-pathname-p (p)
	(and
	 (not (component-present-p (pathname-name p)))
	 (not (component-present-p (pathname-type p)))
	 p))

(defun add-directory-to-path(path directory)
	(merge-pathnames (make-pathname :directory (list :relative directory)) path))

(defun loop-files(basedir targetdir quality)
	(loop for filename in (directory  (format nil "~A/*.*" basedir)) do
			 (if (directory-pathname-p filename)
					 (let ((newdir (first (last (pathname-directory filename)))))
						 (let ((basedir filename) (targetdir (add-directory-to-path targetdir newdir)))
							 (loop-files basedir targetdir quality)
							 ))
					 (action filename (target-filename targetdir filename) quality)
					 )))

;;;; Command line arguments are in sb-ext:*posix-argv*
;;;; This is a list with length 1 when run interactovely in Slime, length 2 or more if executed from the command line

(if (> (length sb-ext:*posix-argv*) 1) 
		(let ((basedir (make-pathname :defaults (third sb-ext:*posix-argv*)))
					(targetdir (make-pathname :defaults (fourth sb-ext:*posix-argv*)))
					(quality (or (fifth sb-ext:*posix-argv*) 5)))
			(loop-files basedir targetdir quality)))