--in can now refer to files that were located in a repository at some past date. For example, --in="here@{yesterday}"

This commit is contained in:
Joey Hess 2014-02-06 12:43:56 -04:00
parent e86db3d2ab
commit a44e01c29c
8 changed files with 73 additions and 15 deletions

View file

@ -18,6 +18,7 @@ module Annex.Branch (
forceUpdate,
updateTo,
get,
getHistorical,
change,
commit,
forceCommit,
@ -197,7 +198,13 @@ getLocal file = go =<< getJournalFileStale file
go Nothing = getRaw file
getRaw :: FilePath -> Annex String
getRaw file = withIndex $ L.unpack <$> catFile fullname file
getRaw = getRef fullname
getHistorical :: RefDate -> FilePath -> Annex String
getHistorical date = getRef (Git.Ref.dateRef fullname date)
getRef :: Ref -> FilePath -> Annex String
getRef ref file = withIndex $ L.unpack <$> catFile ref file
{- Applies a function to modifiy the content of a file.
-

View file

@ -11,6 +11,7 @@ import Common
import Git
import Git.Command
import Git.Sha
import Git.Types
import Data.Char (chr)
@ -51,6 +52,10 @@ underBase dir r = Ref $ dir ++ "/" ++ show (base r)
fileRef :: FilePath -> Ref
fileRef f = Ref $ ":./" ++ f
{- Converts a Ref to refer to the content of the Ref on a given date. -}
dateRef :: Ref -> RefDate -> Ref
dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d
{- A Ref that can be used to refer to a file in the repository as it
- appears in a given Ref. -}
fileFromRef :: Ref -> FilePath -> Ref

View file

@ -57,6 +57,10 @@ type Branch = Ref
type Sha = Ref
type Tag = Ref
{- A date in the format described in gitrevisions. Includes the
- braces, eg, "{yesterday}" -}
newtype RefDate = RefDate String
{- Types of objects that can be stored in git. -}
data ObjectType = BlobObject | CommitObject | TreeObject
deriving (Eq)

View file

@ -30,6 +30,8 @@ import Types.FileMatcher
import Types.Limit
import Logs.Group
import Logs.Unused
import Logs.Location
import Git.Types (RefDate(..))
import Utility.HumanTime
import Utility.DataUnits
@ -112,20 +114,26 @@ matchglob glob (MatchingFile fi) =
matchglob _ (MatchingKey _) = False
{- Adds a limit to skip files not believed to be present
- in a specfied repository. -}
- in a specfied repository. Optionally on a prior date. -}
addIn :: String -> Annex ()
addIn = addLimit . limitIn
limitIn :: MkLimit
limitIn name = Right $ \notpresent -> checkKey $
limitIn s = Right $ \notpresent -> checkKey $ \key ->
if name == "."
then inhere notpresent
else inremote notpresent
then if null date
then inhere notpresent key
else inuuid notpresent key =<< getUUID
else inuuid notpresent key =<< Remote.nameToUUID name
where
inremote notpresent key = do
u <- Remote.nameToUUID name
us <- Remote.keyLocations key
return $ u `elem` us && u `S.notMember` notpresent
(name, date) = separate (== '@') s
inuuid notpresent key u
| null date = do
us <- Remote.keyLocations key
return $ u `elem` us && u `S.notMember` notpresent
| otherwise = do
us <- loggedLocationsHistorical (RefDate date) key
return $ u `elem` us
inhere notpresent key
| S.null notpresent = inAnnex key
| otherwise = do

View file

@ -8,7 +8,7 @@
- Repositories record their UUID and the date when they --get or --drop
- a value.
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -18,6 +18,7 @@ module Logs.Location (
logStatus,
logChange,
loggedLocations,
loggedLocationsHistorical,
loggedKeys,
loggedKeysFor,
) where
@ -27,6 +28,7 @@ import qualified Annex.Branch
import Logs
import Logs.Presence
import Annex.UUID
import Git.Types (RefDate)
{- Log a change in the presence of a key's value in current repository. -}
logStatus :: Key -> LogStatus -> Annex ()
@ -40,10 +42,16 @@ logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u
logChange _ NoUUID _ = noop
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key.
-}
- the value of a key. -}
loggedLocations :: Key -> Annex [UUID]
loggedLocations key = map toUUID <$> (currentLog . locationLogFile) key
loggedLocations = getLoggedLocations currentLog
{- Gets the location log on a particular date. -}
loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID]
loggedLocationsHistorical = getLoggedLocations . historicalLog
getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID]
getLoggedLocations getter key = map toUUID <$> (getter . locationLogFile) key
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}

View file

@ -6,7 +6,7 @@
- A line of the log will look like: "date N INFO"
- Where N=1 when the INFO is present, and 0 otherwise.
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -16,7 +16,8 @@ module Logs.Presence (
addLog,
readLog,
logNow,
currentLog
currentLog,
historicalLog
) where
import Data.Time.Clock.POSIX
@ -24,6 +25,7 @@ import Data.Time.Clock.POSIX
import Logs.Presence.Pure as X
import Common.Annex
import qualified Annex.Branch
import Git.Types (RefDate)
addLog :: FilePath -> LogLine -> Annex ()
addLog file line = Annex.Branch.change file $ \s ->
@ -43,3 +45,12 @@ logNow s i = do
{- Reads a log and returns only the info that is still in effect. -}
currentLog :: FilePath -> Annex [String]
currentLog file = map info . filterPresent <$> readLog file
{- Reads a historical version of a log and returns the info that was in
- effect at that time.
-
- The date is formatted as shown in gitrevisions man page.
-}
historicalLog :: RefDate -> FilePath -> Annex [String]
historicalLog refdate file = map info . filterPresent . parseLog
<$> Annex.Branch.getHistorical refdate file

2
debian/changelog vendored
View file

@ -1,5 +1,7 @@
git-annex (5.20140128) UNRELEASED; urgency=medium
* --in can now refer to files that were located in a repository at
some past date. For example, --in="here@{yesterday}"
* Fixed direct mode annexed content locking code, which is used to
guard against recursive file drops.
* sync --content: Honor annex-ignore configuration.

View file

@ -1005,6 +1005,19 @@ file contents are present at either of two repositories.
or the UUID or description of a repository. For the current repository,
use `--in=here`
* `--in=repository@{date}`
Matches files currently in the work tree whose content was present in
the repository on the given date.
The date is specified in the same syntax documented in
gitrevisions(7). Note that this uses the reflog, so dates far in the
past cannot be queried.
For example, you might need to run `git annex drop .` to temporarily
free up disk space. The next day, you can get back the files you dropped
using `git annex get . --in=here@{yesterday}`
* `--copies=number`
Matches only files that git-annex believes to have the specified number