This commit is contained in:
Joey Hess 2010-10-14 20:05:04 -04:00
parent b8ba60428a
commit 4c3ad80f32
6 changed files with 26 additions and 22 deletions

View file

@ -78,17 +78,9 @@ retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
removeKey :: Backend -> Key -> Annex Bool removeKey :: Backend -> Key -> Annex Bool
removeKey backend key = (B.removeKey backend) key removeKey backend key = (B.removeKey backend) key
{- Checks if any backend has a key. -} {- Checks if a backend has its key. -}
hasKey :: Key -> Annex Bool hasKey :: Key -> Annex Bool
hasKey key = do hasKey key = (B.hasKey (lookupBackendName $ backendName key)) key
b <- backendList
hasKey' b key
hasKey' [] key = return False
hasKey' (b:bs) key = do
has <- (B.hasKey b) key
if (has)
then return True
else hasKey' bs key
{- Looks up the key and backend corresponding to an annexed file, {- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -} - by examining what the file symlinks to. -}
@ -101,6 +93,8 @@ lookupFile file = do
where where
lookup = do lookup = do
l <- readSymbolicLink file l <- readSymbolicLink file
return $ Just (k l, b l) return $ Just $ pair $ takeFileName l
k l = fileKey $ takeFileName $ l pair file = (k, b)
b l = lookupBackendName $ takeFileName $ parentDir $ l where
k = fileKey file
b = lookupBackendName $ backendName k

View file

@ -3,7 +3,8 @@
module Backend.Url (backend) where module Backend.Url (backend) where
import Control.Monad.State import Control.Monad.State (liftIO)
import Data.String.Utils
import System.Cmd import System.Cmd
import System.Exit import System.Exit
import BackendTypes import BackendTypes
@ -30,9 +31,11 @@ dummyOk :: Key -> Annex Bool
dummyOk url = return True dummyOk url = return True
downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl :: Key -> FilePath -> Annex Bool
downloadUrl url file = do downloadUrl key file = do
liftIO $ putStrLn $ "download: " ++ (show url) liftIO $ putStrLn $ "download: " ++ url
result <- liftIO $ rawSystem "curl" ["-#", "-o", file, (show url)] result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url]
if (result == ExitSuccess) if (result == ExitSuccess)
then return True then return True
else return False else return False
where
url = join ":" $ drop 1 $ split ":" $ show key

View file

@ -28,7 +28,7 @@ parseBackendList s =
then supportedBackends then supportedBackends
else map (lookupBackendName) $ words s else map (lookupBackendName) $ words s
{- Looks up a supported backed by name. -} {- Looks up a supported backend by name. -}
lookupBackendName :: String -> Backend lookupBackendName :: String -> Backend
lookupBackendName s = lookupBackendName s =
if ((length matches) /= 1) if ((length matches) /= 1)

View file

@ -36,6 +36,14 @@ instance Read Key where
b = l !! 0 b = l !! 0
k = join ":" $ drop 1 l k = join ":" $ drop 1 l
-- pulls the backend name out
backendName :: Key -> BackendName
backendName (Key (b,k)) = b
-- pulls the key fragment out
keyFrag :: Key -> KeyFrag
keyFrag (Key (b,k)) = k
-- this structure represents a key/value backend -- this structure represents a key/value backend
data Backend = Backend { data Backend = Backend {
-- name of this backend -- name of this backend

3
TODO
View file

@ -1,9 +1,6 @@
* bug when annexing files while in a subdir of a git repo * bug when annexing files while in a subdir of a git repo
* bug when specifying absolute path to files when annexing * bug when specifying absolute path to files when annexing
* need to include backend name as part of the key, because currently
if two backends have overlapping key spaces, it can confuse things
* --push/--pull/--want * --push/--pull/--want
* how to handle git mv file? * how to handle git mv file?

View file

@ -3,8 +3,10 @@
module Types ( module Types (
Annex, Annex,
AnnexState, AnnexState,
Backend,
Key, Key,
Backend backendName,
keyFrag
) where ) where
import BackendTypes import BackendTypes