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
|
(**************************************************************************)
(* *)
(* Copyright (C) 2012 Johannes 'josch' Schauer <j.schauer@email.de> *)
(* *)
(* 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
open Dose_debian
open Dose_doseparse
#define __label __FILE__
let label = __label ;;
include Util.Logging(struct let label = label end) ;;
module Options = struct
open OptParse
let description = ("Given a srcgraph, collapse all strongly connected components to a single vertex")
let usage = "%prog srcgraph.xml Packages Soucres"
let options = OptParser.make ~description ~usage
include BootstrapCommon.MakeOptions(struct let options = options end)
include StdOptions.InputOptions;;
let default = List.filter (fun e -> not (List.mem e ["compare"; "checkonly"; "latest";"outfile";"inputtype"])) StdOptions.InputOptions.default_options in
StdOptions.InputOptions.add_options ~default options ;;
include StdOptions.DistribOptions;;
let default = List.filter (fun e -> not (List.mem e ["deb-profiles"; "deb-ignore-essential"; "deb-builds-from"])) StdOptions.DistribOptions.default_options in
StdOptions.DistribOptions.add_debian_options ~default options ;;
end
let main () =
let posargs = OptParse.OptParser.parse_argv Options.options in
StdDebug.enable_debug (OptParse.Opt.get Options.verbose);
Util.Debug.disable "Depsolver_int";
StdDebug.all_quiet (OptParse.Opt.get Options.quiet);
let options = Options.set_deb_options () in
let noindep = options.Debcudf.drop_bd_indep in
let buildarch = Option.get options.Debcudf.native in
let hostarch = match options.Debcudf.host with None -> "" | Some s -> s in
let foreignarchs = options.Debcudf.foreign in
let sgf, posargs = match posargs with
| sgf::posargs -> sgf,posargs
| _ -> fatal "require srcgraph.xml Packages Sources"
in
let (binlist, (fgsrclist,bgsrclist), _) = BootstrapCommon.parse_packages ~noindep Options.parse_cmdline buildarch hostarch foreignarchs posargs in
let tables = Debcudf.init_tables (fgsrclist@bgsrclist@binlist) in
let fgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) fgsrclist in
let bgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) bgsrclist in
let pkglist = List.map (Debcudf.tocudf ?inst:None ~options tables) binlist in
let universe = Cudf.load_universe (BootstrapCommon.unique [pkglist;fgsl;bgsl]) in
let ic = open_in sgf in
let sg = SrcGraph.from_ic universe buildarch ic in
close_in ic;
let module SGE = SrcGraphExtras.Make(struct let univ = universe end) in
if SrcGraph.Dfs.has_cycle sg then SGE.collapse_scc sg
else info "srcgraph is acyclic. Nothing to do.";
let module SGP = SrcGraph.Printer(struct let univ = universe end) in
SGP.print (Format.formatter_of_out_channel stdout) sg;
;;
main ();;
|
