Permalink
Browse files

Add a branch indicator to the stamp, if we can find one and it's not …

…"master".

Added by Sam's request.
  • Loading branch information...
elibarzilay committed May 5, 2012
1 parent 6e1ee71 commit 1fae7942d583352306e6acb302f98b4639e7eca8
Showing with 41 additions and 25 deletions.
  1. +41 −25 collects/repo-time-stamp/stamp.rkt
@@ -19,25 +19,28 @@
the expected value for nightly builds.
* "g" -- `archive-id' didn't have information, but we found a git
- executable and ran it.
+ 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.
+ 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 "-".
+ [*] In case of "g"/"d", another part is added, indicating the branch
+ name if one was found and if it isn't "master"; Eg, ".../g/foo".
+
|#
(define archive-id "$Format:%ct|%h|a$")
;; when exported through `git archive', the above becomes something like
;; "1273562690|cabd414|a"
-(require racket/system racket/runtime-path)
+(require racket/system racket/runtime-path racket/string)
(define-runtime-path this-dir ".")
(define-runtime-path this-file "stamp.rkt")
@@ -46,39 +49,52 @@
(let ([rx:secs+id #rx"^([0-9]+)\\|([0-9a-f]+|-)\\|(.*?)[ \r\n]*$"])
;; info from an archive (incl. nightly builds)
(define (from-archive-id) archive-id)
+ ;; adds a branch name if applicable (and if different from `master')
+ (define (add-branch str br*)
+ (define br
+ (and (string? br*)
+ (not (member br* '("refs/heads/master" "")))
+ (regexp-replace #rx"^refs/(?:heads/|remotes/)?" br* "")))
+ (if br (string-append str "/" br) str))
;; try to run git to get the current info
(define (from-running-git)
- (let ([exe (or (find-executable-path "git")
- (find-executable-path "git.exe")
- (and (eq? 'macosx (system-type))
- (find-executable-path "/opt/local/bin/git")))])
- (and exe (let ([out (open-output-string)])
- (parameterize ([current-output-port out]
- [current-error-port out]
- [current-input-port (open-input-string "")]
- [current-directory this-dir])
- (system* exe "log" "-1" "--pretty=format:%ct|%h|g")
- (get-output-string out))))))
+ (define exe
+ (or (find-executable-path "git")
+ (find-executable-path "git.exe")
+ (and (eq? 'macosx (system-type))
+ (find-executable-path "/opt/local/bin/git"))))
+ (define (git . args)
+ (define out (open-output-string))
+ (parameterize ([current-output-port out]
+ [current-error-port out]
+ [current-input-port (open-input-string "")]
+ [current-directory this-dir])
+ (apply system* exe args)
+ (string-trim (get-output-string out))))
+ (and exe (add-branch (git "log" "-1" "--pretty=format:%ct|%h|g")
+ (git "rev-parse" "--symbolic-full-name" "HEAD"))))
;; try to find a ".git" directory (can't run git, so conventional
;; guess) and use the sha1 from that file and its date
(define (from-git-dir)
(define git-dir (build-path this-dir 'up 'up ".git"))
+ (define branch #f)
(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))]))))
+ (define l (and (file-exists? file)
+ (call-with-input-file file read-line)))
+ (cond [(not l) #f]
+ [(regexp-match #rx"^ref: +(.*)$" l)
+ => (λ (m) (unless branch (set! branch (cadr m)))
+ (loop (build-path git-dir (cadr m))))]
+ [(regexp-match #px"^[[:xdigit:]]{40}$" l)
+ (add-branch (format "~a|~a|d"
+ (file-or-directory-modify-seconds file)
+ (substring l 0 8))
+ branch)])))
;; 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-running-git
from-git-dir
from-this-file)])
(let* ([x (x)]

0 comments on commit 1fae794

Please sign in to comment.