avoid opening export db until needed
Before, it was opened when constructing the export Remote, even if it never got used.
This commit is contained in:
parent
cd3a2b023a
commit
bc509143e5
1 changed files with 14 additions and 5 deletions
|
@ -102,10 +102,10 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
||||||
Just c -> case yesNo c of
|
Just c -> case yesNo c of
|
||||||
Just True -> ifM (isExportSupported r)
|
Just True -> ifM (isExportSupported r)
|
||||||
( do
|
( do
|
||||||
exportdb <- Export.openDb (uuid r)
|
exportdbv <- liftIO $ newTVarIO Nothing
|
||||||
r' <- isexport exportdb
|
r' <- isexport exportdbv
|
||||||
if importTree (config r)
|
if importTree (config r)
|
||||||
then isimport r' exportdb
|
then isimport r' exportdbv
|
||||||
else return r'
|
else return r'
|
||||||
, return $ notexport r
|
, return $ notexport r
|
||||||
)
|
)
|
||||||
|
@ -128,7 +128,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
isimport r' exportdb = do
|
isimport r' exportdbv = do
|
||||||
lcklckv <- liftIO newEmptyTMVarIO
|
lcklckv <- liftIO newEmptyTMVarIO
|
||||||
dbtv <- liftIO newEmptyTMVarIO
|
dbtv <- liftIO newEmptyTMVarIO
|
||||||
let store f k loc p = do
|
let store f k loc p = do
|
||||||
|
@ -151,6 +151,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
||||||
, liftIO $ fst <$> atomically (readTMVar dbtv)
|
, liftIO $ fst <$> atomically (readTMVar dbtv)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
exportdb <- getexportdb exportdbv
|
||||||
ks <- liftIO $ Export.getExportedKey exportdb loc
|
ks <- liftIO $ Export.getExportedKey exportdb loc
|
||||||
oldcids <- liftIO $ concat
|
oldcids <- liftIO $ concat
|
||||||
<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
|
<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
|
||||||
|
@ -166,8 +167,15 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
||||||
{ storeExport = store
|
{ storeExport = store
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
getexportdb dbv = liftIO (atomically (readTVar dbv)) >>= \case
|
||||||
|
Just db -> return db
|
||||||
|
Nothing -> do
|
||||||
|
db <- Export.openDb (uuid r)
|
||||||
|
liftIO $ atomically $ writeTVar dbv $ Just db
|
||||||
|
return db
|
||||||
|
|
||||||
isexport db = do
|
isexport dbv = do
|
||||||
updateflag <- liftIO $ newTVarIO Nothing
|
updateflag <- liftIO $ newTVarIO Nothing
|
||||||
|
|
||||||
-- When multiple threads run this, all except the first
|
-- When multiple threads run this, all except the first
|
||||||
|
@ -193,6 +201,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
||||||
-- updates the database, to notice when an export has been
|
-- updates the database, to notice when an export has been
|
||||||
-- updated from another repository.
|
-- updated from another repository.
|
||||||
let getexportlocs = \k -> do
|
let getexportlocs = \k -> do
|
||||||
|
db <- getexportdb dbv
|
||||||
bracket startupdateonce doneupdateonce $ \updatenow ->
|
bracket startupdateonce doneupdateonce $ \updatenow ->
|
||||||
when updatenow $
|
when updatenow $
|
||||||
Export.updateExportTreeFromLog db >>= \case
|
Export.updateExportTreeFromLog db >>= \case
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue