hans/audio-library-manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

small bug fixes and packaging

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-28 13:50:48 +02:00
parent 14bf3a1da1
commit 558895b578
6 changed files with 97 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Makefile
+8
View File
@@ -0,0 +1,8 @@
all:
@echo "make arch"
arch:
(cd ..; tar czf ../audio-manager.tar.gz --exclude .git --exclude "*.bak" --exclude "*.*~" audio-library-manager)
arch.sh
+4
View File
@@ -0,0 +1,4 @@
#!/bin/bash
VERSION=`cat info.rkt | grep version | sed -e 's/^[^0-9]*//' -e s'/[^0-9]*$//'`
echo VERSION=$VERSION
(cd ..; tar czf audio-manager-$VERSION.tar.gz --exclude .git --exclude "*.bak" --exclude "*.*~" audio-library-manager)
audio-manager.rkt
+56 -48
View File
@@ -18,6 +18,7 @@
(define (audio-manager music-path opus-path #:log-level [log-level 'debug]) (define (audio-manager music-path opus-path #:log-level [log-level 'debug])
(let* ((ini-config-file (build-path music-path ".audio-manager.ini")) (let* ((ini-config-file (build-path music-path ".audio-manager.ini"))
(ini (file->ini ini-config-file)) (ini (file->ini ini-config-file))
(mail-oke (check-mail-config))
(report-flacs-with-id3 "FLAC files with id3 tags\n\n") (report-flacs-with-id3 "FLAC files with id3 tags\n\n")
(report-flac "") (report-flac "")
(report-opus "") (report-opus "")
@@ -206,54 +207,56 @@
) )
(values base-path path info)) (values base-path path info))
;; Converteer naar opus indien nodig en flac.
(define (to-opus base-path path info) (define (to-opus base-path path info)
(when (or (needs-processing? path info) (when (and (needs-processing? path info)
(needs-copying? info)) (flac? path info))
(if (flac? path info) (let ((path-part (get-path-part info)))
(let ((path-part (get-path-part info))) (unless (eq? path-part #f)
(unless (eq? path-part #f) (let ((opus-file (path-replace-extension
(let ((opus-file (path-replace-extension (build-path opus-path path-part)
(build-path opus-path path-part) #".opus")))
#".opus"))) (set! processed-opus (+ processed-opus 1))
(set! processed-opus (+ processed-opus 1)) (info-am "Converting flac to opus: ~a" opus-file)
(unless (file-exists? opus-file) (rep-opus
(info-am "Converting flac to opus: ~a" opus-file) (format "Converting flac to opus: ~a" (basename opus-file)))
(rep-opus (with-handlers ([exn? (λ (e)
(format "Converting flac to opus: ~a" (basename opus-file))) (set! failed-converts (+ failed-converts 1))
(with-handlers ([exn? (λ (e) (err-am "Conversion of ~a: ~a" path e))])
(set! failed-converts (+ failed-converts 1)) (unless (directory-exists? (basedir opus-file))
(err-am "Conversion of ~a: ~a" path e))]) (make-directory* (basedir opus-file)))
(unless (directory-exists? (basedir opus-file)) (if (convert-to-opus path opus-file ini)
(make-directory* (basedir opus-file))) (begin
(if (convert-to-opus path opus-file ini) (set! converted-files (+ converted-files 1))
(begin (info-am " Converted")
(set! converted-files (+ converted-files 1)) )
(info-am " Converted") (begin
) (info-am " CONVERSION PROBLEM")
(begin (rep-opus " Conversion failed!")
(info-am " CONVERSION PROBLEM") (set! failed-converts (+ failed-converts 1))
(rep-opus " Conversion failed!") )
(set! failed-converts (+ failed-converts 1))
)
)
) )
)
) )
) )
) )
(begin ; copy files rechtstreeks indien nodig )
(with-handlers ([exn? (λ (e) )
(set! failed-copies (+ failed-copies 1)) (values base-path path info))
(err-am "Copy file ~a: ~a" path e))])
(let ((path-part (get-path-part info))) ;; Kopieer bestanden rechtstreeks indien nodig en geen flac
(unless (eq? path-part #f) (define (copy-other base-path path info)
(let ((dest-path (build-path opus-path path-part))) (when (and (needs-copying? info)
(unless (directory-exists? (basedir dest-path)) (not (flac? path info)))
(make-directory* (basedir dest-path))) (with-handlers ([exn? (λ (e)
(copy-file path dest-path #:exists-ok? #t) (set! failed-copies (+ failed-copies 1))
(set! copied-files (+ copied-files 1))))) (err-am "Copy file ~a: ~a" path e))])
) (let ((path-part (get-path-part info)))
) (unless (eq? path-part #f)
(let ((dest-path (build-path opus-path path-part)))
(unless (directory-exists? (basedir dest-path))
(make-directory* (basedir dest-path)))
(copy-file path dest-path #:exists-ok? #t)
(set! copied-files (+ copied-files 1)))))
) )
) )
(values base-path path info)) (values base-path path info))
@@ -262,11 +265,12 @@
(when (deleted? info) (when (deleted? info)
(let ((path-part (get-path-part info))) (let ((path-part (get-path-part info)))
(unless (eq? path-part #f) (unless (eq? path-part #f)
(let ((rm-path (if (flac? info) (let ((rm-path (build-path opus-path
(path-replace-extension (if (flac? path info)
(build-path opus-path path-part) (path-replace-extension
#".opus") (build-path opus-path path-part)
(build-path opus-path path-part)))) #".opus")
path-part))))
(delete-directory/files rm-path #:must-exist? #f) (delete-directory/files rm-path #:must-exist? #f)
(let ((normalized-sub-path (hash-ref info 'path))) (let ((normalized-sub-path (hash-ref info 'path)))
(hash-remove! file-db-hash normalized-sub-path)) (hash-remove! file-db-hash normalized-sub-path))
@@ -360,12 +364,16 @@
(sl-set-log-level log-level) (sl-set-log-level log-level)
(let ((fw (make-file-admin music-path file-db-hash))) (let ((fw (make-file-admin music-path file-db-hash)))
;; Enrichement phase
(set! fw (fw-add-step fw adjust-ext)) (set! fw (fw-add-step fw adjust-ext))
(set! fw (fw-add-step fw flac-with-id3)) (set! fw (fw-add-step fw flac-with-id3))
(set! fw (fw-add-step fw flac-khz-bits)) (set! fw (fw-add-step fw flac-khz-bits))
;; Conversion phase
(set! fw (fw-add-step fw flac-convert)) (set! fw (fw-add-step fw flac-convert))
(set! fw (fw-add-step fw flac-picture)) (set! fw (fw-add-step fw flac-picture))
(set! fw (fw-add-step fw to-opus)) (set! fw (fw-add-step fw to-opus))
(set! fw (fw-add-step fw copy-other))
;; Cleanup/Logging phase
(set! fw (fw-add-step fw deleter)) (set! fw (fw-add-step fw deleter))
(set! fw (fw-add-step fw log-processed-file)) (set! fw (fw-add-step fw log-processed-file))
(let loop () (let loop ()
info.rkt
+2 -5
View File
@@ -2,15 +2,12 @@
(define collection "audio-library-manager") (define collection "audio-library-manager")
(define deps '("base" (define deps '("base"
"db-lib"
"keystore"
"racket-audio" "racket-audio"
"simple-ini" "simple-ini"
"simple-log" "simple-log"
"smtp" ))
"racket-sprintf"))
(define scribblings '(("scribblings/audio-library-manager.scrbl" ()))) (define scribblings '(("scribblings/audio-library-manager.scrbl" ())))
(define build-deps '("rackunit-lib" "scribble-lib" "racket-doc")) (define build-deps '("rackunit-lib" "scribble-lib" "racket-doc"))
(define pkg-desc "Audio library maintenance tools for FLAC and Opus trees") (define pkg-desc "Audio library maintenance tools for FLAC and Opus trees")
(define version "0.1.5") (define version "0.2.2")
(define pkg-authors '(hans-dijkema)) (define pkg-authors '(hans-dijkema))
private/log.rkt
-5
View File
@@ -9,9 +9,4 @@
fatal-am fatal-am
sync-log-am) sync-log-am)
(define log-defined #f)
(displayln (format "log-defined: ~a" log-defined))
(set! log-defined #t)
(sl-def-log audio-manager am) (sl-def-log audio-manager am)
private/mail.rkt
+27 -12
View File
@@ -4,25 +4,40 @@
net/head net/head
simple-ini) simple-ini)
(provide mail-report) (provide mail-report
check-mail-config)
(define (get ini key msg)
(let ((v (ini-get ini 'mail key 'nil)))
(when (eq? v 'nil)
(error msg))
v))
(define (get-config ini)
(let* ((from (get ini 'from "configure from address as name <email>"))
(to (get ini 'to "configure to address as name <email>"))
(server (get ini 'server "configure the smtp server"))
(port (ini-get ini 'mail 'port 25))
(user (ini-get ini 'mail 'user #f))
(passwd (ini-get ini 'mail 'passwd #f))
)
(values from to server port user passwd)))
(define (mail-report ini subject report) (define (mail-report ini subject report)
(let* ((get (λ (key msg) (let-values (((from to server port user auth) (get-config ini)))
(let ((v (ini-get ini 'mail key 'nil)))
(when (eq? v 'nil)
(error msg))
v)))
(from (get 'from "configure from address as name <email>"))
(to (get 'to "configure to address as name <email>"))
(server (get 'server "configure the smtp server"))
(port (ini-get ini 'mail 'port 25))
)
(let* ((hdr (standard-message-header from (list to) '() '() subject))) (let* ((hdr (standard-message-header from (list to) '() '() subject)))
(smtp-send-message server from (list to) hdr (smtp-send-message server from (list to) hdr
(if (list? report) report (list report)) (if (list? report) report (list report))
#:port-no port) #:port-no port
#:auth-user user
#:auth-pwd passwd
)
) )
) )
) )
(define (check-mail-config ini)
(let-values (((from to server port user passwd) (get-config ini)))
#t))