% 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. \subsection{darcs dist} \begin{code} module Darcs.Commands.Dist ( dist ) where import System.Directory ( setCurrentDirectory ) import Workaround ( getCurrentDirectory ) import System.Exit ( ExitCode(..) ) import System.Cmd ( system ) import System.FilePath.Posix ( takeFileName, () ) import Data.Char ( isAlphaNum ) import Control.Monad ( when ) import Darcs.Commands ( DarcsCommand(DarcsCommand, command_name, command_help, command_description, command_extra_args, command_extra_arg_help, command_command, command_prereq, command_get_arg_possibilities, command_argdefaults, command_advanced_options, command_basic_options), nodefaults ) import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distname_option, working_repo_dir, match_one, store_in_memory, fixSubPaths ) import Darcs.Match ( get_nonrange_match, have_nonrange_match ) import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded, createPartialsPristineDirectoryTree ) import Darcs.Repository.Prefs ( get_prefval ) import Darcs.Lock ( withTemp, withTempDir, readBinFile ) import Darcs.RepoPath ( toFilePath ) import Darcs.Utils ( withCurrentDirectory ) import Exec ( exec, Redirect(..) ) \end{code} \options{dist} \haskell{dist_help} \begin{code} dist_description :: String dist_description = "Create a distribution tarball." dist_help :: String dist_help = "The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++ "the repository's root directory, containing the recorded state of the\n" ++ -- FIXME: _ is escaped to appease TeX while we wait for reST. "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" ++ -- FIXME: &s are escaped to appease TeX while we wait for reST. "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" -- FIXME: this is tedious and ugly. {- ++ "\n" ++ "Suppose you use a version numbering scheme `major.minor.patch', and\n" ++ "you tag each release `major.minor'. You can then calculate the\n" ++ "version number by taking the newest tag and appending a dot and the\n" ++ "number of patches since that tag. If you use the directory name as\n" ++ "the project name, you can make tarballs of the form name-version.tgz\n" ++ "using the following shell script:\n" ++ "\n" ++ " major_minor=$(darcs show tags | head -1) &&\n" ++ " patch_level=$(($(darcs changes --count --from-tag .) - 1)) &&\n" ++ " version=$major_minor.$patch_level &&\n" ++ " project=${PWD##*/} &&\n" ++ " darcs dist --dist-name \"$project\"-\"$version\".tar.gz\n" -} dist :: DarcsCommand dist = DarcsCommand {command_name = "dist", command_help = dist_help, command_description = dist_description, command_extra_args = 0, command_extra_arg_help = [], command_command = dist_cmd, command_prereq = amInRepository, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_advanced_options = [], command_basic_options = [distname_option, working_repo_dir, match_one, store_in_memory]} dist_cmd :: [DarcsFlag] -> [String] -> IO () dist_cmd opts args = withRepoReadLock opts $- \repository -> do distname <- get_dist_name opts verb <- return $ Verbose `elem` opts predist <- get_prefval "predist" formerdir <- getCurrentDirectory path_list <- if null args then return [""] else map toFilePath `fmap` fixSubPaths opts args resultfile <- return (formerdirdistname++".tar.gz") withTemp $ \tarfile -> withTempDir "darcsdist" $ \tempdir -> do setCurrentDirectory (formerdir) withTempDir (toFilePath tempdir takeFileName distname) $ \ddir -> do if have_nonrange_match opts then withCurrentDirectory ddir $ get_nonrange_match repository opts else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir) case predist of Nothing -> return ExitSuccess Just pd -> system pd 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 guess_repo_name :: IO String guess_repo_name = do pwd <- getCurrentDirectory if '/' `elem` pwd then return $ reverse $ takeWhile (/='/') $ reverse pwd else return "cantguessreponame" get_dist_name :: [DarcsFlag] -> IO String get_dist_name (DistName dn:_) = return dn get_dist_name (_:fs) = get_dist_name fs get_dist_name _ = guess_repo_name \end{code}