--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:
parent
e86db3d2ab
commit
a44e01c29c
8 changed files with 73 additions and 15 deletions
|
@ -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.
|
||||
-
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
24
Limit.hs
24
Limit.hs
|
@ -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
|
||||
|
|
|
@ -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.) -}
|
||||
|
|
|
@ -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
2
debian/changelog
vendored
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue