-
Notifications
You must be signed in to change notification settings - Fork 35
/
sh.janet
173 lines (153 loc) · 5.71 KB
/
sh.janet
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
###
### Shell utilties for Janet.
### sh.janet
###
(import ./path)
(defn devnull
"get the /dev/null equivalent of the current platform as an open file"
[]
(os/open (if (= :windows (os/which)) "NUL" "/dev/null") :rw))
(defn exec
"Execute command specified by args returning its exit code"
[& args]
(os/execute args :p))
(defn exec-fail
"Execute command specified by args, fails when command exits with non-zero exit code"
[& args]
(os/execute args :px))
(defn exec-slurp
```
It executes args with `os/spawn` and throws an error if the process returns with non-zero exit code. If the process
exits with zero exit code, this function trims standard output of the process and returns it. Before the function
finishes, the spawned process is closed for resource control.
```
[& args]
# Close the process pipes. If the process pipes are not closed, janet can run out of file descriptors.
(with [proc (os/spawn args :xp {:out :pipe})]
(let [[out] (ev/gather
(ev/read (proc :out) :all)
(os/proc-wait proc))]
(if out (string/trimr out) ""))))
(defn exec-slurp-all
```
It executes args with `os/spawn` and returns a struct which has the following keys.
* `:out` - trimmed standard output of the process
* `:err` - trimmed standard error of the process
* `:status` - the exit code of the process
Before the function finishes, the spawned process is closed for resource control.
```
[& args]
# Close the process pipes. If the process pipes are not closed, janet can run out of file descriptors.
(with [proc (os/spawn args :p {:out :pipe :err :pipe})]
(let [[out err status]
(ev/gather
(ev/read (proc :out) :all)
(ev/read (proc :err) :all)
(os/proc-wait proc))]
{:out (if out (string/trimr out) "")
:err (if err (string/trimr err) "")
:status status})))
(defn rm
"Remove a directory and all sub directories recursively."
[path]
(case (os/lstat path :mode)
:directory (do
(each subpath (os/dir path)
(rm (path/join path subpath)))
(os/rmdir path))
nil nil # do nothing if file does not exist
# Default, try to remove
(os/rm path)))
(defn exists?
"Check if the given file or directory exists. (Follows symlinks)"
[path]
(not= nil (os/stat path)))
(defn scan-directory
"Scan a directory recursively, applying the given function on all files and
directories in a depth-first manner. This function has no effect if the
directory does not exist."
[dir func]
(each name (try (os/dir dir) ([_] @[]))
(def fullpath (path/join dir name))
(case (os/stat fullpath :mode)
:file (func fullpath)
:directory (do
(scan-directory fullpath func)
(func fullpath)))))
(defn list-all-files
"List the files in the given directory recursively. Return the paths to all
files found, relative to the current working directory if the given path is a
relative path, or as an absolute path otherwise."
[dir &opt into]
(default into @[])
(each name (try (os/dir dir) ([_] @[]))
(def fullpath (path/join dir name))
(case (os/stat fullpath :mode)
:file (array/push into fullpath)
:directory (list-all-files fullpath into)))
into)
(defn create-dirs
"Create all directories in path specified as string including itself."
[dir-path]
(def dirs @[])
(each part (path/parts dir-path)
(array/push dirs part)
(let [path (path/join ;dirs)]
(if-not (os/lstat path)
(os/mkdir path)))))
(defn make-new-file
"Create and open a file, creating all the directories leading to the file if
they do not exist, and return it. By default, open as a writable file (mode is `:w`)."
[file-path &opt mode]
(default mode :w)
(let [parent-path (path/dirname file-path)]
(when (and (not (exists? file-path))
(not (exists? parent-path)))
(create-dirs parent-path)))
(file/open file-path mode))
(defn copy-file
"Copy a file from source to destination. Creates all directories in the path
to the destination file if they do not exist."
[src-path dst-path]
(def buf-size 4096)
(def buf (buffer/new buf-size))
(with [src (file/open src-path :rb)]
(with [dst (make-new-file dst-path :wb)]
(while (def bytes (file/read src buf-size buf))
(file/write dst bytes)
(buffer/clear buf)))))
(defn copy
`Copy a file or directory recursively from one location to another.
Expects input to be unix style paths`
[src dest]
(if (= :windows (os/which))
(let [end (last (path/posix/parts src))
isdir (= (os/stat src :mode) :directory)]
(os/shell (string "C:\\Windows\\System32\\xcopy.exe"
" "
(path/win32/join ;(path/posix/parts src))
(path/win32/join ;(if isdir [;(path/posix/parts dest) end] (path/posix/parts dest)))
"/y /s /e /i > nul")))
(os/execute ["cp" "-rf" src dest] :px)))
(def- shlex-grammar (peg/compile ~{
:ws (set " \t\r\n")
:escape (* "\\" (capture 1))
:dq-string (accumulate (* "\"" (any (+ :escape (if-not "\"" (capture 1)))) "\""))
:sq-string (accumulate (* "'" (any (if-not "'" (capture 1))) "'"))
:token-char (+ :escape (* (not :ws) (capture 1)))
:token (accumulate (some :token-char))
:value (* (any (+ :ws)) (+ :dq-string :sq-string :token) (any :ws))
:main (any :value)
}))
(defn split
"Split a string into 'sh like' tokens, returns
nil if unable to parse the string."
[s]
(peg/match shlex-grammar s))
(defn- shell-quote
[arg]
(string "'" (string/replace-all "'" `'\''` arg) "'"))
(defn escape
"Output a string with all arguments correctly quoted"
[& args]
(string/join (map shell-quote args) " "))