sergiodj/sponsor-debian-pkg
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix several things

Browse source 
- Variable names were wrong.

- Improve error checking for invalid inputs.

- Improve user questions.
This commit is contained in:
Sergio Durigan Junior 2024-03-31 21:19:58 -04:00
parent ca697024fd
commit 8d662ee833
Signed by: sergiodj
GPG key ID: D0EB762865FC5E36
1 changed files with 41 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
sponsor-debian-pkg.el
View file

@ -42,11 +42,11 @@ ever commented on those issues.
Return an alist of (user . username)." Return an alist of (user . username)."
(let* ((debian-bsb-users (plz 'get (let* ((debian-bsb-users (plz 'get
(concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url (concat sdj/sponsor-debian-pkg-salsa-api-url
"projects/" "projects/"
(url-hexify-string "debian-brasilia-team/docs") (url-hexify-string "debian-brasilia-team/docs")
"/issues?per_page=100&order_by=updated_at") "/issues?per_page=100&order_by=updated_at")
:headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
:timeout 60 :timeout 60
:connect-timeout 60 :connect-timeout 60
:as #'json-read))) :as #'json-read)))
@ -76,14 +76,14 @@ Return an alist of (team . id)."
"Return the full URL for an API endpoint ending with 'NAME'. "Return the full URL for an API endpoint ending with 'NAME'.
The endpoint will always end with a slash." The endpoint will always end with a slash."
(concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url name "/")) (concat sdj/sponsor-debian-pkg-salsa-api-url name "/"))
(defun sdj/sponsor-debian-pkg--generate-team-candidates () (defun sdj/sponsor-debian-pkg--generate-team-candidates ()
"Generate a list of candidates for team names. "Generate a list of candidates for team names.
The generated list is actually a list of namespaces the user is a member of." The generated list is actually a list of namespaces the user is a member of."
(plz 'get (sdj/sponsor-debian-pkg--api-endpoint "namespaces") (plz 'get (sdj/sponsor-debian-pkg--api-endpoint "namespaces")
:headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
:as #'sdj/sponsor-debian-pkg--parse-teams)) :as #'sdj/sponsor-debian-pkg--parse-teams))
(defun sdj/sponsor-debian-pkg--team-repo-exists-p (team repo) (defun sdj/sponsor-debian-pkg--team-repo-exists-p (team repo)
@ -122,7 +122,7 @@ needed."
If 'IMPORT-REPOURL' is provided, use it as the initial import." If 'IMPORT-REPOURL' is provided, use it as the initial import."
(plz 'post (sdj/sponsor-debian-pkg--api-endpoint "projects") (plz 'post (sdj/sponsor-debian-pkg--api-endpoint "projects")
:headers `(("Content-Type" . "application/json") :headers `(("Content-Type" . "application/json")
("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) ("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
:body (json-encode :body (json-encode
(delete nil (delete nil
`(("name" . ,projname) `(("name" . ,projname)
@ -160,8 +160,8 @@ create the repository."
(defun sdj/sponsor-debian-pkg--confirm-username (user) (defun sdj/sponsor-debian-pkg--confirm-username (user)
"Confirm if 'USER' exists." "Confirm if 'USER' exists."
(let ((u (plz 'get (let ((u (plz 'get
(concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url "users?username=" (url-hexify-string user)) (concat sdj/sponsor-debian-pkg-salsa-api-url "users?username=" (url-hexify-string user))
:headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
:as #'json-read))) :as #'json-read)))
(and (not (seq-empty-p u)) user))) (and (not (seq-empty-p u)) user)))
@ -171,27 +171,35 @@ create the repository."
Note that internally teams are actually treated as namespaces." Note that internally teams are actually treated as namespaces."
(condition-case err (condition-case err
(let ((u (plz 'get (let ((u (plz 'get
(concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url "namespaces/" (url-hexify-string team)) (concat sdj/sponsor-debian-pkg-salsa-api-url "namespaces/" (url-hexify-string team))
:headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token)) :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
:as #'json-read))) :as #'json-read)))
(and (not (seq-empty-p u)) (cons team (alist-get 'id u)))) (and (not (seq-empty-p u)) (cons team (alist-get 'id u))))
(plz-error nil))) (plz-error nil)))
(defun sdj/sponsor-debian-pkg--read-sponsoree-choice () (defun sdj/sponsor-debian-pkg--read-sponsoree-choice (&optional optional)
"Read the sponsoree." "Read the sponsoree."
(let* ((sponsoreealist (sdj/sponsor-debian-pkg--generate-sponsoree-candidates)) (let* ((sponsoreealist (sdj/sponsor-debian-pkg--generate-sponsoree-candidates))
(sponsoreechoice (completing-read "Sponsoree: " sponsoreealist))) (sponsoreechoice (completing-read (concat (when optional "(optional) ")
(or (alist-get sponsoreechoice sponsoreealist nil nil #'string=) "Sponsoree: ") sponsoreealist)))
(sdj/sponsor-debian-pkg--confirm-username sponsoreechoice)))) (if sponsoreechoice
(or (alist-get sponsoreechoice sponsoreealist nil nil #'string=)
(sdj/sponsor-debian-pkg--confirm-username sponsoreechoice))
(unless optional
(error "You must specify a sponsoree")))))
(defun sdj/sponsor-debian-pkg--read-team-choice (&optional dontask-p) (defun sdj/sponsor-debian-pkg--read-team-choice (&optional dontask-p optional)
"Read the team." "Read the team."
(when (or dontask-p (when (or dontask-p
(y-or-n-p "Would you like to specify a team? ")) (y-or-n-p (concat (when optional "(optional) ")
"Would you like to specify a team? " )))
(let* ((teamalist (sdj/sponsor-debian-pkg--generate-team-candidates)) (let* ((teamalist (sdj/sponsor-debian-pkg--generate-team-candidates))
(teamchoice (completing-read "Team: " teamalist nil t))) (teamchoice (completing-read "Team: " teamalist nil t)))
(cons teamchoice (if teamchoice
(alist-get teamchoice teamalist nil nil #'string=))))) (cons teamchoice
(alist-get teamchoice teamalist nil nil #'string=))
(unless optional
(error "You must specify a team"))))))
(defun sdj/sponsor-debian-pkg--read-string-or-nil (prompt) (defun sdj/sponsor-debian-pkg--read-string-or-nil (prompt)
"Read a string from the minibuffer or nil." "Read a string from the minibuffer or nil."
@ -199,19 +207,23 @@ Note that internally teams are actually treated as namespaces."
(unless (string-empty-p r) (unless (string-empty-p r)
r))) r)))
(defun sdj/sponsor-debian-pkg--read-repourl (&optional prompt) (defun sdj/sponsor-debian-pkg--read-repourl (&optional prompt optional)
"Read a repository URL." "Read a repository URL."
(let ((r (sdj/sponsor-debian-pkg--read-string-or-nil (or prompt (let ((r (sdj/sponsor-debian-pkg--read-string-or-nil
"Repository URL: ")))) (concat (when optional "(optional) ")
(when r (or prompt
(string-remove-suffix "/" r)))) "Repository URL: ")))))
(if r
(string-remove-suffix "/" r)
(unless optional
(error "You must specify a repository URL")))))
(defun sdj/sponsor-debian-pkg--get-namespace-from-repourl (repourl) (defun sdj/sponsor-debian-pkg--get-namespace-from-repourl (repourl)
"Given a repository URL 'REPOURL', return its namespace." "Given a repository URL 'REPOURL', return its namespace."
(let ((str-no-url (or (and (string-prefix-p "git@salsa.debian.org:" repourl) (when-let ((str-no-url (or (and (string-prefix-p "git@salsa.debian.org:" repourl)
(string-remove-prefix "git@salsa.debian.org:" repourl)) (string-remove-prefix "git@salsa.debian.org:" repourl))
(and (string-prefix-p "https://salsa.debian.org/" repourl) (and (string-prefix-p "https://salsa.debian.org/" repourl)
(string-remove-prefix "https://salsa.debian.org/" repourl))))) (string-remove-prefix "https://salsa.debian.org/" repourl)))))
(string-remove-suffix (string-remove-suffix
"/" "/"
(string-remove-prefix (string-remove-prefix
@ -246,7 +258,7 @@ Return an alist of (ID . DATA), where 'ID' is either 'username or
(result (sdj/sponsor-debian-pkg--what-is-this-namespace namespace)) (result (sdj/sponsor-debian-pkg--what-is-this-namespace namespace))
(team (or (and (eq (car result) 'team) (team (or (and (eq (car result) 'team)
(cdr result)) (cdr result))
(sdj/sponsor-debian-pkg--read-team-choice))) (sdj/sponsor-debian-pkg--read-team-choice nil t)))
(sponsoree (or (and (eq (car result) 'username) (sponsoree (or (and (eq (car result) 'username)
(cdr result)) (cdr result))
(sdj/sponsor-debian-pkg--read-sponsoree-choice)))) (sdj/sponsor-debian-pkg--read-sponsoree-choice))))
@ -270,7 +282,7 @@ initial repository."
(when sponsoree-repourl (when sponsoree-repourl
(when-let* ((sponsoree (sdj/sponsor-debian-pkg--get-namespace-from-repourl sponsoree-repourl)) (when-let* ((sponsoree (sdj/sponsor-debian-pkg--get-namespace-from-repourl sponsoree-repourl))
(sponsoreedir (file-name-as-directory (sponsoreedir (file-name-as-directory
(concat sdj/sponsor-debian-pkg-debian-pkg-path sponsoree))) (concat sdj/sponsor-debian-pkg-path sponsoree)))
(projdir (file-name-as-directory (projdir (file-name-as-directory
(concat sponsoreedir projname))) (concat sponsoreedir projname)))
(team-gitdir (file-name-as-directory (team-gitdir (file-name-as-directory
@ -300,7 +312,7 @@ initial repository."
(error "You must provide a valid sponsoree name and a repository URL")) (error "You must provide a valid sponsoree name and a repository URL"))
(let* ((projname (sdj/sponsor-debian-pkg--get-project-from-repourl repo)) (let* ((projname (sdj/sponsor-debian-pkg--get-project-from-repourl repo))
(sponsoreedir (file-name-as-directory (sponsoreedir (file-name-as-directory
(concat sdj/sponsor-debian-pkg-debian-pkg-path sponsoree))) (concat sdj/sponsor-debian-pkg-path sponsoree)))
(projdir (file-name-as-directory (projdir (file-name-as-directory
(concat sponsoreedir projname))) (concat sponsoreedir projname)))
(repo-is-private-p (string-search (concat "/" sponsoree "/") repo)) (repo-is-private-p (string-search (concat "/" sponsoree "/") repo))