summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs34
-rw-r--r--Annex/Content/Direct.hs14
-rw-r--r--Annex/Direct.hs3
-rw-r--r--Annex/ReplaceFile.hs35
4 files changed, 56 insertions, 30 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5ec3c1b3f..9f8659fb5 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -28,7 +28,6 @@ module Annex.Content (
preseedTmp,
freezeContent,
thawContent,
- replaceFile,
cleanObjectLoc,
) where
@@ -53,6 +52,7 @@ import Git.SharedRepository
import Annex.Perms
import Annex.Link
import Annex.Content.Direct
+import Annex.ReplaceFile
{- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool
@@ -256,38 +256,14 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
validsymlink f = (==) (Just key) <$> isAnnexLink f
storedirect' [] = storeobject =<< calcRepo (gitAnnexLocation key)
- storedirect' (dest:fs) = do
+ storedirect' (f:fs) = do
thawContentDir =<< calcRepo (gitAnnexLocation key)
updateInodeCache key src
thawContent src
- replaceFile dest $ liftIO . moveFile src
+ replaceFile f $ liftIO . moveFile src
{- Copy to any other locations. -}
- forM_ fs $ \f -> replaceFile f $
- liftIO . void . copyFileExternal dest
-
-{- Replaces a possibly already existing file with a new version,
- - atomically, by running an action.
-
- - The action is passed a temp file, which it can write to, and once
- - done the temp file is moved into place.
- -}
-replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
-replaceFile file a = do
- tmpdir <- fromRepo gitAnnexTmpDir
- createAnnexDirectory tmpdir
- tmpfile <- liftIO $ do
- (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $
- takeFileName file
- hClose h
- return tmpfile
- a tmpfile
- liftIO $ do
- r <- tryIO $ rename tmpfile file
- case r of
- Left _ -> do
- createDirectoryIfMissing True $ parentDir file
- rename tmpfile file
- _ -> noop
+ forM_ fs $
+ addContentWhenNotPresent key f
{- Runs an action to transfer an object's content.
-
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index b885b5e5b..49d317258 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -23,6 +23,7 @@ module Annex.Content.Direct (
toInodeCache,
inodesChanged,
createInodeSentinalFile,
+ addContentWhenNotPresent,
) where
import Common.Annex
@@ -32,6 +33,9 @@ import qualified Git
import Utility.Tmp
import Logs.Location
import Utility.InodeCache
+import Utility.CopyFile
+import Annex.ReplaceFile
+import Annex.Link
{- Absolute FilePaths of Files in the tree that are associated with a key. -}
associatedFiles :: Key -> Annex [FilePath]
@@ -180,6 +184,16 @@ elemInodeCaches c (l:ls) = ifM (compareInodeCaches c l)
compareInodeCachesWith :: Annex InodeComparisonType
compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )
+{- Copies the contentfile to the associated file, if the associated
+ - file has not content. If the associated file does have content,
+ - even if the content differs, it's left unchanged. -}
+addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex ()
+addContentWhenNotPresent key contentfile associatedfile = do
+ v <- isAnnexLink associatedfile
+ when (Just key == v) $
+ replaceFile associatedfile $
+ liftIO . void . copyFileExternal contentfile
+
{- Some filesystems get new inodes each time they are mounted.
- In order to work on such a filesystem, a sentinal file is used to detect
- when the inodes have changed.
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 67822f2d5..02fdb2430 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -26,6 +26,7 @@ import Annex.Link
import Utility.InodeCache
import Utility.CopyFile
import Annex.Perms
+import Annex.ReplaceFile
{- Uses git ls-files to find files that need to be committed, and stages
- them into the index. Returns True if some changes were staged. -}
@@ -191,7 +192,7 @@ toDirectGen k f = do
{- Move content from annex to direct file. -}
thawContentDir loc
updateInodeCache k loc
- addAssociatedFile k f
+ void $ addAssociatedFile k f
thawContent loc
replaceFile f $ liftIO . moveFile loc
fromdirect = do
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
new file mode 100644
index 000000000..f0dfa5b27
--- /dev/null
+++ b/Annex/ReplaceFile.hs
@@ -0,0 +1,35 @@
+{- git-annex file replacing
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.ReplaceFile where
+
+import Common.Annex
+import Annex.Perms
+
+{- Replaces a possibly already existing file with a new version,
+ - atomically, by running an action.
+ -
+ - The action is passed a temp file, which it can write to, and once
+ - done the temp file is moved into place.
+ -}
+replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
+replaceFile file a = do
+ tmpdir <- fromRepo gitAnnexTmpDir
+ createAnnexDirectory tmpdir
+ tmpfile <- liftIO $ do
+ (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $
+ takeFileName file
+ hClose h
+ return tmpfile
+ a tmpfile
+ liftIO $ do
+ r <- tryIO $ rename tmpfile file
+ case r of
+ Left _ -> do
+ createDirectoryIfMissing True $ parentDir file
+ rename tmpfile file
+ _ -> noop