Source file debutil.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
(**************************************************************************************)
(*  Copyright (C) 2009 Pietro Abate <pietro.abate@pps.jussieu.fr>                     *)
(*  Copyright (C) 2009 Mancoosi Project                                               *)
(*                                                                                    *)
(*  This library is free software: you can redistribute it and/or modify              *)
(*  it under the terms of the GNU Lesser General Public License as                    *)
(*  published by the Free Software Foundation, either version 3 of the                *)
(*  License, or (at your option) any later version.  A special linking                *)
(*  exception to the GNU Lesser General Public License applies to this                *)
(*  library, see the COPYING file for more information.                               *)
(**************************************************************************************)

open ExtLib
open Dose_common
module Version = Dose_versioning.Debian

include Util.Logging (struct
  let label = "dose_deb.debutil"
end)

let get_source pkg =
  match pkg#source with
  | ("", None) -> (pkg#name, pkg#version)
  | (n, None) -> (n, pkg#version)
  | (n, Some v) -> (n, v)

(* the idea is : if the normalized version of the package is equal to
 * the source version, then add it to the table indexed by source version,
 * otherwise add it to the table indexed by package version *)
(* actually it should be sourceversion -> list of list of clusters grouped by
 * version *)
(* (source,sourceversion) -> [= packageversion -> (ref[pkg],realversion) =] *)

(** [group_by_source universe] returns a hashtbl that maps
    (source,sourceversion) -> to a packages list *)
let cluster packagelist =
  let th = Hashtbl.create (List.length packagelist) in
  List.iter
    (fun pkg ->
      let packageversion =
        Version.compose (Version.strip_epoch_binnmu pkg#version)
      in
      let realversion = Version.compose (Version.strip_epoch pkg#version) in
      let (source, sourceversion) = get_source pkg in
      try
        let h = Hashtbl.find th (source, sourceversion) in
        try
          let (l, hi_v) = Hashtbl.find h packageversion in
          l := pkg :: !l ;
          let new_hi =
            if Version.compare hi_v realversion < 0 then hi_v else realversion
          in
          (* keep the highest version of the cluster handy *)
          Hashtbl.replace h packageversion (l, new_hi)
        with Not_found ->
          (* found the source, but not the package version *)
          Hashtbl.add h packageversion (ref [pkg], realversion)
      with Not_found ->
        (* didn't found the source *)
        let h = Hashtbl.create 17 in
        Hashtbl.add h packageversion (ref [pkg], realversion) ;
        Hashtbl.add th (source, sourceversion) h)
    packagelist ;
  let h = Hashtbl.create (List.length packagelist) in
  let i = ref 0 in
  Hashtbl.iter
    (fun (s, v) thv ->
      let l =
        Hashtbl.fold
          (fun v ({ contents = l }, rv) acc -> (v, rv, l) :: acc)
          thv
          []
      in
      i := !i + List.length l ;
      Hashtbl.add h (s, v) l)
    th ;
  info "Packages: %d" (List.length packagelist) ;
  info "Source Clusters: %d" (Hashtbl.length h) ;
  info "Binary (effective) Clusters: %d" !i ;
  h