Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
clpm
clpi
Commits
0958403d
Commit
0958403d
authored
May 01, 2020
by
Eric Timmons
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add DUAL-INDEX-SYNC
parent
02eccc08
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
31 additions
and
6 deletions
+31
-6
src/dual-index.lisp
src/dual-index.lisp
+31
-6
No files found.
src/dual-index.lisp
View file @
0958403d
...
...
@@ -8,8 +8,10 @@
#:alexandria
#:clpi/index-defs
#:clpi/index
#:clpi/metadata
#:clpi/project-defs
)
(
:export
#:dual-index
))
(
:export
#:dual-index
#:dual-index-sync
))
(
in-package
#:clpi/dual-index
)
...
...
@@ -54,15 +56,28 @@ minutes old."))
(
ends-with-subseq
"metadata"
path
))
(
not
(
gethash
path
(
dual-index-updated-paths
index
)))))
(
defun
path-appendable-p
(
path
)
(
let
((
file-namestring
(
file-namestring
path
)))
(
starts-with-subseq
"releases-"
file-namestring
)))
(
defun
update-object-from-primary
(
index
path
)
(
let*
((
primary
(
dual-index-primary
index
))
(
secondary
(
dual-index-secondary
index
)))
(
if
(
path-appendable-p
path
)
(
with-open-index-object-stream
(
primary-stream
primary
path
:binary-p
t
:offset
(
index-object-size
secondary
path
))
(
index-object-append
secondary
path
primary-stream
))
(
with-open-index-object-stream
(
s
primary
path
)
(
index-object-write
secondary
path
s
)
(
setf
(
gethash
path
(
dual-index-updated-paths
index
))
t
)))))
(
defmethod
open-index-object-stream
((
index
dual-index
)
path
&key
signal-if-older-than
binary-p
offset
)
(
let
((
primary
(
dual-index-primary
index
))
(
secondary
(
dual-index-secondary
index
)))
(
let
((
secondary
(
dual-index-secondary
index
)))
(
flet
((
read-from-primary
()
(
with-open-index-object-stream
(
s
primary
path
)
(
index-object-write
secondary
path
s
)
(
setf
(
gethash
path
(
dual-index-updated-paths
index
))
t
))))
(
update-object-from-primary
index
path
)))
(
handler-bind
((
index-object-missing
(
lambda
(
c
)
(
read-from-primary
)
...
...
@@ -78,3 +93,13 @@ minutes old."))
(
*
10
60
)))
:binary-p
binary-p
:offset
offset
)))))
(
defun
dual-index-sync
(
index
)
"Ensure that every object is present in INDEX's secondary."
(
update-object-from-primary
index
(
metadata-path
index
))
(
update-object-from-primary
index
"index"
)
(
dolist
(
p
(
index-projects
index
))
(
update-object-from-primary
index
(
metadata-path
p
))
(
update-object-from-primary
index
(
project-releases-path
p
)))
(
dolist
(
s
(
index-systems
index
))
(
update-object-from-primary
index
(
metadata-path
s
))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment