Permalink
Browse files

Initial import from SVN

  • Loading branch information...
0 parents commit 8ca8044ca77a1e373e3166a3d144527b9e92efde @jeapostrophe committed Apr 19, 2010
Showing with 3,677 additions and 0 deletions.
  1. +31 −0 fs-persist/data-manager.ss
  2. +53 −0 fs-persist/fs-persist.ss
  3. +124 −0 fs-persist/fscache.ss
  4. +24 −0 fs-persist/opcache.ss
  5. +10 −0 lib/identity.ss
  6. +137 −0 lib/pdftk.ss
  7. +23 −0 lib/resume-data-util.ss
  8. +330 −0 lib/resume-data.ss
  9. +724 −0 lib/resume-lib.ss
  10. +109 −0 lib/util.ss
  11. +109 −0 lib/web-util.ss
  12. +477 −0 part/admin.ss
  13. +157 −0 part/apply.ss
  14. +278 −0 part/initiate.ss
  15. +208 −0 part/letter.ss
  16. +438 −0 part/review.ss
  17. +87 −0 resume.ss
  18. +206 −0 wtk/wtk-list-table.ss
  19. +152 −0 wtk/wtk-list.ss
@@ -0,0 +1,31 @@
+#lang web-server
+; XXX: You could lock this or put it in a kill-safe thread.
+(define-struct file-manager (write current))
+
+(define (file-manager-load read write)
+ (make-file-manager write (read)))
+(define (file-manager-load/path read write path)
+ (file-manager-load (lambda () (read path))
+ (lambda (o) (write path o))))
+
+(define (file-manager-ize/write-op wop)
+ (lambda (fm . args)
+ (define old (file-manager-current fm))
+ (define new (apply wop old args))
+ (set-file-manager-current! fm new)
+ ((file-manager-write fm) new)))
+
+(define (file-manager-ize/read-op rop)
+ (lambda (fm . args)
+ (apply rop (file-manager-current fm) args)))
+
+(define (file-manager/parameter f p)
+ (lambda args
+ (apply f (p) args)))
+
+(provide file-manager?
+ file-manager-load
+ file-manager-load/path
+ file-manager-ize/write-op
+ file-manager-ize/read-op
+ file-manager/parameter)
@@ -0,0 +1,53 @@
+#lang web-server
+(require (lib "file.ss")
+ (lib "list.ss"))
+(require "fscache.ss")
+(provide read-path
+ read-path/default
+ write-path
+ bind-to-file
+ bind-within-directory)
+
+;; Utility
+(define (dirname p)
+ (apply build-path
+ (reverse (rest (reverse (explode-path (build-path p)))))))
+
+;; Caching
+(define cache (make-fscache))
+(define with-input-from-file/cache (make-with-input-from-file cache))
+(define with-output-to-file/cache (make-with-output-to-file cache))
+
+;; Generators
+(define (read-path p)
+ (with-input-from-file/cache p read))
+(define (read-path/default p fail-thunk)
+ (with-handlers ([exn:fail? (lambda (e) (fail-thunk))])
+ (with-input-from-file/cache p read)))
+(define (write-path p v)
+ (make-directory* (dirname p))
+ (with-output-to-file/cache p (lambda () (write v)) 'truncate))
+(define (bind-to-file path-f default-t)
+ (values (lambda args
+ (read-path/default
+ (apply path-f args)
+ default-t))
+ (lambda args
+ (define new (first (reverse args)))
+ (define pargs (reverse (rest (reverse args))))
+ (write-path
+ (apply path-f pargs)
+ new))))
+(define (bind-within-directory directory-fn)
+ (define (item-dir . args)
+ (define new (first (reverse args)))
+ (define pargs (reverse (rest (reverse args))))
+ (string-append (apply directory-fn pargs) new "/"))
+ (values directory-fn
+ (lambda args
+ (map path->string
+ (with-handlers ([exn:fail? (lambda _ empty)])
+ (directory-list (apply directory-fn args)))))
+ item-dir
+ (lambda args
+ (directory-exists? (apply item-dir args)))))
@@ -0,0 +1,124 @@
+#lang web-server
+(require (lib "plt-match.ss")
+ (lib "list.ss")
+ (lib "etc.ss")
+ (lib "file.ss"))
+(provide fscache?
+ (rename-out [ext:make-fscache make-fscache])
+ make-with-input-from-file
+ make-with-output-to-file)
+
+(define-struct fscache (channel manager))
+
+(define-struct request (reply-channel))
+(define-struct (request:lookup request) (path))
+(define-struct (request:replace request) (path new-bytes))
+(define-struct (request:prune request) (proc))
+
+(define-struct return ())
+(define-struct (failure return) (exn))
+(define-struct (success return) (value))
+(define return-value
+ (match-lambda
+ [(struct success (v))
+ v]
+ [(struct failure (e))
+ (raise e)]))
+
+; ext:make-fscache : -> fscache?
+(define (ext:make-fscache)
+ (define cache-table
+ (make-hash-table 'equal))
+ (define (lookup p)
+ (define last-mod
+ (file-or-directory-modify-seconds p))
+ (define cur
+ (hash-table-get cache-table p
+ (lambda ()
+ (define new
+ (list (file-or-directory-modify-seconds p)
+ (with-input-from-file p
+ (lambda ()
+ (read-bytes (file-size p))))))
+ (hash-table-put! cache-table p new)
+ new)))
+ (if (> last-mod (first cur))
+ (begin (hash-table-remove! cache-table p)
+ (lookup p))
+ cur))
+ (define (replace p nb)
+ (hash-table-remove! cache-table p)
+ (with-output-to-file p (lambda () (display nb)) 'truncate)
+ #t)
+ (define request-channel (make-channel))
+ (define manager
+ (thread/suspend-to-kill
+ (lambda ()
+ (let loop ()
+ (sync
+ (handle-evt
+ request-channel
+ (match-lambda
+ [(struct request:lookup (rc p))
+ (with-handlers ([exn:fail? (lambda (e)
+ (channel-put rc (make-failure e)))])
+ (channel-put rc (make-success (second (lookup p)))))
+ (loop)]
+ [(struct request:replace (rc p nb))
+ (with-handlers ([exn:fail? (lambda (e)
+ (channel-put rc (make-failure e)))])
+ (channel-put rc (make-success (replace p nb))))
+ (loop)])))))))
+ (make-fscache request-channel manager))
+
+; fscache-lookup : fscache? path? -> bytes?
+(define (fscache-lookup an-fscache path)
+ (define reply-channel (make-channel))
+ (thread-resume (fscache-manager an-fscache))
+ (channel-put (fscache-channel an-fscache)
+ (make-request:lookup reply-channel path))
+ (return-value (channel-get reply-channel)))
+
+; fscache-replace : fscache? path? bytes? -> void
+(define (fscache-replace an-fscache path bytes)
+ (define reply-channel (make-channel))
+ (thread-resume (fscache-manager an-fscache))
+ (channel-put (fscache-channel an-fscache)
+ (make-request:replace reply-channel path bytes))
+ (return-value (channel-get reply-channel))
+ (void))
+
+; make-with-input-from-file : fscache? -> path? (-> alpha) [ignored] -> alpha
+(define ((make-with-input-from-file an-fscache) path thunk . wiff-args)
+ (define input
+ (open-input-bytes (fscache-lookup an-fscache (normalize-path path))))
+ (parameterize ([current-input-port input])
+ (thunk)))
+
+; make-with-output-to-file : fscache? -> path? (-> alpha) [ignored] -> alpha
+; XXX: Should enforce that you are not using 'append, or implement it correctly.
+(define ((make-with-output-to-file an-fscache) path thunk . wotf-args)
+ (define output-bytes (open-output-bytes))
+ ; Not in tail-position. This seems reasonable, however.
+ (begin0
+ (parameterize ([current-output-port output-bytes])
+ (thunk))
+ (fscache-replace an-fscache
+ (normalize-path path)
+ (get-output-bytes output-bytes))))
+
+(define (test)
+ (define an-fscache (ext:make-fscache))
+ (define with-input-from-file (make-with-input-from-file an-fscache))
+ (define with-output-to-file (make-with-output-to-file an-fscache))
+ (define path "/tmp/blahblahblah")
+ (with-output-to-file path
+ (lambda () (write #t)))
+ (build-list 100
+ (lambda (i)
+ (with-input-from-file path read)))
+ (read)
+ (build-list 100
+ (lambda (i)
+ (with-input-from-file path read)))
+ (void))
@@ -0,0 +1,24 @@
+#lang web-server
+(require (lib "list.ss"))
+(provide (all-defined-out))
+
+; cache-op : proc? path? -> proc?
+(define (cache-op op cache-path)
+ (define the-ht (make-hash-table 'equal))
+ (define (write-cache!)
+ (with-output-to-file cache-path
+ (lambda ()
+ (write (hash-table-map the-ht list)))
+ 'truncate/replace))
+ (for-each (lambda (k+v)
+ (hash-table-put! the-ht (first k+v) (second k+v)))
+ (if (file-exists? cache-path)
+ (with-input-from-file cache-path read)
+ empty))
+ (lambda key
+ (hash-table-get the-ht key
+ (lambda ()
+ (define value (apply op key))
+ (hash-table-put! the-ht key value)
+ (write-cache!)
+ value))))
@@ -0,0 +1,10 @@
+#lang web-server
+(require (lib "plt-match.ss"))
+(provide (all-defined-out))
+
+(define-struct an-identity () #:prefab)
+(define-struct (identity:reference an-identity) (refcode) #:prefab)
+(define-struct (identity:internal an-identity) (csid) #:prefab)
+(define-struct (identity:applicant an-identity) (id) #:prefab)
+
+(define current-identity (make-web-cell #f))
@@ -0,0 +1,137 @@
+#lang web-server
+(require (lib "process.ss")
+ (lib "list.ss")
+ (only-in (lib "file.ss") make-directory*)
+ (planet "hash-store.ss" ("jaymccarthy" "hash-store.plt" 1)))
+(require "../lib/resume-lib.ss"
+ "../lib/util.ss"
+ "../lib/resume-data.ss"
+ "../lib/resume-data-util.ss")
+(provide update-aggregate!
+ create-multi-applicant-aggregate!)
+
+(define (merge new . olds)
+ (apply process*/ports
+ (current-output-port) (open-input-string (string)) (current-error-port)
+ (pdftk-path)
+ (append olds
+ (list "cat" "output" new))))
+
+(define (create-multi-applicant-aggregate! sanids letters?)
+ (define filename
+ (string-append
+ (bytes->string/utf-8
+ (SHA1
+ (string->bytes/utf-8
+ (apply string-append (if letters? "yes" "no") sanids))))
+ ".pdf"))
+ (define path (string-append (aggregate/public-directory) filename))
+ (make-directory* (aggregate/public-directory))
+ (apply merge path
+ (map (lambda (sanid)
+ (unless (and (file-exists? (applicant/aggregate-tex sanid))
+ (file-exists? (applicant/aggregate-letters-tex sanid)))
+ (update-aggregate! sanid #t)
+ (update-aggregate! sanid #f))
+ (if letters?
+ (applicant/aggregate-letters sanid)
+ (applicant/aggregate sanid)))
+ sanids))
+ path)
+
+(define (aggregate-latex sanid letters?)
+ (string-append
+ (format #<<END
+\documentclass{article}
+\usepackage{type1cm}
+\usepackage{graphics}
+\usepackage{pdfpages}
+\usepackage[pdftex]{hyperref}
+\pdfoptionpdfminorversion=7
+\hypersetup{
+pdfauthor = {Resume},
+pdftitle = {~a ~a},
+pdfsubject = {Faculty Applications},
+pdfkeywords = {~a}}
+\begin{document}
+\pdfbookmark[1]{~a ~a}{~a}
+\begin{center}
+{\bf \fontsize{150}{50}\selectfont X} \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+{\bf \fontsize{60}{50}\selectfont ~a ~a} \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+~~ \\
+{\bf \fontsize{150}{50}\selectfont X}
+\end{center}
+\newpage
+
+END
+ (applicant-fname sanid) (applicant-lname sanid)
+ (applicant-areas/string sanid)
+ (applicant-fname sanid) (applicant-lname sanid)
+ sanid
+ (applicant-fname sanid) (applicant-lname sanid))
+ (apply string-append
+ (map (lambda (l f)
+ (format #<<END
+\pdfbookmark[2]{~a}{~a_ts}
+\includepdf[pages=-]{~a}
+
+END
+ l sanid (f sanid)))
+ (list "Cover Letter"
+ "CV"
+ "Research Statement"
+ "Teaching Statement")
+ (list applicant/cover-letter
+ applicant/cv
+ applicant/research-stmt
+ applicant/teaching-stmt)))
+ (if (not letters?)
+ ""
+ (string-append
+ (format #<<END
+\pdfbookmark[2]{Letter Writers}{~a_lw}
+
+END
+ sanid)
+ (apply string-append
+ (map (lambda (refcode)
+ (if (file-exists? (applicant/reference-letter sanid refcode))
+ (format
+ #<<END
+\pdfbookmark[3]{~a}{~a}
+\includepdf[pages=-]{~a}
+
+END
+ (applicant-letter-writer-name sanid refcode)
+ refcode (applicant/reference-letter sanid refcode))
+ ""))
+ (applicant-letter-writers sanid)))))
+ #<<END
+\end{document}
+
+END
+ ))
+
+(define (update-aggregate! sanid letters?)
+ (define filename
+ (if letters?
+ (applicant/aggregate-letters-tex sanid)
+ (applicant/aggregate-tex sanid)))
+ (with-output-to-file filename
+ (lambda ()
+ (display (aggregate-latex sanid letters?)))
+ #:exists 'truncate/replace)
+ (parameterize ([current-directory (applicant/public-directory sanid)])
+ (system* (pdflatex-path) filename)
+ (system* (pdflatex-path) filename)))
Oops, something went wrong.

0 comments on commit 8ca8044

Please sign in to comment.