1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors continuations debugger io io.directories
4 io.encodings.utf8 io.files io.launcher io.sockets
5 io.streams.string kernel mason.common mason.email sequences
10 { "git" "show" } utf8 [ read-lines ] with-process-reader
11 first split-words second ;
15 : git-clone-cmd ( -- cmd )
19 "https://github.com/factor/factor.git"
23 ! Must be run from builds-dir
24 "Cloning initial repository" print-timestamp
25 git-clone-cmd try-output-process ;
27 : git-pull-cmd ( -- cmd )
31 "https://github.com/factor/factor.git"
35 : repo-corrupted-body ( error -- string )
37 "Corrupted repository on " write host-name write " will be re-cloned." print
38 "Error while pulling was:" print
41 ] with-string-writer ;
43 : git-repo-corrupted ( error -- )
44 repo-corrupted-body "corrupted repo" email-fatal
48 : git-pull-failed ( error -- )
49 dup output-process-error? [
50 dup output>> "not uptodate. Cannot merge." swap subseq?
51 [ git-repo-corrupted ]
56 : git-status-cmd ( -- cmd )
57 { "git" "status" "--porcelain" } ;
59 : git-status ( -- seq )
60 git-status-cmd utf8 [ read-lines ] with-process-reader ;
62 : check-repository ( -- seq )
63 "factor" [ git-status ] with-directory ;
65 : repo-dirty-body ( error -- string )
67 "Dirty repository on " write host-name write " will be re-cloned." print
68 "Modified and untracked files:" print nl
70 ] with-string-writer ;
72 : git-repo-dirty ( files -- )
73 repo-dirty-body "dirty repo" email-fatal
79 : git-clone-or-pull ( -- id )
80 ! Must be run from builds-dir.
81 "factor" file-exists? [
84 [ git-pull-cmd short-running-process ]
88 ] [ git-repo-dirty ] if-empty
90 "factor" [ git-id ] with-directory ;