contentlocation, examinekey, lookupkey: Added --batch mode option.

This commit is contained in:
Joey Hess 2015-05-06 13:44:53 -04:00
parent 16fd222113
commit eeb0359a2e
8 changed files with 86 additions and 14 deletions

41
CmdLine/Batch.hs Normal file
View 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 ""

View file

@ -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

View file

@ -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

View file

@ -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
View file

@ -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

View file

@ -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)

View file

@ -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)

View file

@ -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)