qwertyist/cab
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

real actual initial commit

Browse Source
This commit is contained in:
botvid johansson 2025-12-08 17:00:00 +00:00
parent cfbfb368b2
commit a345512622
1 changed files with 96 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
cab.rkt Normal file
View File

@ -0,0 +1,96 @@
#lang racket
;; cab is a verb now.
;; =============================================================================
;; usage:
;; ./racket cab.rkt
;; ./racket cab.rkt -v
;; ./racket cab.rkt -p "/home/user/messy/folder/to/cab"
;; ============================================================================
;; SET UP CABINETS AND ASSOCIATED EXTENSIONS HERE
;; ============================================================================
(define cabinets '("archives" "audio" "dirs" "docs" "misc" "pics" "q3" "vids"))
(define (get-cabinet-name ext)
(define s
(if (bytes? ext) (bytes->string/utf-8 ext) ext))
(cond
[(string=? s "dir") "dirs"]
[(member s '("7z" "gz" "rar" "tar" "zip")) "archives"]
[(member s '("jpg" "jpeg" "png" "gif" "webp" "bmp" "tga")) "pics"]
[(member s '("txt" "doc" "docx" "odt" "xls" "ods" "pdf" "md" "epub")) "docs"]
[(member s '("wav" "ogg" "mp3")) "audio"]
[(member s '("avi" "mp4" "mpg" "mkv" "webm")) "vids"]
[(member s '("pk3" "dm_68")) "q3"]
[(member s '("crdownload")) #f] ;; don't touch chrome temp downloads
[else "misc"]))
(define (xdg-user-dir name)
(define config-file (expand-user-path "~/.config/user-dirs.dirs"))
(if (file-exists? config-file)
(let* ([lines (file->lines config-file)]
[prefix (string-append "XDG_" name "_DIR=")])
(for/or ([line lines])
(if (string-prefix? line prefix)
(let* ([raw (substring line (string-length prefix))]
[unquoted (regexp-replace* #px"\"" raw "")]
[expanded (regexp-replace
#px"\\$HOME"
unquoted
(path->string (find-system-path 'home-dir)))])
(path->complete-path (expand-user-path expanded)))
#f)))
#f))
(define xdg-download-dir (xdg-user-dir "DOWNLOAD"))
(define (create-cabinets)
(for ([cabinet cabinets])
(when (not (directory-exists? cabinet))
(make-directory cabinet))))
(define verbose? (make-parameter #f))
(define path-param (make-parameter xdg-download-dir))
(define (cab)
(command-line
#:once-each
[("-v") "Verbose mode" (verbose? #t)]
[("-p" "--path") path "Specify path" (path-param path)]
#:args ()
(void))
(define (process-files files)
(cond
[(empty? files) 'done]
[else
(let ([file-name (first files)])
(cond
[(and (equal? (file-or-directory-type file-name) 'directory)
(or (member (path->string file-name) cabinets)
(string=? (path->string file-name) ".")))
(when (verbose?) (displayln (format "Skipping cabinet/current directory: ~a" file-name)))
(process-files (rest files))]
[(equal? (file-or-directory-type file-name) 'file)
(let ([ext (filename-extension file-name)])
(let ([cabinet-name (get-cabinet-name ext)])
(if cabinet-name
(begin
(let ([new-path (build-path cabinet-name file-name)])
(rename-file-or-directory file-name new-path))
(let ([display-ext (if (bytes? ext) (bytes->string/utf-8 ext) ext)])
(when (verbose?) (displayln (format "~a -> ~a" display-ext cabinet-name)))))
(when (verbose?) (displayln (format "Skipping ~a (no move)" file-name))))))
(process-files (rest files))]
[(equal? (file-or-directory-type file-name) 'directory)
(let ([cabinet-name (get-cabinet-name "dir")])
(let ([new-path (build-path cabinet-name file-name)])
(rename-file-or-directory file-name new-path))
(when (verbose?) (displayln (format "~a -> ~a" file-name cabinet-name))))
(process-files (rest files))]))]))
(cond
[(directory-exists? (path-param))
(create-cabinets)
(let ([files (directory-list (path-param))])
(process-files files))]
[else
(displayln (format "Error: Directory not found at ~a" (path-param)))
#f]))
(current-directory xdg-download-dir)
(cab)