contentlocation, examinekey, lookupkey: Added --batch mode option.
This commit is contained in:
parent
16fd222113
commit
eeb0359a2e
8 changed files with 86 additions and 14 deletions
41
CmdLine/Batch.hs
Normal file
41
CmdLine/Batch.hs
Normal file
|
@ -0,0 +1,41 @@
|
|||
{- git-annex batch commands
|
||||
-
|
||||
- Copyright 2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module CmdLine.Batch where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
|
||||
batchOption :: Option
|
||||
batchOption = flagOption [] "batch" "enable batch mode"
|
||||
|
||||
data BatchMode = Batch | NoBatch
|
||||
type Batchable t = BatchMode -> t -> CommandStart
|
||||
|
||||
-- A Batchable command can run in batch mode, or not.
|
||||
-- In batch mode, one line at a time is read, parsed, and a reply output to
|
||||
-- stdout. In non batch mode, the command's parameters are parsed and
|
||||
-- a reply output for each.
|
||||
batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek
|
||||
batchable seeker starter params = ifM (getOptionFlag batchOption)
|
||||
( batchloop
|
||||
, seeker (starter NoBatch) params
|
||||
)
|
||||
where
|
||||
batchloop = do
|
||||
mp <- liftIO $ catchMaybeIO getLine
|
||||
case mp of
|
||||
Nothing -> return ()
|
||||
Just p -> do
|
||||
seeker (starter Batch) [p]
|
||||
batchloop
|
||||
|
||||
-- bad input is indicated by an empty line in batch mode. In non batch
|
||||
-- mode, exit on bad input.
|
||||
batchBadInput :: BatchMode -> Annex ()
|
||||
batchBadInput NoBatch = liftIO exitFailure
|
||||
batchBadInput Batch = liftIO $ putStrLn ""
|
|
@ -9,19 +9,20 @@ module Command.ContentLocation where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import Annex.Content
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noCommit $ noMessages $
|
||||
cmd = [withOptions [batchOption] $ noCommit $ noMessages $
|
||||
command "contentlocation" (paramRepeating paramKey) seek
|
||||
SectionPlumbing "looks up content for a key"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withKeys start
|
||||
seek = batchable withKeys start
|
||||
|
||||
start :: Key -> CommandStart
|
||||
start k = do
|
||||
liftIO . maybe exitFailure putStrLn
|
||||
start :: Batchable Key
|
||||
start batchmode k = do
|
||||
maybe (batchBadInput batchmode) (liftIO . putStrLn)
|
||||
=<< inAnnex' (pure True) Nothing check k
|
||||
stop
|
||||
where
|
||||
|
|
|
@ -9,21 +9,22 @@ module Command.ExamineKey where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import qualified Utility.Format
|
||||
import Command.Find (formatOption, getFormat, showFormatted, keyVars)
|
||||
import Types.Key
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $
|
||||
cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
|
||||
command "examinekey" (paramRepeating paramKey) seek
|
||||
SectionPlumbing "prints information from a key"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek ps = do
|
||||
format <- getFormat
|
||||
withKeys (start format) ps
|
||||
batchable withKeys (start format) ps
|
||||
|
||||
start :: Maybe Utility.Format.Format -> Key -> CommandStart
|
||||
start format key = do
|
||||
start :: Maybe Utility.Format.Format -> Batchable Key
|
||||
start format _ key = do
|
||||
showFormatted format (key2file key) (keyVars key)
|
||||
stop
|
||||
|
|
|
@ -9,18 +9,20 @@ module Command.LookupKey where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import Annex.CatFile
|
||||
import Types.Key
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [notBareRepo $ noCommit $ noMessages $
|
||||
cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
|
||||
command "lookupkey" (paramRepeating paramFile) seek
|
||||
SectionPlumbing "looks up key used for file"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withStrings start
|
||||
seek = batchable withStrings start
|
||||
|
||||
start :: String -> CommandStart
|
||||
start file = do
|
||||
liftIO . maybe exitFailure (putStrLn . key2file) =<< catKeyFile file
|
||||
start :: Batchable String
|
||||
start batchmode file = do
|
||||
maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
|
||||
=<< catKeyFile file
|
||||
stop
|
||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -30,6 +30,7 @@ git-annex (5.20150421) UNRELEASED; urgency=medium
|
|||
* Work around wget bug #784348 which could cause it to clobber git-annex
|
||||
symlinks when downloading from ftp.
|
||||
* Support checking ftp urls for file presence.
|
||||
* contentlocation, examinekey, lookupkey: Added --batch mode option.
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Tue, 21 Apr 2015 15:54:10 -0400
|
||||
|
||||
|
|
|
@ -16,6 +16,17 @@ Note that in direct mode, the file will typically be in the git work
|
|||
tree, and while its content should correspond to the key, the file
|
||||
could become modified at any time after git-annex checks it.
|
||||
|
||||
# OPTIONS
|
||||
|
||||
* `--batch`
|
||||
|
||||
Enable batch mode, in which a line containing the key is read from
|
||||
stdin, the filename to its content is output to stdout (with a trailing
|
||||
newline), and repeat.
|
||||
|
||||
Note that if a key's content is not present, an empty line is output to
|
||||
stdout instead.
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
[[git-annex]](1)
|
||||
|
|
|
@ -33,6 +33,11 @@ that can be determined purely by looking at the key.
|
|||
Enable JSON output. This is intended to be parsed by programs that use
|
||||
git-annex. Each line of output is a JSON object.
|
||||
|
||||
* `--batch`
|
||||
|
||||
Enable batch mode, in which a line containing a key is read from stdin,
|
||||
the information about it is output to stdout, and repeat.
|
||||
|
||||
# EXAMPLES
|
||||
|
||||
The location a key's value is stored (in indirect mode)
|
||||
|
|
|
@ -13,6 +13,16 @@ index. The key is output to stdout. If there is no key (because
|
|||
the file is not present in the index, or is not a git-annex managed file),
|
||||
nothing is output, and it exits nonzero.
|
||||
|
||||
# OPTIONS
|
||||
|
||||
* `--batch`
|
||||
|
||||
Enable batch mode, in which a line containing the filename is read from
|
||||
stdin, the key is output to stdout (with a trailing newline), and repeat.
|
||||
|
||||
Note that is there is no key corresponding to the file, an empty line is
|
||||
output to stdout instead.
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
[[git-annex]](1)
|
||||
|
|
Loading…
Reference in a new issue