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.directories.hierarchy
5 io.encodings.utf8 io.files io.launcher io.sockets
6 io.streams.string kernel mason.common mason.email sequences
11 { "git" "show" } utf8 [ lines ] with-process-reader
12 first " " split second ;
16 : git-clone-cmd ( -- cmd )
20 "git://factorcode.org/git/factor.git"
24 ! Must be run from builds-dir
25 "Cloning initial repository" print-timestamp
26 git-clone-cmd try-output-process ;
28 : git-pull-cmd ( -- cmd )
32 "git://factorcode.org/git/factor.git"
36 : repo-corrupted-body ( error -- string )
38 "Corrupted repository on " write host-name write " will be re-cloned." print
39 "Error while pulling was:" print
42 ] with-string-writer ;
44 : git-repo-corrupted ( error -- )
45 repo-corrupted-body "corrupted repo" email-fatal
49 : git-pull-failed ( error -- )
50 dup output-process-error? [
51 dup output>> "not uptodate. Cannot merge." swap subseq?
52 [ git-repo-corrupted ]
57 : git-status-cmd ( -- cmd )
60 : git-status-failed ( error -- )
61 ! Exit code 1 means there's nothing to commit.
62 dup { [ process-failed? ] [ code>> 1 = ] } 1&&
63 [ drop ] [ rethrow ] if ;
65 : git-status ( -- seq )
67 git-status-cmd utf8 [ lines ] with-process-reader*
68 { 0 1 } member? [ drop ] [ process-failed ] if
69 [ "#\t" head? ] filter
70 ] [ git-status-failed { } ] recover ;
72 : check-repository ( -- seq )
73 "factor" [ git-status ] with-directory ;
75 : repo-dirty-body ( error -- string )
77 "Dirty repository on " write host-name write " will be re-cloned." print
78 "Modified and untracked files:" print nl
80 ] with-string-writer ;
82 : git-repo-dirty ( files -- )
83 repo-dirty-body "dirty repo" email-fatal
89 : git-clone-or-pull ( -- id )
90 ! Must be run from builds-dir.
94 [ git-pull-cmd short-running-process ]
98 ] [ git-repo-dirty ] if-empty
100 "factor" [ git-id ] with-directory ;