update_proposals.rkt 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143
  1. #lang racket/base
  2. ;; This program updates an entry in a proposals database.
  3. (require racket/cmdline
  4. racket/date
  5. db
  6. "config.rkt") ; load configuration file
  7. (define progname "update_proposals.rkt")
  8. ; give us the date in YYYY-MM-DD format
  9. (date-display-format 'iso-8601)
  10. ; set up command line arguments
  11. (define mode (command-line
  12. #:program "update_proposals"
  13. #:args ([updatetype "help"]) ; (add, update, list-open, list-closed, help)
  14. updatetype))
  15. ; print some help
  16. (define (printhelp)
  17. (displayln (string-append "Usage: "
  18. progname " MODE"))
  19. (newline)
  20. (displayln "Where MODE is one of:")
  21. (displayln " add\t\t - add new proposal to database.")
  22. (displayln " update\t\t - update a proposal with results.")
  23. (displayln " list-open\t - Show all submitted (but not resolved) proposals.")
  24. (displayln " list-closed\t - Show all resolved proposals.")
  25. (displayln " help\t\t - Show this help message.")
  26. (newline)
  27. (displayln "Copyright 2019-2020 George C. Privon"))
  28. ; set up a condensed prompt for getting information
  29. (define (getinput prompt)
  30. (write-string prompt)
  31. (write-string ": ")
  32. (read-line))
  33. ; take an input result from the SQL search and write it out nicely
  34. (define (printentry entry)
  35. (displayln (string-append
  36. (number->string (vector-ref entry 0))
  37. ": "
  38. (vector-ref entry 1)
  39. "("
  40. (vector-ref entry 2)
  41. "; PI: "
  42. (vector-ref entry 4)
  43. ") \""
  44. (vector-ref entry 3)
  45. "\"")))
  46. ; add a new proposal to the database
  47. (define (addnew)
  48. (displayln "Adding new proposal to database.")
  49. ; user inputs proposal data
  50. (define proptype (getinput "Proposal type"))
  51. (define org (getinput "Submitting organization"))
  52. (define solic (getinput "Solitation/call"))
  53. (define tele (getinput "Telescope"))
  54. (define title (getinput "Proposal title"))
  55. (define pi (getinput "PI"))
  56. (define coi (getinput "CoIs"))
  57. ; assume all these proposals are submitted, don't ask the user
  58. (define status "submitted")
  59. (define submitdate (getinput "Submit date (YYYY-MM-DD)"))
  60. (define oID (getinput "Organization's proposal ID"))
  61. ; do the INSERT into the Sqlite database
  62. (query-exec conn "INSERT INTO proposals (type, organization, solicitation, telescope, PI, title, CoI, status, submitdate, orgpropID) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
  63. proptype org solic tele pi title coi status submitdate oID))
  64. ; update an entry with new status (accepted, rejected, etc.)
  65. (define (update ID)
  66. (displayln (string-append "Updating entry " (number->string ID)))
  67. (define entry (query-maybe-row conn "SELECT * FROM proposals WHERE ID=?" ID))
  68. (cond
  69. [(eq? #f entry) (error "Invalid ID. Row not found")])
  70. (displayln (string-append "Current status is: "
  71. (vector-ref entry 9)
  72. " ("
  73. (vector-ref entry 10)
  74. ")"))
  75. (write-string "Please enter new status: ")
  76. (define newstatus (read-line))
  77. ;(write-string "Please enter date of updated status (leave blank to use current date): ")
  78. ;(define resdate (read-line))
  79. (define resdate (date->string (seconds->date (current-seconds))))
  80. ; now update that entry
  81. (query-exec conn "UPDATE proposals SET status=?, resultdate=? WHERE ID=?"
  82. newstatus
  83. resdate
  84. ID)
  85. (displayln "Entry updated."))
  86. ; retrieve and print the proposals whose status is still listed as "submitted"
  87. (define (printopen)
  88. (define unfinished (query-rows conn "SELECT ID,telescope,solicitation,title,PI FROM proposals WHERE status='submitted'"))
  89. (displayln (string-append (number->string (length unfinished)) " pending proposals found."))
  90. (newline)
  91. ; print all the unresolved proposals to the screen
  92. (map printentry unfinished))
  93. ; retrieve and print the proposals whose status are not listed as "submitted"
  94. (define (printclosed)
  95. (define finished (query-rows conn "SELECT ID,telescope,solicitation,title,PI FROM proposals WHERE status!='submitted'"))
  96. (displayln (string-append (number->string (length finished)) " resolved proposals found."))
  97. (newline)
  98. ; print all the unresolved proposals to the screen
  99. (map printentry finished))
  100. ; find proposals waiting for updates
  101. (define (findpending)
  102. (write-string "Updating proposals")
  103. (printopen)
  104. (write-string "Please enter a proposal number to edit (enter 0 or nothing to exit): ")
  105. (define upID (read-line))
  106. (cond
  107. [(eq? (string->number upID) 0) (exit)]
  108. [(string->number upID) (update (string->number upID))]
  109. [else (exit)]))
  110. ; make sure we can use the sqlite3 connection
  111. (cond (not (sqlite3-available?))
  112. (error "Sqlite3 library not available."))
  113. ; open the database file
  114. (define conn (sqlite3-connect #:database dbloc))
  115. ; determine which mode we're in
  116. (cond
  117. [(regexp-match "help" mode) (printhelp)]
  118. [(regexp-match "add" mode) (addnew)]
  119. [(regexp-match "update" mode) (findpending)]
  120. [(regexp-match "list-open" mode) (printopen)]
  121. [(regexp-match "list-closed" mode) (printclosed)]
  122. [else (error (string-append "Unknown mode. Try " progname " help\n\n"))])
  123. ; close the databse
  124. (disconnect conn)