From 2ec349a18d96ba41bae98ac94830f9b8d8fa2598 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Mar 2011 14:38:34 -0400 Subject: Add version command to show git-annex version as well as repository version information. (cherry picked from commit 828a84ba3341d4b7a84292d8b9002a8095dd2382) Conflicts: GitAnnex.hs Upgrade.hs Version.hs debian/changelog --- Command/Version.hs | 37 +++++++++++++++++++++++++++++++++++++ GitAnnex.hs | 2 ++ Upgrade.hs | 5 ++++- Version.hs | 13 +++++++++---- configure.hs | 13 ++++++++++++- debian/changelog | 2 ++ doc/git-annex.mdwn | 4 ++++ 7 files changed, 70 insertions(+), 6 deletions(-) create mode 100644 Command/Version.hs diff --git a/Command/Version.hs b/Command/Version.hs new file mode 100644 index 000000000..4d18469c6 --- /dev/null +++ b/Command/Version.hs @@ -0,0 +1,37 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Version where + +import Control.Monad.State (liftIO) +import Data.String.Utils + +import Command +import qualified SysConfig +import Version +import Upgrade + +command :: [Command] +command = [Command "version" paramNothing seek "show versions"] + +seek :: [CommandSeek] +seek = [withNothing start] + +start :: CommandStartNothing +start = do + liftIO $ putStrLn $ "git-annex version: " ++ SysConfig.packageversion + v <- getVersion + let v' = case v of + Just s -> s + Nothing -> "unknown" + liftIO $ putStrLn $ "local repository version: " ++ v' + liftIO $ putStrLn $ "default repository version: " ++ defaultVersion + liftIO $ putStrLn $ "supported repository versions: " ++ vs supportedVersions + liftIO $ putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions + return Nothing + where + vs l = join " " l diff --git a/GitAnnex.hs b/GitAnnex.hs index da91f6e74..f9bdec6ba 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -41,6 +41,7 @@ import qualified Command.Trust import qualified Command.Untrust import qualified Command.Semitrust import qualified Command.Map +import qualified Command.Version cmds :: [Command] cmds = concat @@ -70,6 +71,7 @@ cmds = concat , Command.Whereis.command , Command.Migrate.command , Command.Map.command + , Command.Version.command ] options :: [Option] diff --git a/Upgrade.hs b/Upgrade.hs index 3c16bcc86..22120b093 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -24,6 +24,9 @@ import Messages import Version import Utility +upgradableVersions :: [Version] +upgradableVersions = ["0"] + {- Uses the annex.version git config setting to automate upgrades. -} upgrade :: Annex Bool upgrade = do @@ -31,7 +34,7 @@ upgrade = do case version of Just "0" -> upgradeFrom0 Nothing -> return True -- repo not initted yet, no version - Just v | v == currentVersion -> return True + Just v | v `elem` supportedVersions -> return True Just _ -> error "this version of git-annex is too old for this git repository!" upgradeFrom0 :: Annex Bool diff --git a/Version.hs b/Version.hs index 9e31d3c9e..18a9e18f8 100644 --- a/Version.hs +++ b/Version.hs @@ -15,13 +15,18 @@ import qualified Annex import qualified GitRepo as Git import Locations -currentVersion :: String -currentVersion = "1" +type Version = String + +defaultVersion :: Version +defaultVersion = "1" + +supportedVersions :: [Version] +supportedVersions = [defaultVersion] versionField :: String versionField = "annex.version" -getVersion :: Annex (Maybe String) +getVersion :: Annex (Maybe Version) getVersion = do g <- Annex.gitRepo let v = Git.configGet g versionField "" @@ -38,4 +43,4 @@ getVersion = do else return Nothing -- no version yet setVersion :: Annex () -setVersion = Annex.setConfig versionField currentVersion +setVersion = Annex.setConfig versionField defaultVersion diff --git a/configure.hs b/configure.hs index 772ba5489..6ebaf00a8 100644 --- a/configure.hs +++ b/configure.hs @@ -7,7 +7,8 @@ import TestConfig tests :: [TestCase] tests = [ - testCp "cp_a" "-a" + TestCase "version" $ getVersion + , testCp "cp_a" "-a" , testCp "cp_p" "-p" , testCp "cp_reflink_auto" "--reflink=auto" , TestCase "uuid generator" $ selectCmd "uuid" ["uuid", "uuidgen"] @@ -48,6 +49,16 @@ unicodeFilePath = do let file = head $ filter (isInfixOf "unicode-test") fs return $ Config "unicodefilepath" (BoolConfig $ isInfixOf "ΓΌ" file) +{- Pulls package version out of the changelog. -} +getVersion :: Test +getVersion = do + changelog <- readFile "debian/changelog" + let verline = head $ lines changelog + let version = middle (words verline !! 1) + return $ Config "packageversion" (StringConfig version) + where + middle s = drop 1 $ take (length s - 1) s + setup :: IO () setup = do createDirectoryIfMissing True tmpDir diff --git a/debian/changelog b/debian/changelog index 893b613be..bfde82af2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,8 @@ git-annex (0.25) UNRELEASED; urgency=low * Fix dropping of files using the URL backend. * Fix support for remotes with '.' in their names. + * Add version command to show git-annex version as well as repository + version information. -- Joey Hess Thu, 17 Mar 2011 11:46:53 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4998a6491..797b0f8a3 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -267,6 +267,10 @@ Many git-annex commands will stage changes for later `git commit` by you. git annex setkey --backend=WORM --key=1287765018:3 /tmp/file +* version + + Shows the version of git-annex, as well as repository version information. + # OPTIONS * --force -- cgit v1.2.3