% Copyright (C) 2003 David Roundy
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
\darcsCommand{dist}
\begin{code}
module Darcs.Commands.Dist ( dist ) where
import System.Directory ( setCurrentDirectory )
import Workaround ( getCurrentDirectory )
import System.Exit ( ExitCode(..), exitWith )
import System.Cmd ( system )
import System.FilePath.Posix ( takeFileName, (</>) )
import Data.Char ( isAlphaNum )
import Control.Monad ( when )
import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,
commandDescription, commandExtraArgs,
commandExtraArgHelp, commandCommand,
commandPrereq, commandGetArgPossibilities,
commandArgdefaults,
commandAdvancedOptions, commandBasicOptions),
nodefaults )
import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distnameOption,
workingRepoDir, matchOne, storeInMemory,
fixSubPaths )
import Darcs.Match ( getNonrangeMatch, haveNonrangeMatch )
import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,
createPartialsPristineDirectoryTree )
import Darcs.Repository.Prefs ( getPrefval )
import Darcs.Lock ( withTemp, withTempDir, readBinFile )
import Darcs.RepoPath ( AbsolutePath, toFilePath )
import Darcs.Utils ( withCurrentDirectory )
import Exec ( exec, Redirect(..) )
distDescription :: String
distDescription = "Create a distribution tarball."
distHelp :: String
distHelp =
"The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++
"the repository's root directory, containing the recorded state of the\n" ++
"working tree (unrecorded changes and the _darcs directory are\n" ++
"excluded).\n" ++
"\n" ++
"If a predist command is set (see `darcs setpref'), that command will\n" ++
"be run on the tarball contents prior to archiving. For example,\n" ++
"autotools projects would set it to `autoconf && automake'.\n" ++
"\n" ++
"By default, the tarball (and the top-level directory within the\n" ++
"tarball) has the same name as the repository, but this can be\n" ++
"overridden with the --dist-name option.\n"
dist :: DarcsCommand
dist = DarcsCommand {commandName = "dist",
commandHelp = distHelp,
commandDescription = distDescription,
commandExtraArgs = 0,
commandExtraArgHelp = [],
commandCommand = distCmd,
commandPrereq = amInRepository,
commandGetArgPossibilities = return [],
commandArgdefaults = nodefaults,
commandAdvancedOptions = [],
commandBasicOptions = [distnameOption,
workingRepoDir,
matchOne,
storeInMemory]}
distCmd :: [DarcsFlag] -> [String] -> IO ()
distCmd opts args = withRepoReadLock opts $- \repository -> do
distname <- getDistName opts
verb <- return $ Verbose `elem` opts
predist <- getPrefval "predist"
formerdir <- getCurrentDirectory
path_list <- if null args
then return [""]
else map toFilePath `fmap` fixSubPaths opts args
resultfile <- return (formerdir</>distname++".tar.gz")
withTemp $ \tarfile ->
withTempDir "darcsdist" $ \tempdir -> do
setCurrentDirectory (formerdir)
withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do
if haveNonrangeMatch opts
then withCurrentDirectory ddir $ getNonrangeMatch repository opts
else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
ec <- case predist of Nothing -> return ExitSuccess
Just pd -> system pd
if (ec == ExitSuccess) then doDist verb tarfile tempdir ddir resultfile
else
do
putStrLn "Dist aborted due to predist failure"
exitWith ec
doDist :: Bool -> FilePath -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()
doDist verb tarfile tempdir ddir resultfile = do
setCurrentDirectory (toFilePath tempdir)
exec "tar" ["-cf", "-", safename $ takeFileName $ toFilePath ddir]
(Null, File tarfile, AsIs)
when verb $ withTemp $ \tar_listing -> do
exec "tar" ["-tf", "-"]
(File tarfile, File tar_listing, Stdout)
to <- readBinFile tar_listing
putStr to
exec "gzip" ["-c"]
(File tarfile, File resultfile, AsIs)
putStrLn $ "Created dist as "++resultfile
where
safename n@(c:_) | isAlphaNum c = n
safename n = "./" ++ n
guessRepoName :: IO String
guessRepoName = do
pwd <- getCurrentDirectory
if '/' `elem` pwd
then return $ reverse $ takeWhile (/='/') $ reverse pwd
else return "cantguessreponame"
getDistName :: [DarcsFlag] -> IO String
getDistName (DistName dn:_) = return dn
getDistName (_:fs) = getDistName fs
getDistName _ = guessRepoName
\end{code}