| ;; -*- lexical-binding: t -*- |
| |
| ;; Copyright 2020 The Chromium OS Authors. All rights reserved. |
| ;; Use of this source code is governed by a BSD-style license that can be |
| ;; found in the LICENSE file. |
| (require 'request) |
| (require 'xml) |
| |
| ;; TODO this is test code to be removed in future CL. |
| ;; The following will become user configuration options. |
| (setq test-user "aaronmassey@chromium.org") |
| (setq test-host "chromium-review.googlesource.com") |
| (setq test-repo-root (file-name-as-directory "~/chromiumos")) |
| (setq test-repo-manifest-path (expand-file-name ".repo/manifests/default.xml" test-repo-root)) |
| ;; TODO Make our parser self-discoverable by project instead of a parameter. |
| (setq test-manifest-parser (expand-file-name "src/platform/dev/contrib/emacs/manifest_parser" |
| test-repo-root)) |
| (defun gerrit--test-init-all () |
| (gerrit--init-global-comment-map test-host test-user) |
| (gerrit--init-global-repo-project-path-map test-manifest-parser test-repo-manifest-path)) |
| |
| |
| (defvar gerrit--change-to-filepath-comments nil |
| "Map containing with change => filepath => comments. |
| filepath is from git project root, for the given change.") |
| |
| |
| (defvar gerrit--project-branch-pair-to-projectpath nil |
| "Map showing relative path from repo root to project. |
| Is of the form (project . dest-branch) => path-from-repo-root.") |
| |
| |
| (cl-defun gerrit--fetch-recent-changes (host user &optional (count 3)) |
| "Fetches recent changes as ChangeInfo entities. |
| host - Gerrit server address |
| user - the user who owns the recent changes |
| count (optional) - the number of recent changes, default is 3 |
| Fetch recent changes that are not abandoned/merged, and |
| thus are actionable, returns an array of hashtables that |
| represent Gerrit ChangeInfo entities." |
| (request-response-data |
| (request |
| (format "https://%s/changes/" host) |
| ;; We don't use "status:reviewed" because that only counts reviews after latest patch, |
| ;; but we may want reviews before the latest patch too. |
| :params `(("q" . ,(format "owner:%s status:open" user)) |
| ("n" . ,(format "%d" count))) |
| :sync t |
| :parser 'gerrit--request-response-json-parser))) |
| |
| |
| (defun gerrit--request-response-json-parser () |
| "Response parsing callback for use with request.el |
| parses Gerrit response json payload by removing the |
| embedded XSS protection string before using a real json parser." |
| (json-parse-string (replace-regexp-in-string "^[[:space:]]*)]}'" "" (buffer-string)))) |
| |
| |
| (defun gerrit--fetch-unresolved-comments (host change) |
| "Gets recent unresolved comments for open Gerrit CLs. |
| Returns a map of the form path => sequence of comments, |
| where path is the filepath from the gerrit project root |
| and each comment represents a CommentInfo entity from Gerrit" |
| (let* ((response |
| (request |
| (format "https://%s/changes/%s~master~%s/comments" |
| host |
| (url-hexify-string (gethash "project" change)) |
| (gethash "change_id" change)) |
| :sync t |
| :parser 'gerrit--request-response-json-parser)) |
| (out-map (request-response-data response))) |
| ;; We only want the user to see unresolved comments. |
| (loop for key in (hash-table-keys out-map) do |
| ;; We explicitly check if not true because the value may be ':false' |
| ;; which is technically evals to true as it is not nil. |
| (delete-if (lambda (comment) (not (eql t (gethash "unresolved" comment)))) |
| (gethash key out-map))) |
| out-map)) |
| |
| |
| (defun gerrit--fetch-change-to-file-to-unresolved-comments (host user) |
| "Returns a map of maps of the form: |
| change => filepath => array(CommentInfo Map), |
| where filepath is from the nearest git root for a file. |
| Only fetches recent changes for open CLs." |
| (let ((out-map (make-hash-table :test 'equal))) |
| (loop for change across (gerrit--fetch-recent-changes host user) do |
| (setf (gethash change out-map) |
| (gerrit--fetch-unresolved-comments host change))) |
| out-map)) |
| |
| |
| (defun gerrit--init-global-comment-map (host user) |
| "Inits `gerrit--change-to-filepath-comments`." |
| (setf gerrit--change-to-filepath-comments |
| (gerrit--fetch-change-to-file-to-unresolved-comments |
| host user))) |
| |
| |
| (cl-defun gerrit--project-branch-pair-to-path-map (path-to-manifest-parser-exec abs-path-to-manifest) |
| "Return map (project . dest-branch) => path-from-repo-root. |
| Parses the manifest given manifest file using the given parser executable. |
| Assumes that stdout of parser is a Lisp alist of the form: |
| ((project . dest-branch) . path-from-repo-root)." |
| (let (parsed-alist |
| (output (make-hash-table :test 'equal)) |
| (tmp-buffer-name "*gerrit-temp--buffer*")) |
| |
| (when (get-buffer tmp-buffer-name) |
| (kill-buffer tmp-buffer-name)) |
| |
| (unless (= 0 (call-process path-to-manifest-parser-exec |
| nil |
| tmp-buffer-name |
| nil |
| abs-path-to-manifest)) |
| (message "Error parsing manifest file investigate %s" tmp-buffer-name) |
| (cl-return-from gerrit--project-branch-pair-to-path-map nil)) |
| |
| (save-excursion |
| (set-buffer tmp-buffer-name) |
| (goto-char (point-min)) |
| (setf parsed-alist (read (current-buffer))) |
| (kill-buffer tmp-buffer-name)) |
| |
| (loop for item in parsed-alist do |
| (setf (gethash (car item) output) (cdr item))) |
| |
| output)) |
| |
| |
| (defun gerrit--init-global-repo-project-path-map (path-to-manifest-parser-exec |
| abs-path-to-manifest) |
| "Initializes `gerrit--project-branch-pair-to-projectpath`." |
| ;; Here we use Python expat sax parser as it's considerably faster. |
| (setf gerrit--project-branch-pair-to-projectpath (gerrit--project-branch-pair-to-path-map |
| path-to-manifest-parser-exec |
| abs-path-to-manifest))) |
| |
| |
| (defun gerrit--get-abs-path-to-file (filepath-from-project-git-root |
| project-branch-pair |
| abs-path-to-repo-root) |
| "Returns full system path of the first argument. |
| `gerrit--project-branch-pair-to-projectpath` must be initialized." |
| (expand-file-name |
| filepath-from-project-git-root |
| (directory-file-name |
| (expand-file-name |
| (gethash (cons (gethash "project" project-branch-pair) |
| (gethash "branch" project-branch-pair)) |
| gerrit--project-branch-pair-to-projectpath) |
| abs-path-to-repo-root)))) |
| |
| |
| (provide 'repo-gerrit) |