update_proposals.rkt 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178
  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 " list-accepted\t - Show accepted proposals.")
  26. (displayln " list-rejected\t - Show rejected proposals.")
  27. (displayln " help\t\t - Show this help message.")
  28. (newline)
  29. (displayln "Copyright 2019-2020, 2022 George C. Privon"))
  30. ; set up a condensed prompt for getting information
  31. (define (getinput prompt)
  32. (write-string prompt)
  33. (write-string ": ")
  34. (read-line))
  35. ; take an input result from the SQL search and write it out nicely
  36. (define (printentry entry issub)
  37. (displayln (string-append
  38. (number->string (vector-ref entry 0))
  39. ": "
  40. (vector-ref entry 1)
  41. "("
  42. (vector-ref entry 2)
  43. "; PI: "
  44. (vector-ref entry 4)
  45. (if (not issub)
  46. (string-append "; "
  47. (vector-ref entry 5))
  48. "")
  49. ") \""
  50. (vector-ref entry 3)
  51. "\"")))
  52. ; add a new proposal to the database
  53. (define (addnew conn)
  54. (displayln "Adding new proposal to database.")
  55. ; user inputs proposal data
  56. (define proptype (getinput "Proposal type"))
  57. (define org (getinput "Submitting organization"))
  58. (define solic (getinput "Solitation/call"))
  59. (define tele (getinput "Telescope"))
  60. (define title (getinput "Proposal title"))
  61. (define pi (getinput "PI"))
  62. (define coi (getinput "CoIs"))
  63. ; assume all these proposals are submitted, don't ask the user
  64. (define status "submitted")
  65. (define submitdate (getinput "Submit date (YYYY-MM-DD)"))
  66. (define oID (getinput "Organization's proposal ID"))
  67. ; do the INSERT into the Sqlite database
  68. (query-exec conn "INSERT INTO proposals (type, organization, solicitation, telescope, PI, title, CoI, status, submitdate, orgpropID) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
  69. proptype org solic tele pi title coi status submitdate oID))
  70. ; update an entry with new status (accepted, rejected, etc.)
  71. (define (update conn ID)
  72. (displayln (string-append "Updating entry " (number->string ID)))
  73. (define entry (query-maybe-row conn "SELECT * FROM proposals WHERE ID=?" ID))
  74. (cond
  75. [(eq? #f entry) (error "Invalid ID. Row not found")])
  76. (displayln (string-append "Current status is: "
  77. (vector-ref entry 9)
  78. " ("
  79. (vector-ref entry 10)
  80. ")"))
  81. (write-string "Please enter new status: ")
  82. (define newstatus (read-line))
  83. ;(write-string "Please enter date of updated status (leave blank to use current date): ")
  84. ;(define resdate (read-line))
  85. (define resdate (date->string (seconds->date (current-seconds))))
  86. ; now update that entry
  87. (query-exec conn "UPDATE proposals SET status=?, resultdate=? WHERE ID=?"
  88. newstatus
  89. resdate
  90. ID)
  91. (displayln "Entry updated."))
  92. ; retrieve and print proposals based on status
  93. (define (printprop conn
  94. #:submitted issub
  95. #:accepted [isaccept #f]
  96. #:rejected [isrej #f])
  97. (define selclause (string-append
  98. (if issub
  99. "status='submitted'"
  100. "status!='submitted'")
  101. ; find things that are "accepted" or "funded"
  102. (if isaccept
  103. " AND status LIKE '%Accepted%' OR status LIKE '%Funded%'"
  104. "")
  105. ; find things that are "rejected"
  106. (if isrej
  107. " AND status LIKE '%Rejected%'"
  108. "")))
  109. (define props (query-rows conn (string-append "SELECT ID,telescope,solicitation,title,PI,status FROM proposals WHERE "
  110. selclause)))
  111. (display (string-append (number->string (length props))))
  112. (if issub
  113. (displayln " pending proposals found.")
  114. (displayln " resolved proposals found."))
  115. (newline)
  116. ; print all the unresolved proposals to the screen
  117. (map (lambda (prop)
  118. (printentry prop issub))
  119. props))
  120. ; find proposals waiting for updates
  121. (define (findpending conn)
  122. (write-string "Updating proposals. ")
  123. (printprop conn #:submitted #t)
  124. (write-string "Please enter a proposal number to edit (enter 0 or nothing to exit): ")
  125. (define upID (read-line))
  126. (cond
  127. [(eq? (string->number upID) 0) (exit)]
  128. [(string->number upID) (update conn (string->number upID))]
  129. [else (exit)]))
  130. ; make sure we can use the sqlite3 connection
  131. (define checkdblib
  132. (cond (not (sqlite3-available?))
  133. (error "Sqlite3 library not available.")))
  134. ; catch-all routine for when we need to access the database
  135. (define (querysys mode)
  136. ; first see if we need write access or if we can use read only
  137. (define dbmode (if (or (regexp-match "add" mode)
  138. (regexp-match "update" mode))
  139. 'read/write
  140. 'read-only))
  141. ; open the database with the specified mode
  142. (define conn (sqlite3-connect #:database dbloc
  143. #:mode dbmode))
  144. ; now handle the user's request
  145. (cond
  146. [(regexp-match "add" mode) (addnew conn)]
  147. [(regexp-match "update" mode) (findpending conn)]
  148. [(regexp-match "list-open" mode) (printprop conn #:submitted #t)]
  149. [(regexp-match "list-closed" mode) (printprop conn #:submitted #f)]
  150. [(regexp-match "list-accepted" mode) (printprop conn #:submitted #f #:accepted #t)]
  151. [(regexp-match "list-rejected" mode) (printprop conn #:submitted #f #:rejected #t)]
  152. [else (error (string-append "Unknown mode. Try " progname " help\n\n"))])
  153. ; close the databse
  154. (disconnect conn))
  155. ; First see if the user wants help or if we need to pass to one of the other
  156. ; procedures
  157. (cond
  158. [(regexp-match "help" mode) (printhelp)]
  159. [else (querysys mode)])