Removed the setkey command, and added a setcontent command with a more useful interface.
This commit is contained in:
parent
e09dd6f306
commit
cc1ea8f844
6 changed files with 80 additions and 65 deletions
|
@ -38,7 +38,7 @@ perform key file backend numcopies = check
|
|||
[ verifyLocationLog key file
|
||||
, checkKeySize key
|
||||
, checkKeyNumCopies key file numcopies
|
||||
, (Types.Backend.fsckKey backend) key
|
||||
, checkBackend backend key
|
||||
]
|
||||
|
||||
{- To fsck a bare repository, fsck each key in the location log. -}
|
||||
|
@ -65,7 +65,7 @@ performBare :: Key -> Backend Annex -> CommandPerform
|
|||
performBare key backend = check
|
||||
[ verifyLocationLog key (show key)
|
||||
, checkKeySize key
|
||||
, (Types.Backend.fsckKey backend) key
|
||||
, checkBackend backend key
|
||||
]
|
||||
|
||||
check :: [Annex Bool] -> CommandPerform
|
||||
|
@ -134,6 +134,9 @@ checkKeySize key = do
|
|||
return False
|
||||
|
||||
|
||||
checkBackend :: Backend Annex -> Key -> Annex Bool
|
||||
checkBackend backend key = (Types.Backend.fsckKey backend) key
|
||||
|
||||
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
|
||||
checkKeyNumCopies key file numcopies = do
|
||||
needed <- getNumCopies numcopies
|
||||
|
|
56
Command/SetContent.hs
Normal file
56
Command/SetContent.hs
Normal file
|
@ -0,0 +1,56 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.SetContent where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Logs.Location
|
||||
import Annex.Content
|
||||
import qualified Backend
|
||||
import qualified Command.Fsck
|
||||
|
||||
def :: [Command]
|
||||
def = [command "setcontent" (paramPair paramPath paramPath) seek
|
||||
"sets content of annexed file"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withWords start]
|
||||
|
||||
start :: [FilePath] -> CommandStart
|
||||
start (src:dest:[]) = do
|
||||
showStart "setkey" dest
|
||||
next $ perform src dest
|
||||
start _ = error "specify a src file and a dest file"
|
||||
|
||||
perform :: FilePath -> FilePath -> CommandPerform
|
||||
perform src dest = go =<< Backend.lookupFile dest
|
||||
where
|
||||
go Nothing = error "dest file is not in annex"
|
||||
go (Just (key, backend)) = do
|
||||
-- the file might be on a different filesystem,
|
||||
-- so mv is used rather than simply calling
|
||||
-- moveToObjectDir; disk space is also
|
||||
-- checked this way.
|
||||
ok <- getViaTmp key $ \tmp ->
|
||||
if dest /= src
|
||||
then liftIO $
|
||||
boolSystem "mv" [File src, File tmp]
|
||||
else return True
|
||||
if ok
|
||||
then next $ cleanup key backend
|
||||
else error "mv failed!"
|
||||
|
||||
cleanup :: Key -> Backend Annex -> CommandCleanup
|
||||
cleanup key backend = do
|
||||
logStatus key InfoPresent
|
||||
|
||||
-- fsck the new content
|
||||
size_ok <- Command.Fsck.checkKeySize key
|
||||
backend_ok <- Command.Fsck.checkBackend backend key
|
||||
|
||||
return $ size_ok && backend_ok
|
|
@ -1,48 +0,0 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.SetKey where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Logs.Location
|
||||
import Annex.Content
|
||||
import Config
|
||||
|
||||
def :: [Command]
|
||||
def = [command "setkey" paramPath seek
|
||||
"sets annexed content for a key using a temp file"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withStrings start]
|
||||
|
||||
{- Sets cached content for a key. -}
|
||||
start :: FilePath -> CommandStart
|
||||
start file = do
|
||||
showStart "setkey" file
|
||||
next $ perform file
|
||||
|
||||
perform :: FilePath -> CommandPerform
|
||||
perform file = do
|
||||
key <- cmdlineKey
|
||||
-- the file might be on a different filesystem, so mv is used
|
||||
-- rather than simply calling moveToObjectDir; disk space is also
|
||||
-- checked this way.
|
||||
ok <- getViaTmp key $ \dest ->
|
||||
if dest /= file
|
||||
then liftIO $
|
||||
boolSystem "mv" [File file, File dest]
|
||||
else return True
|
||||
if ok
|
||||
then next cleanup
|
||||
else error "mv failed!"
|
||||
|
||||
cleanup :: CommandCleanup
|
||||
cleanup = do
|
||||
key <- cmdlineKey
|
||||
logStatus key InfoPresent
|
||||
return True
|
Loading…
Add table
Add a link
Reference in a new issue