1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators.short-circuit continuations
4 debugger io io.directories io.encodings.utf8 io.files
5 io.launcher io.sockets io.streams.string kernel mason.common
6 mason.email sequences splitting ;
10 { "git" "show" } utf8 [ lines ] with-process-reader
11 first " " split second ;
15 : git-clone-cmd ( -- cmd )
19 "git://factorcode.org/git/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 "git://factorcode.org/git/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
45 "factor" really-delete-tree
48 : git-pull-failed ( error -- )
49 dup output-process-error? [
50 dup output>> "not uptodate. Cannot merge." swap start
51 [ git-repo-corrupted ]
56 : with-process-reader* ( desc encoding quot -- )
57 [ <process-reader*> ] dip swap [ with-input-stream ] dip
58 dup wait-for-process dup { 0 1 } member?
59 [ 2drop ] [ process-failed ] if ; inline
61 : git-status-cmd ( -- cmd )
64 : git-status-failed ( error -- )
65 #! Exit code 1 means there's nothing to commit.
66 dup { [ process-failed? ] [ code>> 1 = ] } 1&&
67 [ drop ] [ rethrow ] if ;
69 : git-status ( -- seq )
71 git-status-cmd utf8 [ lines ] with-process-reader*
72 [ "#\t" head? ] filter
73 ] [ git-status-failed { } ] recover ;
75 : check-repository ( -- seq )
76 "factor" [ git-status ] with-directory ;
78 : repo-dirty-body ( error -- string )
80 "Dirty repository on " write host-name write " will be re-cloned." print
81 "Modified and untracked files:" print nl
83 ] with-string-writer ;
85 : git-repo-dirty ( files -- )
86 repo-dirty-body "dirty repo" email-fatal
87 "factor" really-delete-tree
93 #! Must be run from builds-dir.
97 [ git-pull-cmd short-running-process ]
101 ] [ git-repo-dirty ] if-empty
103 "factor" [ git-id ] with-directory ;