cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Attempt to fetch this Git polling mess

Browse source 
Listing remote branches through libgit2 will list branches that don't exist on
the remote. I think branch-list is more listing branch references, and you can
have references to a remote branch where the remote branch doesn't exist. This
isn't very useful here though, as I'm trying to work out what remote branches
exist.

There's remote-ls which might help, but I can't figure out how to get the
commits for branches from that.

Therefore, just bodge the two things together in to a big mess. I seem to be
able to get commits from branch-list that hopefully match what's on the
remote (although I'm not confident about this), and I think remote-ls does
allow checking what branches exist.
This commit is contained in:
Christopher Baines 2023-10-11 17:53:38 +01:00
parent 70f1824e46
commit 82bb174700
1 changed files with 34 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

46
guix-data-service/poll-git-repository.scm
View file

@ -112,21 +112,42 @@
conn conn
git-repository-id)) git-repository-id))
;; remote-ls returns remote-head's where the oid's aren't like the
;; oid's found through branches, and I'm not sure how to handle
;; them. Work around this by just using remote-ls to check what
;; branches exist on the remote.
(remote-branch-names
(with-repository repository-directory repository
(let ((remote (remote-lookup repository "origin")))
(remote-connect remote)
(filter-map
(lambda (rh)
(let ((name (remote-head-name rh)))
(if (string-prefix? "refs/heads/" name)
(string-drop name
(string-length "refs/heads/"))
#f)))
(remote-ls remote)))))
(repository-branches (repository-branches
(with-repository repository-directory repository (with-repository repository-directory repository
(map (filter-map
(lambda (branch-reference) (lambda (branch-reference)
(let* ((branch-name (let* ((branch-name
(last (string-drop (reference-shorthand branch-reference)
(string-split (string-length "origin/"))))
(reference-shorthand branch-reference) (and
#\/)))) ;; branch-list may list branches which don't exist on the
(cons ;; remote, so use the information from remote-ls to
branch-name ;; filter them out
;; TODO Not sure what the right way to do this is (member branch-name remote-branch-names)
(and=> (false-if-exception (cons
(reference-target branch-reference)) branch-name
oid->string)))) ;; TODO Not sure what the right way to do this is
(and=> (false-if-exception
(reference-target branch-reference))
oid->string)))))
(branch-list repository BRANCH-REMOTE))))) (branch-list repository BRANCH-REMOTE)))))
(with-postgresql-transaction (with-postgresql-transaction
@ -187,7 +208,8 @@
git-repository-id git-repository-id
repository-commit repository-commit
"poll")))) "poll"))))
(if database-commit (if (or (not database-commit)
(string=? database-commit ""))
#f ;; Nothing to do #f ;; Nothing to do
(insert-git-commit-entry conn (insert-git-commit-entry conn
(git-branch-entry) (git-branch-entry)