annex.genmetadata can be set to make git-annex automatically set metadata (year and month) when adding files

2 files changed, 52 insertions, 2 deletions

diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs
new file mode 100644
index 000000000..ef235b51f
--- /dev/null
+++ b/Annex/MetaData.hs
@@ -0,0 +1,51 @@
+{- git-annex metadata
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.MetaData where
+
+import Common.Annex
+import qualified Annex
+import Types.MetaData
+import Logs.MetaData
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Time.Calendar
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+
+tagMetaField :: MetaField
+tagMetaField = MetaField "tag"
+
+yearMetaField :: MetaField
+yearMetaField = MetaField "year"
+
+monthMetaField :: MetaField
+monthMetaField = MetaField "month"
+
+{- Generates metadata for a file that has just been ingested into the
+ - annex. Passed the FileStatus of the content file.
+ -
+ - Does not overwrite any existing metadata values for the key.
+ -}
+genMetaData :: Key -> FileStatus -> Annex ()
+genMetaData key status = whenM (annexGenMetaData <$> Annex.getGitConfig) $ do
+	metadata <- getCurrentMetaData key
+	let metadata' = genMetaData' status metadata
+	unless (metadata' == emptyMetaData) $
+		addMetaData key metadata'
+
+genMetaData' :: FileStatus -> MetaData -> MetaData
+genMetaData' status old = MetaData $ M.fromList $ filter isnew
+	[ (yearMetaField, S.singleton $ toMetaValue $ show y)
+	, (monthMetaField, S.singleton $ toMetaValue $ show m)
+	]
+  where
+	isnew (f, _) = S.null (currentMetaDataValues f old)
+	(y, m, _d) = toGregorian $ utctDay $ 
+		posixSecondsToUTCTime $ realToFrac $
+			modificationTime status
diff --git a/Annex/View.hs b/Annex/View.hs
index 69d064753..9d1a763e2 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -300,8 +300,7 @@ applyView' mkviewedfile getfilemetadata view = do
 	genviewedfiles = viewedFiles view mkviewedfile -- enables memoization
 	go uh hasher f (Just (k, _)) = do
 		metadata <- getCurrentMetaData k
-		let dirmetadata = getfilemetadata f
-		let metadata' = unionMetaData dirmetadata metadata
+		let metadata' = getfilemetadata f `unionMetaData` metadata
 		forM_ (genviewedfiles f metadata') $ \fv -> do
 			stagesymlink uh hasher fv =<< inRepo (gitAnnexLink fv k)
 	go uh hasher f Nothing