Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 329 lines (302 sloc) 10.588 kb
11220ce @ocorcoll License
authored
1 ;Copyright (C) 2009 Oriol Corcoll
2 ;
3 ;Licensed under the Apache License, Version 2.0 (the "License");
4 ;you may not use this file except in compliance with the License.
5 ;You may obtain a copy of the License at
6 ;
7 ;http://www.apache.org/licenses/LICENSE-2.0
8 ;
9 ;Unless required by applicable law or agreed to in writing, software
10 ;distributed under the License is distributed on an "AS IS" BASIS,
11 ;WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 ;See the License for the specific language governing permissions and
13 ;limitations under the License.
14
15
c6d19c4 @ocorcoll Add source
authored
16 (module beanscheme scheme
17 (provide (all-defined-out))
18
36dbc2a @ocorcoll Doc string in code.
authored
19 ;Open beanstalkd connection.
20 ;:p host: string?
21 ;:p port: integer?
22 ;:r: input-port? output-port?
c6d19c4 @ocorcoll Add source
authored
23 (define (open host port)
24 (tcp-connect host port))
25
36dbc2a @ocorcoll Doc string in code.
authored
26 ;Close beanstalkd connection.
27 ;:p out: output-port?
28 ;:p in: input-port?
c6d19c4 @ocorcoll Add source
authored
29 (define (quit out in)
30 (fprintf out "quit\r\n")
31 (close-output-port out)
32 (close-input-port in))
33
36dbc2a @ocorcoll Doc string in code.
authored
34 ;List tubes.
35 ;:p out: output-port?
36 ;:p in: input-port?
37 ;:r: list? or #f
c6d19c4 @ocorcoll Add source
authored
38 (define (list-tubes out in)
39 (fprintf out "list-tubes\r\n")
40 (flush-output out)
41 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
42 (if (string=? (first conf) "OK")
43 (filter (lambda (i) (not(string=? "" i)))
44 (map (lambda (i) (regexp-replace* #rx"-| " i ""))
45 (regexp-split #rx"\n|\r\n" (read-string (+ (string->number (last conf)) 2) in))))
46 #f)))
47
36dbc2a @ocorcoll Doc string in code.
authored
48 ;List watched tubes
49 ;:p out: output-port?
50 ;:p in: input-port?
51 ;:r: list? or #f
c6d19c4 @ocorcoll Add source
authored
52 (define (list-tubes-watched out in)
53 (fprintf out "list-tubes-watched\r\n")
54 (flush-output out)
55 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
56 (if (string=? (first conf) "OK")
57 (filter (lambda (i) (not(string=? "" i)))
58 (map (lambda (i) (regexp-replace* #rx"-| " i ""))
59 (regexp-split #rx"\n|\r\n" (read-string (+ (string->number (last conf)) 2) in))))
60 #f)))
61
36dbc2a @ocorcoll Doc string in code.
authored
62 ;Tube in use.
63 ;:p out: output-port?
64 ;:p in: input-port?
65 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
66 (define (list-tube-used out in)
67 (fprintf out "list-tube-used\r\n")
68 (flush-output out)
69 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
70 (if (string=? (first conf) "USING")
71 (last conf)
72 #f)))
36dbc2a @ocorcoll Doc string in code.
authored
73
74 ;Change tube in use.
75 ;:p tube: string?
76 ;:p out: output-port?
77 ;:p in: input-port?
78 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
79 (define (use tube out in)
80 (fprintf out "use ~a\r\n" tube)
81 (flush-output out)
82 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
83 (if (string=? (first conf) "USING")
84 (last conf)
85 #f)))
36dbc2a @ocorcoll Doc string in code.
authored
86
87 ;Change watching tube.
88 ;:p tube: string?
89 ;:p out: output-port?
90 ;:p in: input-port?
91 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
92 (define (watch tube out in)
93 (fprintf out "watch ~a\r\n" tube)
94 (flush-output out)
95 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
96 (if (string=? (first conf) "WATCHING")
97 (last conf)
98 #f)))
36dbc2a @ocorcoll Doc string in code.
authored
99
100 ;Ignore a tube.
101 ;:p tube: string?
102 ;:p out: output-port?
103 ;:p in: input-port?
104 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
105 (define (ignore tube out in)
106 (fprintf out "ignore ~a\r\n" tube)
107 (flush-output out)
108 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
109 (if (string=? (first conf) "WATCHING")
110 (last conf)
111 #f)))
36dbc2a @ocorcoll Doc string in code.
authored
112
113 ;Put job in queue.
114 ;:p data: string?
115 ;:p out: output-port?
116 ;:p in: input-port?
117 ;:p priority [100]: integer?
118 ;:p delay [0]: integer?
119 ;:p ttr [5]: integer?
120 ;:r: string? or #f
121 (define (put-string data out in [priority 100] [delay 0] [ttr 5])
122 (fprintf out "put ~a ~a ~a ~a\r\n" priority delay ttr (string-length data))
123 (fprintf out "~a\r\n" data)
124 (flush-output out)
125 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
126 (if (string=? (first conf) "INSERTED")
127 (last conf)
128 #f)))
c6d19c4 @ocorcoll Add source
authored
129
36dbc2a @ocorcoll Doc string in code.
authored
130 ;Put job in queue.
131 ;:p data: bytes?
132 ;:p out: output-port?
133 ;:p in: input-port?
134 ;:p priority [100]: integer?
135 ;:p delay [0]: integer?
136 ;:p ttr [5]: integer?
137 ;:r: string? or #f
138 (define (put-binary data out in [priority 100] [delay 0] [ttr 5])
139 (fprintf out "put ~a ~a ~a ~a\r\n" priority delay ttr (bytes-length data))
140 (fprintf out "~a\r\n" data)
c6d19c4 @ocorcoll Add source
authored
141 (flush-output out)
142 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
143 (if (string=? (first conf) "INSERTED")
144 (last conf)
145 #f)))
146
36dbc2a @ocorcoll Doc string in code.
authored
147 ;Reserve job.
148 ;:p out: output-port?
149 ;:p in: input-port?
150 ;:p timeout [#f]: integer?
151 ;:r: integer? string? or #f
c6d19c4 @ocorcoll Add source
authored
152 (define (reserve out in [timeout #f])
153 (if timeout
154 (fprintf out "reserve-with-timeout ~a\r\n" timeout)
155 (fprintf out "reserve\r\n"))
156 (flush-output out)
157 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
158 (if (string=? (first conf) "RESERVED")
159 (values (string->number(second conf))
160 (let ([str (read-string (+ (string->number (third conf)) 2) in)])
161 (substring str 0 (- (string-length str) 2))))
162 #f)))
163
36dbc2a @ocorcoll Doc string in code.
authored
164 ;Release job.
165 ;:p id: integer?
166 ;:p out: output-port?
167 ;:p in: input-port?
168 ;:p priority [100]: integer?
169 ;:p delay [0]: integer?
170 ;:r: #t or #f
c6d19c4 @ocorcoll Add source
authored
171 (define (release id out in [priority 100] [delay 0])
172 (fprintf out "release ~a ~a ~a\r\n" (number->string id) priority delay)
173 (flush-output out)
174 (if (string=? (read-line in 'return-linefeed) "RELEASED") #t #f))
175
36dbc2a @ocorcoll Doc string in code.
authored
176 ;Bury job.
177 ;:p id: integer?
178 ;:p out: output-port?
179 ;:p in: input-port?
180 ;:p priority [100]: integer?
181 ;:r: #t or #f
c6d19c4 @ocorcoll Add source
authored
182 (define (bury id out in [priority 100])
183 (fprintf out "bury ~a ~a\r\n" (number->string id) priority)
184 (flush-output out)
185 (if (string=? (read-line in 'return-linefeed) "BURIED") #t #f))
186
36dbc2a @ocorcoll Doc string in code.
authored
187 ;Touch job.
188 ;:p id: integer?
189 ;:p out: output-port?
190 ;:p in: input-port?
191 ;:r: #t or #f
c6d19c4 @ocorcoll Add source
authored
192 (define (touch id out in)
193 (fprintf out "touch ~a\r\n" (number->string id))
194 (flush-output out)
195 (if (string=? (read-line in 'return-linefeed) "TOUCHED") #t #f))
196
36dbc2a @ocorcoll Doc string in code.
authored
197 ;Delete job.
198 ;:p id: integer?
199 ;:p out: output-port?
200 ;:p in: input-port?
201 ;:r: #t or #f
c6d19c4 @ocorcoll Add source
authored
202 (define (delete id out in)
203 (fprintf out "delete ~a\r\n" (number->string id))
204 (flush-output out)
205 (if (string=? (read-line in 'return-linefeed) "DELETED") #t #f))
206
36dbc2a @ocorcoll Doc string in code.
authored
207 ;Kick job.
208 ;:p bound: integer?
209 ;:p out: output-port?
210 ;:p in: input-port?
211 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
212 (define (kick bound out in)
213 (fprintf out "kick ~a\r\n" (number->string bound))
214 (flush-output out)
215 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
216 (if (string=? (first conf) "KICKED")
217 (last conf)
218 #f)))
219
36dbc2a @ocorcoll Doc string in code.
authored
220 ;Stats of job.
221 ;:p id: integer?
222 ;:p out: output-port?
223 ;:p in: input-port?
224 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
225 (define (stats-job id out in)
226 (fprintf out "stats-job ~a\r\n" (number->string id))
227 (flush-output out)
228 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
229 (if (string=? (first conf) "OK")
230 (let ([str (read-string (+ (string->number (second conf)) 2) in)])
231 (substring str 0 (- (string-length str) 2)))
232 #f)))
233
36dbc2a @ocorcoll Doc string in code.
authored
234 ;Stats of tube.
235 ;:p tube: string?
236 ;:p out: output-port?
237 ;:p in: input-port?
238 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
239 (define (stats-tube tube out in)
240 (fprintf out "stats-tube ~a\r\n" tube)
241 (flush-output out)
242 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
243 (if (string=? (first conf) "OK")
244 (let ([str (read-string (+ (string->number (second conf)) 2) in)])
245 (substring str 0 (- (string-length str) 2)))
246 #f)))
36dbc2a @ocorcoll Doc string in code.
authored
247
248 ;Stats of queue.
249 ;:p out: output-port?
250 ;:p in: input-port?
251 ;:r: string? or #f
c6d19c4 @ocorcoll Add source
authored
252 (define (stats out in)
253 (fprintf out "stats\r\n")
254 (flush-output out)
255 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
256 (if (string=? (first conf) "OK")
257 (let ([str (read-string (+ (string->number (second conf)) 2) in)])
258 (substring str 0 (- (string-length str) 2)))
259 #f)))
260
36dbc2a @ocorcoll Doc string in code.
authored
261 ;Pause a tube.
262 ;:p tube: string?
263 ;:p delay: integer?
264 ;:p out: output-port?
265 ;:p in: input-port?
266 ;:r: #t or #f
c6d19c4 @ocorcoll Add source
authored
267 (define (pause-tube tube delay out in)
268 (fprintf out "pause-tube ~a ~a\r\n" tube delay)
269 (flush-output out)
270 (if (string=? (read-line in 'return-linefeed) "PAUSED") #t #f))
36dbc2a @ocorcoll Doc string in code.
authored
271
272 ;Peek job.
273 ;:p id: integer?
274 ;:p out: output-port?
275 ;:p in: input-port?
276 ;:r: integer? string? or #f
c6d19c4 @ocorcoll Add source
authored
277 (define (peek id out in)
36dbc2a @ocorcoll Doc string in code.
authored
278 (fprintf out "peek ~a\r\n" (number->string id))
c6d19c4 @ocorcoll Add source
authored
279 (flush-output out)
280 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
281 (if (string=? (first conf) "FOUND")
282 (values (string->number(second conf))
283 (let ([str (read-string (+ (string->number (third conf)) 2) in)])
284 (substring str 0 (- (string-length str) 2))))
285 #f)))
286
36dbc2a @ocorcoll Doc string in code.
authored
287 ;Peek ready job.
288 ;:p out: output-port?
289 ;:p in: input-port?
290 ;:r: integer? string? or #f
c6d19c4 @ocorcoll Add source
authored
291 (define (peek-ready out in)
292 (fprintf out "peek-ready\r\n")
293 (flush-output out)
294 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
295 (if (string=? (first conf) "FOUND")
296 (values (string->number(second conf))
297 (let ([str (read-string (+ (string->number (third conf)) 2) in)])
298 (substring str 0 (- (string-length str) 2))))
299 #f)))
300
36dbc2a @ocorcoll Doc string in code.
authored
301 ;Peek delayed job.
302 ;:p out: output-port?
303 ;:p in: input-port?
304 ;:r: integer? string? or #f
c6d19c4 @ocorcoll Add source
authored
305 (define (peek-delayed out in)
306 (fprintf out "peek-delayed\r\n")
307 (flush-output out)
308 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
309 (if (string=? (first conf) "FOUND")
310 (values (string->number(second conf))
311 (let ([str (read-string (+ (string->number (third conf)) 2) in)])
312 (substring str 0 (- (string-length str) 2))))
313 #f)))
314
36dbc2a @ocorcoll Doc string in code.
authored
315 ;Peek buried job.
316 ;:p out: output-port?
317 ;:p in: input-port?
318 ;:r: integer? string? or #f
c6d19c4 @ocorcoll Add source
authored
319 (define (peek-buried out in)
320 (fprintf out "peek-buried\r\n")
321 (flush-output out)
322 (let ([conf (regexp-split #rx" " (read-line in 'return-linefeed))])
323 (if (string=? (first conf) "FOUND")
324 (values (string->number(second conf))
325 (let ([str (read-string (+ (string->number (third conf)) 2) in)])
326 (substring str 0 (- (string-length str) 2))))
327 #f)))
5c8c943 @ocorcoll TODO's in README
authored
328 )
Something went wrong with that request. Please try again.