Overview
| Comment: | Added example of shell handling to sretrieve |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | filters-fix |
| Files: | files | file ages | folders |
| SHA1: |
a70e62a60bd40a9bacf9d96747e347ad |
| User & Date: | mrwellan on 2016-06-15 10:17:56 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-06-17
| ||
| 09:05 | Minor refactor on get-tests check-in: 9996ef5713 user: mrwellan tags: filters-fix | |
|
2016-06-15
| ||
| 10:17 | Added example of shell handling to sretrieve check-in: a70e62a60b user: mrwellan tags: filters-fix | |
|
2016-05-16
| ||
| 18:08 | Unfinished db changes for filters check-in: f903f42e57 user: mrwellan tags: filters-fix | |
Changes
Modified sretrieve.scm from [915dd04401] to [5fabfaebe0].
| ︙ | ︙ | |||
54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
(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?
cp <relative path> : copy file to current directory
log : get listing of recent downloads
Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest
Version: " megatest-fossil-hash)) ;; "
;;======================================================================
| > | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
(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?
cp <relative path> : copy file to current directory
log : get listing of recent downloads
shell : start a shell-like interface
Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest
Version: " megatest-fossil-hash)) ;; "
;;======================================================================
|
| ︙ | ︙ | |||
409 410 411 412 413 414 415 416 417 418 419 420 421 422 |
#f
(loop (car tal)(cdr tal)))))))
(define (sretrieve:stderr-print . args)
(with-output-to-port (current-error-port)
(lambda ()
(apply print args))))
;;======================================================================
;; MAIN
;;======================================================================
(define (sretrieve:load-config exe-dir exe-name)
(let* ((fname (conc exe-dir "/." exe-name ".config")))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 |
#f
(loop (car tal)(cdr tal)))))))
(define (sretrieve:stderr-print . args)
(with-output-to-port (current-error-port)
(lambda ()
(apply print args))))
;;======================================================================
;; SHELL
;;======================================================================
(define (toplevel-command . args) #f)
(define (sretrieve:shell)
(use readline)
(let* ((path '())
(prompt "> ")
(top-areas '("mrwellan" "pjhatwal" "bjbarcla" "ritikaag" "jmoon18"))
(iport (make-readline-port prompt)))
(install-history-file) ;; [homedir] [filename] [nlines])
(with-input-from-port iport
(lambda ()
(let loop ((inl (read-line)))
(if (not (or (eof-object? inl)
(equal? inl "exit")))
(let* ((parts (string-split inl))
(cmd (if (null? parts) #f (car parts))))
(if (not cmd)
(loop (read-line))
(case (string->symbol cmd)
((cd)
(if (> (length parts) 1) ;; have a parameter
(set! path (append path (string-split (cadr parts)))) ;; not correct for relative paths
(set! path '())))
((ls)
(let* ((thepath (if (> (length parts) 1) ;; have a parameter
(cdr parts)
path))
(plen (length thepath)))
(cond
((null? thepath)
(print (string-intersperse top-areas " ")))
((and (< plen 2)
(member (car thepath) top-areas))
(system (conc "ls /p/fdk/gwa/" (car thepath))))
(else ;; have a long path
;; check for access rights here
(system (conc "ls /p/fdk/gwa/" (string-intersperse thepath "/")))))))
(else
(print "Got command: " inl))))
(loop (read-line)))))))))
;;======================================================================
;; MAIN
;;======================================================================
(define (sretrieve:load-config exe-dir exe-name)
(let* ((fname (conc exe-dir "/." exe-name ".config")))
|
| ︙ | ︙ | |||
556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 |
((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)
| > > | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 |
((log)
(sretrieve:db-do configdat (lambda (db)
(print "Logs : ")
(query (for-each-row
(lambda (row)
(apply print (intersperse row " | "))))
(sql db "SELECT * FROM actions")))))
((shell)
(sretrieve:shell))
(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)
|