PageRenderTime 55ms CodeModel.GetById 29ms RepoModel.GetById 0ms app.codeStats 0ms

/vpl2/error-extraction.lisp

https://bitbucket.org/mt/biobike
Lisp | 124 lines | 109 code | 11 blank | 4 comment | 6 complexity | 1c14dce2df8a4c32def808ba01e27d4c MD5 | raw file
Possible License(s): LGPL-2.1, BSD-3-Clause
  1. (in-package :vpl)
  2. ;;; Finds error messages in all the log files in a given directory
  3. ;;; and writes them out to a file in the same directory called vpl-errors.txt.
  4. (defun extract-all-vpl-errors (usersdir)
  5. (loop for thing in (directory usersdir)
  6. do
  7. (handler-case
  8. (let* ((p (pathname thing))
  9. (pd (pathname-directory (utils::s+ p "/")))
  10. (namestring (utils::lastelem pd)))
  11. (print namestring)
  12. (vpl::extract-vpl-log-errors-from-user namestring))
  13. (error () nil)
  14. )))
  15. (defvar *current-log-file* nil)
  16. (defun extract-vpl-log-errors-from-user (user)
  17. (extract-vpl-log-errors-from-directory (wb::user-logs-directory user)))
  18. (defun extract-vpl-log-errors-from-directory
  19. (dir &optional (outfile "vpl-errors.txt"))
  20. (let ((filepath (merge-pathnames outfile dir)))
  21. (with-open-file (out filepath :direction :output :if-exists :supersede)
  22. (formatt "~%Processing log files in directory ~A~%" (namestring dir))
  23. (formatt "~%Writing errors to error file ~A~%" (namestring filepath))
  24. (let ((files (directory-with-subdirs-in-directory-form dir)))
  25. (format out ";;; Errors found from logs in ~A~%~%" (namestring dir))
  26. ;; Get rid of anything that isn't a log file
  27. (setq files
  28. (remove-if
  29. (lambda (file)
  30. (or (pathname-names-directory? file)
  31. (null (is-log-file? file))))
  32. files
  33. ))
  34. ;; Sort the files by write date most recent first
  35. (setq files (sort files '> :key 'file-write-date))
  36. (loop for file in files do
  37. (formatt " ~A...~%" (file-namestring file))
  38. (let ((errors (extract-vpl-errors-from-log file)))
  39. (when errors
  40. (format out "~%;; Errors found in log file ~A~%~%"
  41. (file-namestring file)
  42. ))
  43. (loop for error in errors do
  44. (loop for line in error do
  45. (format out "~A~%" line))
  46. (format out ";;; ----------~%")
  47. )))))))
  48. (defun extract-vpl-errors-from-log (log-file)
  49. (let* ((lines (coerce (file-to-string-list log-file) 'vector))
  50. (nlines (length lines))
  51. (line-count 0)
  52. (errors nil)
  53. (*current-log-file* log-file))
  54. (loop until (>= line-count nlines)
  55. do
  56. (vif (error-type (line-contains-vpl-error? (aref lines line-count)))
  57. (multiple-value-bind (error-lines new-line-count)
  58. (funcall
  59. (ecase error-type
  60. (:vpl-interface-error 'extract-vpl-interface-error)
  61. (:evaluation-error 'extract-evaluation-error)
  62. )
  63. lines line-count)
  64. (push error-lines errors)
  65. (setq line-count new-line-count)
  66. )
  67. (incf line-count)
  68. ))
  69. (reverse errors)
  70. ))
  71. (defun extract-vpl-interface-error (lines line-count)
  72. (block exit
  73. (loop for j from (1+ line-count) below (length lines) do
  74. (let ((line (aref lines j)))
  75. (when (log-line? line)
  76. (return-from exit
  77. (values
  78. (coerce (subseq lines line-count j) 'list)
  79. j
  80. )))))
  81. (return-from exit
  82. (values
  83. (coerce (subseq lines line-count) 'list)
  84. (length lines)
  85. ))))
  86. (defun extract-evaluation-error (lines line-count)
  87. (let ((uplines
  88. (block exit
  89. (loop for j from (1- line-count) downto 0 do
  90. (when (search ": Form: " (aref lines j))
  91. (return-from exit
  92. (coerce (subseq lines j line-count) 'list)
  93. )))
  94. (error "No form found above evaluation error in ~A!!"
  95. *current-log-file*
  96. ))))
  97. (multiple-value-bind (downlines next-line-count)
  98. (extract-vpl-interface-error lines line-count)
  99. (values (append uplines downlines) next-line-count)
  100. )))
  101. (defun line-contains-vpl-error? (line)
  102. (cond
  103. ((search "Error message: " line) :evaluation-error)
  104. ((search "Vpl interface error:" line) :vpl-interface-error)
  105. (t nil)
  106. ))
  107. (defun log-line? (line)
  108. (and (> (length line) 8)
  109. (digit-char-p (aref line 0))
  110. (digit-char-p (aref line 1))
  111. (char= (aref line 2) #\/)
  112. ))
  113. (defun is-log-file? (pathname) (string-equal "log" (pathname-type pathname)))