[Pkg-haskell-commits] [tools] 03/07: With SQL, fetch packages from unstable and buildd-unstable in one go

[Joachim Breitner]

This is an automated email from the git hooks/post-receive script.

nomeata pushed a commit to branch master
in repository tools.

commit 1ed4e9acbbb3b21fa2ca2cde213f5d36c048be36
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Sep 10 16:58:09 2014 +0200

    With SQL, fetch packages from unstable and buildd-unstable in one go
---
 binNMUs.hs | 30 ++++++++++++++++--------------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/binNMUs.hs b/binNMUs.hs
index 5b8af5e..1a7db60 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -372,12 +372,16 @@ splitSrc sf =
         [s]          -> (s, Nothing)
         _ -> error $ printf "Failed to parse source field %s" sf
 
--- | Fetches packages for this arch, overlaying sid with buildd-sid
 fetchArchive :: Conf -> Arch -> IO [Binary]
-fetchArchive conf a = do
-    pkgs1 <- acquirePackages conf "buildd-unstable" a
+fetchArchive c | sql c     = fetchArchiveSQL c
+               | otherwise = fetchArchiveHTTP c
+
+-- | Fetches packages for this arch, overlaying sid with buildd-sid
+fetchArchiveHTTP :: Conf -> Arch -> IO [Binary]
+fetchArchiveHTTP conf a = do
+    pkgs1 <- acquirePackagesHTTP conf "buildd-unstable" a
     let pkg1_names = S.fromList (map bPkgName pkgs1)
-    pkgs2 <- acquirePackages conf "unstable" a
+    pkgs2 <- acquirePackagesHTTP conf "unstable" a
     let pkgs2' = [ p | p <- pkgs2 , bPkgName p `S.notMember` pkg1_names ]
     return $ pkgs1 ++ pkgs2'
 
@@ -391,21 +395,16 @@ acquireFile' conf url = do
   where o = offline conf
         q = o || quiet conf
 
-
-acquirePackages :: Conf -> String -> Arch -> IO [Binary]
-acquirePackages c | sql c     = acquirePackagesSQL c
-                  | otherwise = acquirePackagesHTTP c
-
 type Row = (String, String, String, String, String, B.ByteString, B.ByteString)
 
-acquirePackagesSQL :: Conf -> String -> Arch -> IO [Binary]
-acquirePackagesSQL conf suite arch = do
+fetchArchiveSQL :: Conf -> Arch -> IO [Binary]
+fetchArchiveSQL conf arch = do
 #ifdef SQL
-    unless q $ hPutStr stderr $ printf "Querying projectb database for suite %s arch %s ..." suite arch
+    unless q $ hPutStr stderr $ printf "Querying projectb database for arch %s ..." arch
     unless q $ hFlush stderr
     conn <- connectPostgreSQL (B.pack "service=projectb")
     -- conn <- connect (ConnectInfo "localhost" 5434 "guest" "" "projectb")
-    rows <- query conn fetchBins [suite, arch, r, r]
+    rows <- query conn fetchBins [arch, r, r]
     close conn
     let bins = mapMaybe (rowToBinary conf) rows
     unless q $ hPutStrLn  stderr $ " done"
@@ -416,6 +415,7 @@ acquirePackagesSQL conf suite arch = do
 
 fetchBins = Query $ B.pack $ "\
     \SELECT    \
+    \    DISTINCT ON (package) \
     \    package,    \
     \    binaries.version::text,    \
     \    arch_string ,    \
@@ -434,9 +434,11 @@ fetchBins = Query $ B.pack $ "\
     \    JOIN metadata_keys pmk ON pmk.key = 'Provides'    \
     \    LEFT OUTER JOIN binaries_metadata pm ON pm.bin_id = binaries.id AND pmk.key_id = pm.key_id    \
     \WHERE    \
-    \    suite.suite_name = ?   \
+    \    suite.suite_name IN ('unstable', 'buildd-unstable')   \
     \    AND arch_string = ?    \
     \    AND (dm.value ~ ? OR pm.value ~ ? )    \
+    \ORDER BY \
+    \    package, binaries.version DESC \
     \"
 
 #else

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/tools.git