Skip to content

Commit

Permalink
Merge pull request #98 from lehitoskin/temp-files
Browse files Browse the repository at this point in the history
Resolve #97
  • Loading branch information
IonoclastBrigham authored Sep 27, 2018
2 parents a555a41 + 94dfe35 commit 80d13c7
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 45 deletions.
60 changes: 28 additions & 32 deletions embed.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -265,10 +265,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(define itxt-hash (make-itxt-hash itxt-bstr))
(define new-hash (itxt-set png-hash itxt-hash "XML:com.adobe.xmp"))
(define new-png (hash->png new-hash))
(with-output-to-file png
(λ () (display new-png))
#:mode 'binary
#:exists 'truncate/replace))
(call-with-atomic-output-file png (λ (out tmp-png) (void (write-bytes new-png out)))))

(define (add-embed-jpeg! jpeg taglist)
(define jpeg-bytes (if (bytes? jpeg)
Expand Down Expand Up @@ -347,15 +344,16 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(cdr marker))
len
(bytes-length len-bstr))))
(with-output-to-file flif
(λ () (printf "~a~a~a~a~a"
before
#"eXmp"
(length->bytes (bytes-length deflated-bstr))
deflated-bstr
after))
#:mode 'binary
#:exists 'truncate/replace))
(call-with-atomic-output-file
flif
(λ (out tmp-flif)
(fprintf out
"~a~a~a~a~a"
before
#"eXmp"
(length->bytes (bytes-length deflated-bstr))
deflated-bstr
after))))

(define (set-embed-flif! flif taglist)
(define old-xmp (get-embed-flif flif))
Expand All @@ -375,10 +373,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(define itxt-hash (make-itxt-hash itxt-bstr))
(define new-hash (itxt-set png-hash itxt-hash "XML:com.adobe.xmp"))
(define new-png (hash->png new-hash))
(with-output-to-file png
(λ () (display new-png))
#:mode 'binary
#:exists 'truncate/replace))
(call-with-atomic-output-file png (λ (out tmp-png) (void (write-bytes new-png out)))))

; takes a list of strings and embeds them into a valid PNG
(define (set-embed-png! png taglist)
Expand Down Expand Up @@ -429,15 +424,15 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(integer->integer-bytes len 2 #f #t)
jpeg-XMP-id
xmp-bstr)))
(with-output-to-file jpeg
(λ ()
; sandwich the new XMP APP1 between the old data
(printf "~a~a~a"
(call-with-atomic-output-file
jpeg
(λ (out tmp-jpeg)
; sandwich the new XMP APP1 beteen the old data
(fprintf out
"~a~a~a"
bstr-before
app1-bstr
bstr-after))
#:mode 'binary
#:exists 'truncate/replace))
bstr-after))))

; what a giant mess this is
(define (set-embed-jpeg! jpeg taglist)
Expand Down Expand Up @@ -490,10 +485,14 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(define after-bstr (if (empty? pos-pair)
(bytes #x3b)
(subbytes bstr (+ (first (first pos-pair)) (second (first pos-pair))))))
(with-output-to-file gif
(λ () (printf "~a~a~a" before-bstr new-appn-xmp after-bstr))
#:mode 'binary
#:exists 'truncate/replace))
(call-with-atomic-output-file
gif
(λ (out tmp-gif)
(fprintf out
"~a~a~a"
before-bstr
new-appn-xmp
after-bstr))))

; embed the taglist into the gif
; application extension only available for GIF89a!
Expand Down Expand Up @@ -539,10 +538,7 @@ GIF XMP keyword: #"XMP Data" with auth #"XMP"
(string->bytes/utf-8 xmp-str)
#"</metadata>"
after))
(with-output-to-file svg
(λ () (display xmp-bstr))
#:mode 'binary
#:exists 'truncate/replace))
(call-with-atomic-output-file svg (λ (out tmp-svg) (void (write-bytes xmp-bstr out)))))

(define/contract (set-embed-svg! img taglist)
((and/c path-string? embed-support?) (listof string?) . -> . void?)
Expand Down
20 changes: 7 additions & 13 deletions thumbnails.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
png-image
racket/contract
racket/draw
racket/file
racket/list
racket/path
racket/string
Expand Down Expand Up @@ -53,17 +54,9 @@
(first (flif->list path #:animation? #f))]
[else (read-bitmap path)]))
(define thumb-path (path->md5 path))
; use a temporary file in case there's concurrent
; thumbnail generation going on
(define thumb-tmp
(build-path thumbnails-path
(string-append (number->string (current-seconds)) "_ivy-tmp.png")))
; use pict to scale the image to 128x128
(define thumb-pct (bitmap thumb-bmp))
(define thumb-small (pict->bitmap (scale-to-fit thumb-pct 128 128)))
(define thumb-port-out (open-output-file thumb-tmp
#:mode 'binary
#:exists 'truncate/replace))
(printf "Writing bytes to ~a~n" thumb-path)
(define thumb-hash (png->hash (convert thumb-small 'png-bytes)))
; set thumbnail attributes
Expand Down Expand Up @@ -99,10 +92,11 @@
(make-text-chunk mime "Thumb::Mimetype"))
"Thumb::Mimetype")])
(text-set mty (make-text-hash (make-text-chunk software "Software")) "Software")))
; save to disk
(write-bytes (hash->png setted) thumb-port-out)
(close-output-port thumb-port-out)
; rename thumb-tmp to thumb-path
(rename-file-or-directory thumb-tmp thumb-path #t)
; use a temporary file in case there's concurrent thumbnail generation going on
(call-with-atomic-output-file
thumb-path
(λ (thumb-out thumb-tmp)
; save to disk
(write-bytes (hash->png setted) thumb-out)))
(unless (eq? (system-type) 'windows)
(file-or-directory-permissions thumb-path #o600))))

0 comments on commit 80d13c7

Please sign in to comment.