On Sat, Feb 12, 2011 at 02:25:56PM +0100, Peter Hercek wrote: > On 02/11/2011 12:38 PM, Peter Simons wrote: > >your recent update of the i686 tree screwed up the symlinks for 'repo.db' > >again, which in turn broke my build. Furthermore, you've again deleted older > >versions of the updated packages even though I repeatedly asked you not to. > > Is there a local access and is the naming policy strict enough so > that the removal of the old packages can be handled by a simple > script over the text listing of the repository directory?
Yes, there is local access, and yes it's easy to extract version info from the filenames alone. I've attached a script I use to list *all* old versions of all packages in a directory; my typical usage is "rm `repo-tidy`". > If so then lets just write a script which keeps the last two > versions of everything. Feel free to modify the script. > I already proposed this but there was no response and it looks like > it is still an issue. Well, to be rather blunt, it's an issue I don't care about at all, so I was waiting for someone who cares to hack it up :-) /M -- Magnus Therning OpenPGP: 0xAB4DFBA4 email: [email protected] jabber: [email protected] twitter: magthe http://therning.org/magnus
#! /usr/bin/env runhaskell
module Main where
import System.Directory
import Control.Monad
import Data.List
import System.FilePath
import Distribution.Text
import Distribution.Version
import Data.Maybe
import qualified Data.Map as M
main = do
files <- getDirectoryContents "." >>= filterM doesFileExist
let pkgs = map splitFilename $ filter (isSuffixOf ".pkg.tar.xz") files
let pkgmap = makeMap pkgs
let mpkgs = M.filter ((> 1) . length) pkgmap
mapM_ printToRemove $ M.elems mpkgs
data ArchPkg = ArchPkg
{ apFileName :: FilePath
, apPackage :: String
, apVersion :: Maybe Version
, apRelease :: Int
, apArch :: String
} deriving (Eq, Show)
splitFilename fn = ArchPkg { apFileName = fn, apPackage = reverse pkg,
apVersion = simpleParse $ reverse ver, apRelease = read $ reverse rel, apArch =
reverse arch }
where
revfnnoext = reverse $ (iterate dropExtension fn) !! 3
(arch, (_:r1)) = break (== '-') revfnnoext
(rel, (_:r2)) = break (== '-') r1
(ver, (_:r3)) = break (== '-') r2
pkg = r3
makeMap pkgs = mm M.empty pkgs
where
mm m [] = m
mm m (pkg:rest) = mm (M.insertWith' (++) (apPackage pkg) [pkg] m) rest
cmpAP a b = let
verCmp = compare (apVersion a) (apVersion b)
relCmp = compare (apRelease a) (apRelease b)
in if verCmp /= EQ
then verCmp
else relCmp
printToRemove ps = mapM_ (putStrLn . apFileName) (tail $ reverse $ sortBy cmpAP
ps)
-- vim: set ft=haskell :
pgpyo2x3sdRsb.pgp
Description: PGP signature
_______________________________________________ arch-haskell mailing list [email protected] http://www.haskell.org/mailman/listinfo/arch-haskell
