44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
(include "megatest-fossil-hash.scm")
;;
;; GLOBALS
;;
(define *verbosity* 1)
(define *logging* #f)
(define *sretrieve:current-tab-number* 0)
(define *args-hash* (make-hash-table))
(define sretrieve:help (conc "Usage: sretrieve [action [params ...]]
ls : list contents of target area
get <relversion> : retrieve data for release <version>
-m \"message\" : why retrieved?
log : get listing of recent downloads
|
|
|
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
(include "megatest-fossil-hash.scm")
;;
;; GLOBALS
;;
(define *verbosity* 1)
(define *logging* #f)
(define *exe-name* (pathname-file (car (argv))))
(define *sretrieve:current-tab-number* 0)
(define *args-hash* (make-hash-table))
(define sretrieve:help (conc "Usage: " *exe-name* " [action [params ...]]
ls : list contents of target area
get <relversion> : retrieve data for release <version>
-m \"message\" : why retrieved?
log : get listing of recent downloads
|
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(if (not path)
(begin
(debug:print 0 "[database]\nlocation /some/path\n\n Is missing from the config file!")
(exit 1)))
(if (and path
(directory? path)
(file-read-access? path))
(let* ((dbpath (conc path "/sretrieve.db"))
(writeable (file-write-access? dbpath))
(dbexists (file-exists? dbpath)))
(handle-exceptions
exn
(begin
(debug:print 2 "ERROR: problem accessing db " dbpath
((condition-property-accessor 'exn 'message) exn))
|
|
|
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(if (not path)
(begin
(debug:print 0 "[database]\nlocation /some/path\n\n Is missing from the config file!")
(exit 1)))
(if (and path
(directory? path)
(file-read-access? path))
(let* ((dbpath (conc path "/" *exe-name* ".db"))
(writeable (file-write-access? dbpath))
(dbexists (file-exists? dbpath)))
(handle-exceptions
exn
(begin
(debug:print 2 "ERROR: problem accessing db " dbpath
((condition-property-accessor 'exn 'message) exn))
|
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
|
(print "Files in " base-dir)
(sretrieve:do-as-calling-user
(lambda ()
(process-execute "/bin/ls" (list base-dir)))))
(print "ERROR: No base dir specified!"))))
((log)
(sretrieve:db-do configdat (lambda (db)
(print "Listing actions")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
(sql db "SELECT * FROM actions")))))
(else
(print "ERROR: Unrecognised command. Try \"sretrieve help\""))))
;; multi-word commands
((null? rema)(print sretrieve:help))
((>= (length rema) 2)
(apply sretrieve:process-action configdat (car rema)(cdr rema)))
(else (debug:print 0 "ERROR: Unrecognised command. Try \"sretrieve help\"")))))
(main)
|
|
|
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
|
(print "Files in " base-dir)
(sretrieve:do-as-calling-user
(lambda ()
(process-execute "/bin/ls" (list base-dir)))))
(print "ERROR: No base dir specified!"))))
((log)
(sretrieve:db-do configdat (lambda (db)
(print "Logs : ")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
(sql db "SELECT * FROM actions")))))
(else
(print "ERROR: Unrecognised command. Try \"sretrieve help\""))))
;; multi-word commands
((null? rema)(print sretrieve:help))
((>= (length rema) 2)
(apply sretrieve:process-action configdat (car rema)(cdr rema)))
(else (debug:print 0 "ERROR: Unrecognised command. Try \"sretrieve help\"")))))
(main)
|