sponsor-debian.el

@@ -1,4 +1,4 @@
-;;; sponsor-debian-pkg.el --- Make it easy to sponsor packages on Debian.
+;;; sponsor-debian.el --- Make it easy to sponsor packages on Debian.
 ;;;
 ;;; Commentary:
 ;;;
@@ -33,7 +33,22 @@
   :group 'sdj/sponsor-debian-pkg
   :type 'string)
 
-(defun sdj/sponsor-debian-pkg--generate-sponsoree-candidates ()
+(defun sdj/sponsor--generate-sponsoree-candidates-from-dir ()
+  "Generate a list of sponsoree candidates from the contents of 'sdj/sponsor-debian-pkg-path'.
+
+The idea is that each directory name inside that path corresponds
+to a salsa.d.o username."
+  (flatten-tree
+   (mapcar
+    (lambda (e)
+      (let ((dirname (car e)))
+	(when (and (nth 2 e)
+		   ; Exclude "." and ".." from the list
+		   (not (seq-contains-p '("." "..") dirname)))
+	  dirname)))
+    (directory-files-and-attributes sdj/sponsor-debian-pkg-path))))
+
+(defun sdj/sponsor--generate-sponsoree-candidates ()
   "Generate a list of sponsoree candidates from salsa.d.o.
 
 The idea is to query Debian Brasilia's 'docs' project, obtain a
@@ -42,11 +57,11 @@ ever commented on those issues.
 
 Return an alist of (user . username)."
   (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/"
 				     (url-hexify-string "debian-brasilia-team/docs")
 				     "/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
 			     :connect-timeout 60
 			     :as #'json-read)))
@@ -59,7 +74,7 @@ Return an alist of (user . username)."
 		 (cons (format "%s (%s)" name username) username)))
 	     debian-bsb-users))))
 
-(defun sdj/sponsor-debian-pkg--parse-teams ()
+(defun sdj/sponsor--parse-teams ()
   "Parse a JSON representation of all teams which we are subscribed to.
 
 Return an alist of (team . id)."
@@ -72,25 +87,18 @@ Return an alist of (team . id)."
 	  (cons (alist-get 'full_path e) (alist-get 'id e))))
       parsedteams))))
 
-(defun sdj/sponsor-debian-pkg--api-endpoint (name)
+(defun sdj/sponsor--api-endpoint (name)
-  "Return the full URL for an API endpoint ending with 'NAME'.
+  (concat sdj/sponsor-debian-pkg-salsa-api-url name "/"))
 
-The endpoint will always end with a slash."
+(defun sdj/sponsor--generate-team-candidates ()
-  (concat sdj/sponsor-debian-pkg-debian-pkg-salsa-api-url name "/"))
+  (plz 'get (sdj/sponsor--api-endpoint "namespaces")
+    :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-salsa-api-token))
+    :as #'sdj/sponsor--parse-teams))
 
-(defun sdj/sponsor-debian-pkg--generate-team-candidates ()
+(defun sdj/sponsor--team-repo-exists-p (team repo)
-  "Generate a list of candidates for team names.
-
-The generated list is actually a list of namespaces the user is a member of."
-  (plz 'get (sdj/sponsor-debian-pkg--api-endpoint "namespaces")
-    :headers `(("PRIVATE-TOKEN" . ,sdj/sponsor-debian-pkg-debian-pkg-salsa-api-token))
-    :as #'sdj/sponsor-debian-pkg--parse-teams))
-
-(defun sdj/sponsor-debian-pkg--team-repo-exists-p (team repo)
-  "Check if 'REPO' (under 'TEAM' namespace) exists."
   (condition-case err
       (let ((r (plz 'get
-		 (concat (sdj/sponsor-debian-pkg--api-endpoint "projects")
+		 (concat (sdj/sponsor--api-endpoint "projects")
 			 (url-hexify-string (concat team "/" repo)))
 		 :as 'response)))
 	(when (plz-response-p r)
@@ -99,115 +107,87 @@ The generated list is actually a list of namespaces the user is a member of."
 	    (404 nil))))
     (plz-error nil)))
 
-(defun sdj/sponsor-debian-pkg--sanitize-import-url (url)
+(defun sdj/sponsor--sanitize-import-url (url)
-  "Sanitize the git import URL to be used when creating a new project.
-
-This will always make sure to replace 'git@salsa.debian.org:'
-with 'https://salsa.debian.org/', and append a '.git' suffix if
-needed."
   (concat (string-replace "git@salsa.debian.org:"
 			  "https://salsa.debian.org/"
 			  url)
 	  (unless (string-suffix-p ".git" url)
 	    ".git")))
 
-(defun sdj/sponsor-debian-pkg--parse-new-repo-clone-url ()
+(defun sdj/sponsor--parse-new-repo-clone-url ()
-  "Parse the JSON returned when creating a new project, returning its clone URL."
   (let ((parsenewrepo (json-read)))
     (alist-get 'ssh_url_to_repo parsenewrepo)))
 
-(defun sdj/sponsor-debian-pkg--create-team-repo (team projname &optional import-repourl)
+(defun sdj/sponsor--create-team-repo (team projname repourl)
-  "Create a repository named 'PROJNAME' under 'TEAM' namespace.
+  (plz 'post (sdj/sponsor--api-endpoint "projects")
-
-If 'IMPORT-REPOURL' is provided, use it as the initial import."
-  (plz 'post (sdj/sponsor-debian-pkg--api-endpoint "projects")
     :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
 	   (delete nil
 		   `(("name" . ,projname)
 		     ("description" . ,(concat "Debian package for " projname))
-		     ,(when import-repourl
+		     ,(when repourl
-			`("import_url" . ,(sdj/sponsor-debian-pkg--sanitize-import-url import-repourl)))
+			`("import_url" . ,(sdj/sponsor--sanitize-import-url repourl)))
 		     ("namespace_id" . ,(cdr team))
 		     ("initialize_with_readme" . false))))
-    :as #'sdj/sponsor-debian-pkg--parse-new-repo-clone-url))
+    :as #'sdj/sponsor--parse-new-repo-clone-url))
 
-(defun sdj/sponsor-debian-pkg--make-team-repo-url (team projname)
+(defun sdj/sponsor--make-team-repo-url (team projname)
-  "Given 'TEAM' and 'PROJNAME', return the repository URL.
-
-This URL is used for cloning purposes, and therefore starts with
-'git@salsa.debian.org:'."
   (concat "git@salsa.debian.org:"
 	  (car team) "/"
 	  projname ".git"))
 
-(defun sdj/sponsor-debian-pkg--get-or-create-team-repo (team projname &options import-repourl dontask-p)
+(defun sdj/sponsor--get-or-create-team-repo (team projname repourl &optional dontask-p)
-  "Get or create a new repository under 'TEAM'.
+  (if (sdj/sponsor--team-repo-exists-p (car team) projname)
-
+      (sdj/sponsor--make-team-repo-url team projname)
-If 'IMPORT-REPOURL' is provided, use it as the initial repository content.
-
-If 'DONTASK-P' is t, don't ask whether the user would like to
-create the repository."
-  (if (sdj/sponsor-debian-pkg--team-repo-exists-p (car team) projname)
-      (sdj/sponsor-debian-pkg--make-team-repo-url team projname)
     (when (or dontask-p
 	      (y-or-n-p "Would you like to create the repository under the team's namespace? "))
       (message "Creating the team repository (%s/%s.git)..."
 	       (car team) projname)
-      (sdj/sponsor-debian-pkg--create-team-repo team projname import-repourl))))
+      (sdj/sponsor--create-team-repo team projname repourl))))
 
-(defun sdj/sponsor-debian-pkg--confirm-username (user)
+(defun sdj/sponsor--confirm-username (user)
-  "Confirm if 'USER' exists."
   (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)))
     (and (not (seq-empty-p u)) user)))
 
-(defun sdj/sponsor-debian-pkg--confirm-team (team)
+(defun sdj/sponsor--confirm-team (team)
-  "Confirm if 'TEAM' exists.
-
-Note that internally teams are actually treated as namespaces."
   (condition-case err
       (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)))
 	(and (not (seq-empty-p u)) (cons team (alist-get 'id u))))
     (plz-error nil)))
 
-(defun sdj/sponsor-debian-pkg--read-sponsoree-choice ()
+(defun sdj/sponsor--read-sponsoree-choice ()
-  "Read the sponsoree."
+  (let* ((sponsoreealist (sdj/sponsor--generate-sponsoree-candidates))
-  (let* ((sponsoreealist (sdj/sponsor-debian-pkg--generate-sponsoree-candidates))
 	 (sponsoreechoice (completing-read "Sponsoree: " sponsoreealist)))
     (or (alist-get sponsoreechoice sponsoreealist nil nil #'string=)
-	(sdj/sponsor-debian-pkg--confirm-username sponsoreechoice))))
+	(sdj/sponsor--confirm-username sponsoreechoice))))
 
-(defun sdj/sponsor-debian-pkg--read-team-choice (&optional dontask-p)
+(defun sdj/sponsor--read-team-choice (&optional dontask-p)
-  "Read the team."
   (when (or dontask-p
 	    (y-or-n-p "Would you like to specify a team? "))
-    (let* ((teamalist (sdj/sponsor-debian-pkg--generate-team-candidates))
+    (let* ((teamalist (sdj/sponsor--generate-team-candidates))
 	   (teamchoice (completing-read "Team: " teamalist nil t)))
       (cons teamchoice
 	    (alist-get teamchoice teamalist nil nil #'string=)))))
 
-(defun sdj/sponsor-debian-pkg--read-string-or-nil (prompt)
+(defun sdj/sponsor--read-string-or-nil (prompt)
-  "Read a string from the minibuffer or nil."
   (let ((r (read-from-minibuffer prompt)))
     (unless (string-empty-p r)
       r)))
 
-(defun sdj/sponsor-debian-pkg--read-repourl (&optional prompt)
+(defun sdj/sponsor--read-repourl (&optional prompt)
-  "Read a repository URL."
+  (let ((r (sdj/sponsor--read-string-or-nil (or prompt
-  (let ((r (sdj/sponsor-debian-pkg--read-string-or-nil (or prompt
 						"Repository URL: "))))
     (when r
       (string-remove-suffix "/" r))))
 
-(defun sdj/sponsor-debian-pkg--get-namespace-from-repourl (repourl)
+(defun sdj/sponsor--get-namespace-from-repourl (repourl)
-  "Given a repository URL 'REPOURL', return its namespace."
   (let ((str-no-url (or (and (string-prefix-p "git@salsa.debian.org:" repourl)
 			     (string-remove-prefix "git@salsa.debian.org:" repourl))
 			(and (string-prefix-p "https://salsa.debian.org/" repourl)
@@ -219,18 +199,19 @@ Note that internally teams are actually treated as namespaces."
       (file-name-directory
        (string-remove-suffix "/" str-no-url))))))
 
-(defun sdj/sponsor-debian-pkg--get-project-from-repourl (repourl)
+  ;; (replace-regexp-in-string
-  "Given a repository URL 'REPOURL', return its project name."
+  ;;  (rx
+  ;;   (or "git@salsa.debian.org:" "https://salsa.debian.org/")
+  ;;   (group (one-or-more (not "/"))) (minimal-match (one-or-more not-newline)))
+  ;; 			      "\\1" repourl nil nil nil ))
+
+(defun sdj/sponsor--get-project-from-repourl (repourl)
   (file-name-base (string-remove-suffix "/" repourl)))
 
-(defun sdj/sponsor-debian-pkg--what-is-this-namespace (namespace)
+(defun sdj/sponsor--what-is-this-namespace (namespace)
-  "Given a namespace 'NAMESPACE', identify it.
+  (let* ((username (sdj/sponsor--confirm-username namespace))
-
-Return an alist of (ID . DATA), where 'ID' is either 'username or
-'team, and 'DATA' is information about the namespace."
-  (let* ((username (sdj/sponsor-debian-pkg--confirm-username namespace))
 	 (team (and (not username)
-		    (sdj/sponsor-debian-pkg--confirm-team namespace))))
+		    (sdj/sponsor--confirm-team namespace))))
     (cond
      (username
       (cons 'username username))
@@ -239,38 +220,33 @@ Return an alist of (ID . DATA), where 'ID' is either 'username or
      (t
       (error "Could not find namespace '%s'" namespace)))))
 
-(defun sdj/sponsor-debian-pkg--read-args ()
+(defun sdj/sponsor-init--read-args ()
-  "Read arguments from the minibuffer."
+  (let* ((repo (sdj/sponsor--read-repourl))
-  (let* ((repo (sdj/sponsor-debian-pkg--read-repourl))
+	 (namespace (sdj/sponsor--get-namespace-from-repourl repo))
-	 (namespace (sdj/sponsor-debian-pkg--get-namespace-from-repourl repo))
+	 (result (sdj/sponsor--what-is-this-namespace namespace))
-	 (result (sdj/sponsor-debian-pkg--what-is-this-namespace namespace))
 	 (team (or (and (eq (car result) 'team)
 			(cdr result))
-		   (sdj/sponsor-debian-pkg--read-team-choice)))
+		   (sdj/sponsor--read-team-choice)))
 	 (sponsoree (or (and (eq (car result) 'username)
 			     (cdr result))
-			(sdj/sponsor-debian-pkg--read-sponsoree-choice))))
+			(sdj/sponsor--read-sponsoree-choice))))
     (when (y-or-n-p (format "Sponsoree: [%s]; Team: [%s]; OK? " sponsoree (or (car team) "none")))
       (list sponsoree team repo))))
 
 ;;;###autoload
-(defun sdj/sponsor-debian-pkg-create-team-repo (team projname sponsoree-repourl)
+(defun sdj/sponsor-create-team-repo (team projname sponsoree-repourl)
-  "Create a team repository.
-
-If 'SPONSOREE-REPOURL' is provided, use it as a base for the
-initial repository."
   (interactive
    (list
-    (sdj/sponsor-debian-pkg--read-team-choice t)
+    (sdj/sponsor--read-team-choice t)
-    (sdj/sponsor-debian-pkg--read-string-or-nil "Project name: ")
+    (sdj/sponsor--read-string-or-nil "Project name: ")
-    (sdj/sponsor-debian-pkg--read-repourl "Sponsoree repository to import into the new one (optional): ")))
+    (sdj/sponsor--read-repourl "Sponsoree repository to import into the new one (optional): ")))
   (when (or (not team) (not projname))
     (error "You must provide a valid team and a project name"))
-  (let ((team-repourl (sdj/sponsor-debian-pkg--get-or-create-team-repo team projname sponsoree-repourl t)))
+  (let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname sponsoree-repourl t)))
     (when sponsoree-repourl
-      (when-let* ((sponsoree (sdj/sponsor-debian-pkg--get-namespace-from-repourl sponsoree-repourl))
+      (when-let* ((sponsoree (sdj/sponsor--get-namespace-from-repourl sponsoree-repourl))
 		  (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
 			    (concat sponsoreedir projname)))
 		  (team-gitdir (file-name-as-directory
@@ -293,14 +269,14 @@ initial repository."
 			    "fetch" sponsoree))))))))
 
 ;;;###autoload
-(defun sdj/sponsor-debian-pkg (sponsoree team repo)
+(defun sdj/sponsor-init (sponsoree team repo)
   (interactive
-   (sdj/sponsor-debian-pkg--read-args))
+   (sdj/sponsor-init--read-args))
   (when (or (not sponsoree) (not repo))
     (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--get-project-from-repourl repo))
 	 (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
 		   (concat sponsoreedir projname)))
 	 (repo-is-private-p (string-search (concat "/" sponsoree "/") repo))
@@ -315,7 +291,7 @@ initial repository."
 	(call-process "gbp" nil (get-buffer-create "*gbp output*") nil
 		      "clone" repo sponsoree-gitdir))
       (when (and team repo-is-private-p)
-	(when-let ((team-repourl (sdj/sponsor-debian-pkg--get-or-create-team-repo team projname repo))
+	(when-let ((team-repourl (sdj/sponsor--get-or-create-team-repo team projname repo))
 		   (team-gitdir (concat projdir projname)))
 	  (unless (file-directory-p team-gitdir)
 	    (message "Cloning the team repository...")
@@ -331,6 +307,6 @@ initial repository."
 			     "fetch" sponsoree))))))
     (dired sponsoree-gitdir)))
 
-(provide 'sponsor-debian-pkg)
+(provide 'sponsor-debian)
 
-;;; sponsor-debian-pkg.el ends here
+;;; sponsor-debian.el ends here