suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Add an attempt to find the SHA1 and date from the ".git/HEAD" file.

Browse Source 
* Try "/opt/local/bin/git" on OSX, since it's a common path for git, and
  when running through the Finder it will usually not be found in the
  $PATH.

* Explain the various results in a detailed comment.
This commit is contained in:
Eli Barzilay 2010-11-01 16:25:49 -04:00
parent 3160f821a5
commit ea591c3c23
1 changed files with 67 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/repo-time-stamp/stamp.rkt
View File

@ -2,6 +2,37 @@
(provide stamp) (provide stamp)
#|
This file provides a single binding, `stamp', with a string value that
describes the Racket version. The format of this stamp is a date, a
SHA1, and a character describing how the information was retrieved:
"YYYY-MM-DD(SHA1/H)"
The description is attempted in several ways, with the `H' character
indicating how it was actually obtained:
* "a" -- the date and sha1 information were in the `archive-id' string
below, which means that it had that information at the time that
`git archive' created an archive out of a git repository. This is
the expected value for nightly builds.
* "g" -- `archive-id' didn't have information, but we found a git
executable and ran it.
* "d" -- an executable was not found either, but a ".git" directory
was found in the usual place, with a "HEAD" file that has eventually
lead to a SHA1. In this case, the time stamp is the stamp of the
git reference file that was used.
* "f" -- none of the above worked, so the last resort was to report
the date of this file (which can provide a rough idea how old the
tree is, but obviously this can be arbitrary). In this case the
SHA1 is missing and will be "-".
|#
(define archive-id "$Format:%ct|%h|a$") (define archive-id "$Format:%ct|%h|a$")
;; when exported through `git archive', the above becomes something like ;; when exported through `git archive', the above becomes something like
;; "1273562690|cabd414|a" ;; "1273562690|cabd414|a"
@ -13,25 +44,42 @@
(define stamp (define stamp
(let ([rx:secs+id #rx"^([0-9]+)\\|([0-9a-f]+|-)\\|(.*?)[ \r\n]*$"]) (let ([rx:secs+id #rx"^([0-9]+)\\|([0-9a-f]+|-)\\|(.*?)[ \r\n]*$"])
(for*/or ([x (list ;; info from an archive (incl. nightly builds)
;; info from an archive (incl. nightly builds) (define (from-archive-id) archive-id)
(lambda () archive-id) ;; try to run git to get the current info
;; try to run git to get the current info (define (from-running-git)
(lambda () (let ([exe (or (find-executable-path "git")
(let ([exe (or (find-executable-path "git") (find-executable-path "git.exe")
(find-executable-path "git.exe"))]) (and (eq? 'macosx (system-type))
(and exe (find-executable-path "/opt/local/bin/git")))])
(let ([out (open-output-string)]) (and exe (let ([out (open-output-string)])
(parameterize ([current-output-port out] (parameterize ([current-output-port out]
[current-error-port out] [current-error-port out]
[current-directory this-dir]) [current-directory this-dir])
(system* exe "log" "-1" (system* exe "log" "-1" "--pretty=format:%ct|%h|g")
"--pretty=format:%ct|%h|g") (get-output-string out))))))
(get-output-string out)))))) ;; try to find a ".git" directory (can't run git, so conventional
;; fallback: get the date of this file, no id ;; guess) and use the sha1 from that file and its date
(lambda () (define (from-git-dir)
(format "~a|-|f" (define git-dir (build-path this-dir 'up 'up ".git"))
(file-or-directory-modify-seconds this-file))))]) (let loop ([file (build-path git-dir "HEAD")])
(let ([l (and (file-exists? file)
(call-with-input-file file read-line))])
(cond [(not l) #f]
[(regexp-match #rx"^ref: +(.*)$" l)
=> (lambda (m)
(loop (build-path git-dir (cadr m))))]
[(regexp-match #px"^[[:xdigit:]]{40}$" l)
(format "~a|~a|d"
(file-or-directory-modify-seconds file)
(substring l 0 8))]))))
;; fallback: get the date of this file, no id
(define (from-this-file)
(format "~a|-|f" (file-or-directory-modify-seconds this-file)))
(for*/or ([x (list from-archive-id
from-running-git
from-git-dir
from-this-file)])
(let* ([x (x)] (let* ([x (x)]
[m (and (string? x) (regexp-match rx:secs+id x))] [m (and (string? x) (regexp-match rx:secs+id x))]
[d (and m (seconds->date (string->number (cadr m))))] [d (and m (seconds->date (string->number (cadr m))))]