diff --git a/osz-extract.scm b/osz-extract.scm new file mode 100644 index 0000000..61f4d13 --- /dev/null +++ b/osz-extract.scm @@ -0,0 +1,57 @@ +;; Guile script for extracting .osz files +;; Usage: guile -s osz-extract.scm DIR +;; will traverse DIR recursively and extract any X.osz file into a new directory called X + +(use-modules + (srfi srfi-1) + (srfi srfi-11) + (ice-9 ftw) + (ice-9 match)) + +(define (split-file-name filename) + (let* ([parts (string-split filename #\.)] + [ext (if (= (length parts) 1) + "" + (last parts))]) + (values (dirname filename) + (basename filename (string-append "." ext)) + ext))) + +(define (filename-extension filename) + (let-values + ([(dir base ext) (split-file-name filename)]) + ext)) + +(define (osz-file? filename) + (equal? (filename-extension filename) "osz")) + +(define* (invoke* . args) + (unless (= (status:exit-val (apply system* args)) 0) + (error "Couldn't execute " args))) + +(define (extract-osz filename) + (let-values + ([(dir base ext) (split-file-name filename)]) + (let* ([dirname (string-append dir "/" base)] + [src (string-append dir "/" base "." ext)]) + (unless (file-exists? dirname) + (mkdir dirname)) + (invoke* "unzip" src "-d" dirname) + (delete-file src)))) + +(define (walk filename statinfo flag) + (match flag + ('regular + (begin + (when (osz-file? filename) + (extract-osz filename)) + #t)) + (_ #t))) + + +(match (command-line) + (`(,_ ,dir) + (ftw dir walk)) + (_ + (format #t "Usage : guile -s extract.scm