Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Moved to Dublin Core metadata where possible. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | 7eb028a9642b80c6d741303ca5f99a558cba4652 |
| User & Date: | alaric 2015-05-09 14:44:08 |
Context
|
2015-05-28
| ||
| 11:23 | OGG metadata parsing, and -Dfoo="bar" for defaults. check-in: 65f90322e5 user: alaric tags: trunk | |
|
2015-05-09
| ||
| 14:44 | Moved to Dublin Core metadata where possible. check-in: 7eb028a964 user: alaric tags: trunk | |
|
2015-04-20
| ||
| 13:19 | Ugarit manifest maker, with a reasonably complete ID3 parser in it... check-in: fcfe83ff3b user: alaric tags: trunk | |
Changes
Changes to ugarit-manifest-maker.scm.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 .. 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ... 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 ... 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 ... 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 ... 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 ... 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 ... 596 597 598 599 600 601 602 603 604 605 606 607 608 609 |
(use ugarit-mime)
(use srfi-37)
(use miscmacros)
(use fnmatch)
(use exif)
(define *excludes* '())
(define *total-objects* 0)
(define *total-bytes* 0)
(define (path-size path)
(if (directory? path)
(fold
+
................................................................................
(not (any
(lambda (pattern)
(fnmatch pattern name))
*excludes*))))
(define (get-jpeg-metadata path)
;; FIXME http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf
'((description . #f)
(latitude . #f)
(longitude . #f)
(altitude . #f)
(place-name . #f)
(featuring . #f)
(event-name . #f)
(creator . #f)
(creation-date . #f)
(keyword . #f)))
(define debug (lambda x (void)))
#;(define debug printf)
(define (alist-update! alist key value)
(let ((pair (assq key alist)))
(if (and (pair? pair) (not (cdr pair)))
................................................................................
(- fsize 1) ;; Remove encoding byte
(lambda (i) (integer->char (rb)))))))))
(debug "FID: ~S size: ~S [~S]\n" fid fsize data)
(cond
((string=? fid "\x00\x00\x00")
(abort* md))
((string=? fid "TT2")
(loop (alist-update! md 'name data)))
((string=? fid "TP1")
(loop (alist-update! md 'creator data)))
((string=? fid "TCM")
(loop (alist-update! md 'creator data)))
((string=? fid "TYE")
(loop (alist-update! md 'creation-date data)))
((string=? fid "TCO")
(loop (alist-update! md 'keyword (process-genre data))))
((string=? fid "TAL")
(loop (alist-update! md 'collection-name data)))
((string=? fid "TRK")
(and-let* ((parts (string-split data "/"))
((= (length parts) 2))
(track (string->number (first parts)))
(tracks (string->number (second parts))))
(loop (alist-update!
(alist-update! md 'volume-index track)
'volume-size tracks)))
(loop md))
((string=? fid "TPA")
(and-let* ((parts (string-split data "/"))
((= (length parts) 2))
(volume (string->number (first parts)))
(volumes (string->number (second parts))))
(loop (alist-update!
(alist-update! md 'collection-volume volume)
'collection-volumes volumes)))
(loop md))
(else
(printf " ;; Unknown ID3 tag ~S=~S\n"
fid
(string-append
(make-string 1 (integer->char encoding))
data))
................................................................................
(- fsize 1) ;; Remove encoding byte
(lambda (i) (integer->char (rb)))))))))
(debug "FID: ~S size: ~S [~S]\n" fid fsize data)
(cond
((string=? fid "\x00\x00\x00\x00")
(abort* md))
((string=? fid "TIT2")
(loop (alist-update! md 'name data)))
((string=? fid "TPE1")
(loop (alist-update! md 'creator data)))
((string=? fid "TCOM")
(loop (alist-update! md 'creator data)))
((string=? fid "TPE2")
(loop (alist-update! md 'featuring data)))
((string=? fid "TPE3")
(loop (alist-update! md 'featuring data)))
((string=? fid "TPE4")
(loop (alist-update! md 'editor data)))
((string=? fid "TPUB")
(loop (alist-update! md 'publisher data)))
((string=? fid "TYER")
(loop (alist-update! md 'creation-date data)))
((string=? fid "TCON")
(loop (alist-update! md 'keyword (process-genre data))))
((string=? fid "TALB")
(loop (alist-update! md 'collection-name data)))
((string=? fid "TRCK")
(and-let* ((parts (string-split data "/"))
((= (length parts) 2))
(track (string->number (first parts)))
(tracks (string->number (second parts))))
(loop (alist-update!
(alist-update! md 'volume-index track)
'volume-size tracks)))
(loop md))
((string=? fid "TPOS")
(and-let* ((parts (string-split data "/"))
((= (length parts) 2))
(volume (string->number (first parts)))
(volumes (string->number (second parts))))
(loop (alist-update!
(alist-update! md 'collection-volume volume)
'collection-volumes volumes)))
(loop md))
(else
(printf " ;; Unknown ID3 tag ~S=~S\n"
fid
(if (< (string-length data) 160)
data
(string-append
................................................................................
(collection-name . #f)
(collection-volume . #f)
(collection-volumes . #f)
(volume-index . #f)
(volume-size . #f)))
(define (get-pdf-metadata path)
'((creator . #f)
(topic . #f)
(creation-date . #f)
(keyword . #f)))
(define (get-ps-metadata path)
'((creator . #f)
(topic . #f)
(creation-date . #f)
(keyword . #f)))
(define (generate-manifest path)
(if (directory? path)
;; Recurse therein
(for-each (lambda (relname)
(generate-manifest (make-pathname path relname)))
(directory path))
................................................................................
;; Not a directory
(when (included-file? path)
(let* ((name (pathname-file path))
(*got-name* #f)
(print-item
(lambda (item)
(if (and (eq? (car item) 'name)
(cdr item))
(set! *got-name* #f))
(if (cdr item)
(printf " (~S = ~S)\n" (car item) (cdr item))
(printf " #;(~S = \"\")\n" (car item)))))
(mime-type (extension->mimetype (string-append "."
(or
(pathname-extension path)
"")))))
(printf "(object ~S\n" path)
(printf " (filename = ~S)\n" path)
(printf " (mime-type = ~S)\n" mime-type)
(newline)
(cond
((string=? mime-type "image/jpeg")
(for-each print-item
(get-jpeg-metadata path)))
................................................................................
((string=? mime-type "application/postscript")
(for-each print-item
(get-ps-metadata path)))
(else
(unless *got-name*
(printf " (name = ~S)\n" name))
(printf " #;(description = \"\")\n")))
(newline)
(let ((stat (file-stat path)))
(printf " (mtime = ~S)\n" (vector-ref stat 8))
(printf " (ctime = ~S)\n" (vector-ref stat 7)))
(let ((size (path-size path)))
(printf " (size = ~S))\n" size)
(set! *total-bytes*
(+ *total-bytes* size))
(set! *total-objects*
(+ *total-objects* 1)))
(newline)))))
(define (usage)
(with-output-to-port (current-error-port)
(lambda ()
(printf "Usage: ugarit-manifest-maker [options...] [files...]\n")
(printf " -e <pattern> Exclude files matching pattern\n")))
(exit 1))
(define things-to-import
(args-fold
(command-line-arguments)
(list
(option
................................................................................
'(#\h "help") #f #f
(lambda _
(usage)))
(option
'(#\e "exclude") #t #f
(lambda (o n x vals)
(push! x *excludes*)
vals)))
(lambda (o n x vals)
(usage))
cons
'()))
(for-each generate-manifest
|
> > | | < | < < < | < > | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | | | < > > > | | | > | | | | > > > > > > > > > > > |
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 .. 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 ... 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 ... 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 ... 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 ... 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 ... 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 ... 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 |
(use ugarit-mime) (use srfi-37) (use miscmacros) (use fnmatch) (use exif) (define *excludes* '()) (define *defines* '()) (define *total-objects* 0) (define *total-bytes* 0) (define (path-size path) (if (directory? path) (fold + ................................................................................ (not (any (lambda (pattern) (fnmatch pattern name)) *excludes*)))) (define (get-jpeg-metadata path) ;; FIXME http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf '((dc:description . #f) (dc:spatial . #f) (dc:temporal . #f) (dc:creator . #f) (dc:created . #f) (dc:subject . #f))) (define debug (lambda x (void))) #;(define debug printf) (define (alist-update! alist key value) (let ((pair (assq key alist))) (if (and (pair? pair) (not (cdr pair))) ................................................................................ (- fsize 1) ;; Remove encoding byte (lambda (i) (integer->char (rb))))))))) (debug "FID: ~S size: ~S [~S]\n" fid fsize data) (cond ((string=? fid "\x00\x00\x00") (abort* md)) ((string=? fid "TT2") (loop (alist-update! md 'dc:title data))) ((string=? fid "TP1") (loop (alist-update! md 'dc:creator data))) ((string=? fid "TCM") (loop (alist-update! md 'dc:creator data))) ((string=? fid "TYE") (loop (alist-update! md 'dc:created data))) ((string=? fid "TCO") (loop (alist-update! md 'dc:subject (process-genre data)))) ((string=? fid "TAL") (loop (alist-update! md 'set:title data))) ((string=? fid "TRK") (and-let* ((parts (string-split data "/")) ((= (length parts) 2)) (track (string->number (first parts))) (tracks (string->number (second parts)))) (loop (alist-update! (alist-update! md 'set:index track) 'set:size tracks))) (loop md)) ((string=? fid "TPA") (and-let* ((parts (string-split data "/")) ((= (length parts) 2)) (volume (string->number (first parts))) (volumes (string->number (second parts)))) (loop (alist-update! (alist-update! md 'superset:index volume) 'superset:size volumes))) (loop md)) (else (printf " ;; Unknown ID3 tag ~S=~S\n" fid (string-append (make-string 1 (integer->char encoding)) data)) ................................................................................ (- fsize 1) ;; Remove encoding byte (lambda (i) (integer->char (rb))))))))) (debug "FID: ~S size: ~S [~S]\n" fid fsize data) (cond ((string=? fid "\x00\x00\x00\x00") (abort* md)) ((string=? fid "TIT2") (loop (alist-update! md 'dc:title data))) ((string=? fid "TPE1") (loop (alist-update! md 'dc:creator data))) ((string=? fid "TCOM") (loop (alist-update! md 'dc:creator data))) ((string=? fid "TPE2") (loop (alist-update! md 'dc:contributor data))) ((string=? fid "TPE3") (loop (alist-update! md 'dc:contributor data))) ((string=? fid "TPE4") (loop (alist-update! md 'dc:contributor data))) ((string=? fid "TPUB") (loop (alist-update! md 'dc:publisher data))) ((string=? fid "TYER") (loop (alist-update! md 'dc:created data))) ((string=? fid "TCON") (loop (alist-update! md 'dc:subject (process-genre data)))) ((string=? fid "TALB") (loop (alist-update! md 'set:title data))) ((string=? fid "TRCK") (and-let* ((parts (string-split data "/")) ((= (length parts) 2)) (track (string->number (first parts))) (tracks (string->number (second parts)))) (loop (alist-update! (alist-update! md 'set:index track) 'set:size tracks))) (loop md)) ((string=? fid "TPOS") (and-let* ((parts (string-split data "/")) ((= (length parts) 2)) (volume (string->number (first parts))) (volumes (string->number (second parts)))) (loop (alist-update! (alist-update! md 'superset:index volume) 'superset:size volumes))) (loop md)) (else (printf " ;; Unknown ID3 tag ~S=~S\n" fid (if (< (string-length data) 160) data (string-append ................................................................................ (collection-name . #f) (collection-volume . #f) (collection-volumes . #f) (volume-index . #f) (volume-size . #f))) (define (get-pdf-metadata path) '((dc:creator . #f) (dc:subject . #f) (dc:description . #f) (dc:created . #f) (dc:identifier . #f) (dc:source . #f))) (define (get-ps-metadata path) '((dc:creator . #f) (dc:subject . #f) (dc:description . #f) (dc:created . #f) (dc:identifier . #f) (dc:source . #f))) (define (generate-manifest path) (if (directory? path) ;; Recurse therein (for-each (lambda (relname) (generate-manifest (make-pathname path relname))) (directory path)) ................................................................................ ;; Not a directory (when (included-file? path) (let* ((name (pathname-file path)) (*got-name* #f) (print-item (lambda (item) (if (and (eq? (car item) 'dc:title) (cdr item)) (set! *got-name* #f)) (if (cdr item) (printf " (~S = ~S)\n" (car item) (cdr item)) (printf " #;(~S = \"\")\n" (car item))))) (mime-type (extension->mimetype (string-append "." (or (pathname-extension path) ""))))) (printf "(object ~S\n" path) (printf " (filename = ~S)\n" path) (printf " (dc:format = ~S)\n" mime-type) (for-each print-item *defaults*) (newline) (cond ((string=? mime-type "image/jpeg") (for-each print-item (get-jpeg-metadata path))) ................................................................................ ((string=? mime-type "application/postscript") (for-each print-item (get-ps-metadata path))) (else (unless *got-name* (printf " (dc:title = ~S)\n" name)) (printf " #;(description = \"\")\n"))) (newline) (let ((stat (file-stat path))) (printf " (dc:modified = ~S)\n" (vector-ref stat 8)) (printf " (ctime = ~S)\n" (vector-ref stat 7))) (let ((size (path-size path))) (printf " (file-size = ~S))\n" size) (set! *total-bytes* (+ *total-bytes* size)) (set! *total-objects* (+ *total-objects* 1))) (newline))))) (define (usage) (with-output-to-port (current-error-port) (lambda () (printf "Usage: ugarit-manifest-maker [options...] [files...]\n") (printf " -e <pattern> Exclude files matching pattern\n") (printf " -D <key>=<value> Define default metadata for all files\n"))) (exit 1)) (define things-to-import (args-fold (command-line-arguments) (list (option ................................................................................ '(#\h "help") #f #f (lambda _ (usage))) (option '(#\e "exclude") #t #f (lambda (o n x vals) (push! x *excludes*) vals)) (option '(#\D "define") #t #f (lambda (o n x vals) (let ((pos (string-index x #\=))) (unless pos (usage)) (let ((key (string-take x pos)) (value (string-drop x (+ pos 1)))) (push! (cons key value) *defines*))) vals))) (lambda (o n x vals) (usage)) cons '())) (for-each generate-manifest |