matchexpression: Added --largefiles option to parse an annex.largefiles expression.

This commit is contained in:
Joey Hess 2016-02-03 16:58:36 -04:00
parent 5127cb59cc
commit 23cc315c38
Failed to extract signature
6 changed files with 44 additions and 17 deletions

View file

@ -14,6 +14,7 @@ module Annex.FileMatcher (
matchAll, matchAll,
preferredContentParser, preferredContentParser,
parsedToMatcher, parsedToMatcher,
mkLargeFilesParser,
largeFilesMatcher, largeFilesMatcher,
) where ) where

View file

@ -27,12 +27,17 @@ cmd = noCommit $
data MatchExpressionOptions = MatchExpressionOptions data MatchExpressionOptions = MatchExpressionOptions
{ matchexpr :: String { matchexpr :: String
, largeFilesExpression :: Bool
, matchinfo :: MatchInfo , matchinfo :: MatchInfo
} }
optParser :: CmdParamsDesc -> Parser MatchExpressionOptions optParser :: CmdParamsDesc -> Parser MatchExpressionOptions
optParser desc = MatchExpressionOptions optParser desc = MatchExpressionOptions
<$> argument str (metavar desc) <$> argument str (metavar desc)
<*> switch
( long "largefiles"
<> help "parse as annex.largefiles expression"
)
<*> (addkeysize <$> dataparser) <*> (addkeysize <$> dataparser)
where where
dataparser = MatchingInfo dataparser = MatchingInfo
@ -48,19 +53,27 @@ optParser desc = MatchExpressionOptions
( long "size" <> metavar paramSize ( long "size" <> metavar paramSize
<> help "specify size to match against" <> help "specify size to match against"
)) ))
<*> optinfo "mimetype" (strOption
( long "mimetype" <> metavar paramValue
<> help "specify mime type to match against"
))
optinfo datadesc mk = (Right <$> mk) optinfo datadesc mk = (Right <$> mk)
<|> (pure $ Left $ missingdata datadesc) <|> (pure $ Left $ missingdata datadesc)
missingdata datadesc = bail $ "cannot match this expression without " ++ datadesc ++ " data" missingdata datadesc = bail $ "cannot match this expression without " ++ datadesc ++ " data"
-- When a key is provided, use its size. -- When a key is provided, use its size.
addkeysize i@(MatchingInfo f (Right k) _) = case keySize k of addkeysize i@(MatchingInfo f (Right k) _ m) = case keySize k of
Just sz -> MatchingInfo f (Right k) (Right sz) Just sz -> MatchingInfo f (Right k) (Right sz) m
Nothing -> i Nothing -> i
addkeysize i = i addkeysize i = i
seek :: MatchExpressionOptions -> CommandSeek seek :: MatchExpressionOptions -> CommandSeek
seek o = do seek o = do
u <- getUUID parser <- if largeFilesExpression o
case parsedToMatcher $ preferredContentParser matchAll matchAll groupMap M.empty (Just u) (matchexpr o) of then mkLargeFilesParser
else preferredContentParser
matchAll matchAll groupMap M.empty . Just <$> getUUID
case parsedToMatcher $ parser ((matchexpr o)) of
Left e -> liftIO $ bail $ "bad expression: " ++ e Left e -> liftIO $ bail $ "bad expression: " ++ e
Right matcher -> ifM (checkmatcher matcher) Right matcher -> ifM (checkmatcher matcher)
( liftIO exitSuccess ( liftIO exitSuccess

View file

@ -94,7 +94,7 @@ matchGlobFile glob = go
cglob = compileGlob glob CaseSensative -- memoized cglob = compileGlob glob CaseSensative -- memoized
go (MatchingKey _) = pure False go (MatchingKey _) = pure False
go (MatchingFile fi) = pure $ matchGlob cglob (matchFile fi) go (MatchingFile fi) = pure $ matchGlob cglob (matchFile fi)
go (MatchingInfo af _ _) = matchGlob cglob <$> getInfo af go (MatchingInfo af _ _ _) = matchGlob cglob <$> getInfo af
#ifdef WITH_MAGICMIME #ifdef WITH_MAGICMIME
matchMagic :: Magic -> MkLimit Annex matchMagic :: Magic -> MkLimit Annex
@ -102,10 +102,9 @@ matchMagic magic glob = Right $ const go
where where
cglob = compileGlob glob CaseSensative -- memoized cglob = compileGlob glob CaseSensative -- memoized
go (MatchingKey _) = pure False go (MatchingKey _) = pure False
go (MatchingFile fi) = check (matchFile fi) go (MatchingFile fi) = liftIO $ catchBoolIO $
go (MatchingInfo af _ _) = check =<< getInfo af matchGlob cglob <$> magicFile magic (matchFile fi)
check f = liftIO $ catchBoolIO $ go (MatchingInfo _ _ _ mimeval) = matchGlob cglob <$> getInfo mimeval
matchGlob cglob <$> magicFile magic f
#endif #endif
{- Adds a limit to skip files not believed to be present {- Adds a limit to skip files not believed to be present
@ -151,7 +150,7 @@ limitInDir dir = const go
where where
go (MatchingFile fi) = checkf $ matchFile fi go (MatchingFile fi) = checkf $ matchFile fi
go (MatchingKey _) = return False go (MatchingKey _) = return False
go (MatchingInfo af _ _) = checkf =<< getInfo af go (MatchingInfo af _ _ _) = checkf =<< getInfo af
checkf = return . elem dir . splitPath . takeDirectory checkf = return . elem dir . splitPath . takeDirectory
{- Adds a limit to skip files not believed to have the specified number {- Adds a limit to skip files not believed to have the specified number
@ -197,7 +196,7 @@ limitLackingCopies approx want = case readish want of
else case mi of else case mi of
MatchingFile fi -> getGlobalFileNumCopies $ matchFile fi MatchingFile fi -> getGlobalFileNumCopies $ matchFile fi
MatchingKey _ -> approxNumCopies MatchingKey _ -> approxNumCopies
MatchingInfo _ _ _ -> approxNumCopies MatchingInfo _ _ _ _ -> approxNumCopies
us <- filter (`S.notMember` notpresent) us <- filter (`S.notMember` notpresent)
<$> (trustExclude UnTrusted =<< Remote.keyLocations key) <$> (trustExclude UnTrusted =<< Remote.keyLocations key)
return $ numcopies - length us >= needed return $ numcopies - length us >= needed
@ -211,7 +210,7 @@ limitLackingCopies approx want = case readish want of
limitUnused :: MatchFiles Annex limitUnused :: MatchFiles Annex
limitUnused _ (MatchingFile _) = return False limitUnused _ (MatchingFile _) = return False
limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys
limitUnused _ (MatchingInfo _ ak _) = do limitUnused _ (MatchingInfo _ ak _ _) = do
k <- getInfo ak k <- getInfo ak
S.member k <$> unusedKeys S.member k <$> unusedKeys
@ -266,7 +265,7 @@ limitSize vs s = case readSize dataUnits s of
where where
go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz
go sz _ (MatchingKey key) = checkkey sz key go sz _ (MatchingKey key) = checkkey sz key
go sz _ (MatchingInfo _ _ as) = go sz _ (MatchingInfo _ _ as _) =
getInfo as >>= \sz' -> return (Just sz' `vs` Just sz) getInfo as >>= \sz' -> return (Just sz' `vs` Just sz)
checkkey sz key = return $ keySize key `vs` Just sz checkkey sz key = return $ keySize key `vs` Just sz
check _ sz (Just key) = checkkey sz key check _ sz (Just key) = checkkey sz key
@ -309,4 +308,4 @@ lookupFileKey = lookupFile . currFile
checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
checkKey a (MatchingKey k) = a k checkKey a (MatchingKey k) = a k
checkKey a (MatchingInfo _ ak _) = a =<< getInfo ak checkKey a (MatchingInfo _ ak _ _) = a =<< getInfo ak

View file

@ -19,7 +19,9 @@ import qualified Data.Set as S
data MatchInfo data MatchInfo
= MatchingFile FileInfo = MatchingFile FileInfo
| MatchingKey Key | MatchingKey Key
| MatchingInfo (OptInfo FilePath) (OptInfo Key) (OptInfo FileSize) | MatchingInfo (OptInfo FilePath) (OptInfo Key) (OptInfo FileSize) (OptInfo MimeType)
type MimeType = String
data FileInfo = FileInfo data FileInfo = FileInfo
{ currFile :: FilePath { currFile :: FilePath

2
debian/changelog vendored
View file

@ -15,6 +15,8 @@ git-annex (6.20160127) UNRELEASED; urgency=medium
or "lackingcopies", etc. or "lackingcopies", etc.
* annex.largefiles: Add support for mimetype=text/* etc, when git-annex * annex.largefiles: Add support for mimetype=text/* etc, when git-annex
is linked with libmagic. is linked with libmagic.
* matchexpression: Added --largefiles option to parse an annex.largefiles
expression.
-- Joey Hess <id@joeyh.name> Thu, 28 Jan 2016 13:53:09 -0400 -- Joey Hess <id@joeyh.name> Thu, 28 Jan 2016 13:53:09 -0400

View file

@ -1,6 +1,6 @@
# NAME # NAME
git-annex matchexpression - checks if a preferred content expression matches git-annex matchexpression - checks if an expression matches
# SYNOPSIS # SYNOPSIS
@ -8,7 +8,7 @@ git annex matchexpression `expression [data]`
# DESCRIPTION # DESCRIPTION
This plumbing-level command is given a prefferred content expression, This plumbing-level command is given a preferred content expression,
and some data, and checks if the expression matches the data. It exits 0 if and some data, and checks if the expression matches the data. It exits 0 if
it matches, and 1 if not. If not enough data was provided, it displays an it matches, and 1 if not. If not enough data was provided, it displays an
error and exits with special code 42. error and exits with special code 42.
@ -38,6 +38,16 @@ For example, this will exit 0:
Many keys have a known size, and so --size is not needed when specifying Many keys have a known size, and so --size is not needed when specifying
such a key. such a key.
* `--largefiles`
Parse the expression as an annex.largefiles expression, rather than a
preferred content expression.
* `--mimetype=`
Tell what the mime type of the file is. Only needed when using
--largefiles with a mimetype= expression.
# SEE ALSO # SEE ALSO
[[git-annex]](1) [[git-annex]](1)