hg-buildpackage-1.0.4: hg-importdsc.hs

{- Copyright (c) 2007 John Goerzen <jgoerzen@complete.org>
   Please see the COPYRIGHT file -}

import System.Console.GetOpt
import System.Console.GetOpt.Utils
import Utils
import HSH
import Text.Printf
import Control.Monad
import System.Path
import Types
import System.Posix.Env

helpinfo = "Usage:\n\
\hg-importdsc [-v] [-s n] dscname\n\
\\n\
\The source package will be imported into ../${package}.upstream (if it has\n\
\an upstream component) and the current working directory\n\
\\n\
\Where:\n\
\\n\
\  dscname is the name of a dsc file to import\n"

crashusage = die 5 $ usageInfo helpinfo importargs

main = 
  do (args, files) <- parseCmdLine RequireOrder importargs helpinfo
     let isverbose = (Verbose `elem` args)
     when isverbose setverbose
     let verbargs = if isverbose then ["-v"] else []
     (dscname) <- case files of
                    [x] -> return x
                    _ -> crashusage

     package <- runSL $ catFrom [dscname] -|- dsc2control -|- getcontrolsource
     version <- runSL $ catFrom [dscname] -|- dsc2control -|- 
                getcontrolversion

     let tag = Tag "DEBIAN" package version
               
     assertvalidhg "."
     hastag tag >>= (flip when) (die 0 $
            printf "Version %s already exists; skipping all imports." version)

     istagok tag >>= (flip unless) (die 1 $
            printf "Verion %s is not newer than all Debian versions; aborting."
                   version)

     hasupstream <- dschasupstream dscname
     when hasupstream (procupstream args verbargs dscname tag)

     putStrLn $ " *** Processing Debian source tree for " ++ dscname

     lines <- runSL $ "hg status" -|- wcL
     when (lines /= "0") $ die 1 $
          "Error: Working directory has uncommitted changes.  Aborting\n\
          \before merge for safety."

     when hasupstream (pullupstream dscname tag)

     brackettmpdir "../,,hg-importdsc-XXXXXX" 
                       (procdsc args verbargs dscname tag)

procupstream args verbargs dscname tag =
    do upstreamrepo <- readlinkabs (printf "../%s.upstream" (tag2pkg tag))
       assertvalidhg upstreamrepo
       v $ "Upstream detected at " ++ upstreamrepo

       upstreamname <- runSL (dscgetfile dscname "\\.orig\\.tar\\.gz$")
       let upstreamfn = dirname dscname ++ "/" ++ upstreamname

       putStrLn $ " *** Processing upstream file " ++ upstreamfn
       runIO ("hg-importorig", (concat . map importopt2arg $ args) ++
              [upstreamfn, tag2pkg tag, tag2upsver tag])
       putStrLn $ " *** Done processing upstream file " ++ upstreamfn

pullupstream dscname tag =
    do upstreamrepo <- readlinkabs (printf "../%s.upstream" (tag2pkg tag))
       result <- run $ ("hg", ["-q", "incoming", upstreamrepo])
       if result /= (0::Int)
          then putStrLn "No patches to pull from upstream; skipping this step."
          else do runIO $ ("hg", ["pull", upstreamrepo])
                  procpull upstreamrepo tag

procpull upstreamrepo tag =
    do heads <- runSL $ "hg -q heads" -|- wcL
       if heads == "2"
          then do putEnv $ "HGMERGE=" ++ hglibdir ++ "/hgmerge-debupstream"
                  runIO ("hg", ["merge", tag2upsstr tag ++ "_TAG"])
                  runIO ("hg", ["commit", "-m", "Merged upstream " ++
                                tag2upsver tag ++ " into Debian branch"])
          else runIO "hg update"
                              
procdsc args verbargs dscname tag tmpdir =
    do absname <- readlinkabs dscname
       v $ "Unpacking " ++ absname ++ " into " ++ tmpdir
       bracketCWD tmpdir $ runIO $ ("dpkg-source", ["-x", absname])
       
       let srcdir = printf "%s/%s-%s" tmpdir (tag2pkg tag) (tag2upsver tag)
       v $ "Importing directory " ++ srcdir
       case [s | S s <- args] of
         [] -> runIO $ ("hg_load_dirs", verbargs ++
                ["--summary=Import Debian " ++ (tag2pkg tag) ++ " " ++
                (tag2ver tag), srcdir])
         (x:_) -> do runIO $ ("hg_load_dirs", verbargs ++ ["-n", "-f", srcdir])
                     runIO $ ("hg", verbargs ++ ["addremove", "-s", x])
                     runIO $ ("hg", verbargs ++ ["commit", "-m",
                      printf "Import Debian %s %s" (tag2pkg tag) (tag2ver tag)])
       runIO $ ("hg", ["tag", show tag])