let outdated
?(dump=false)
?(failure=false)
?(explain=false)
?(summary=false)
?(checklist=None)
?options repository =
let worktable = Hashtbl.create 1024 in
let version_acc = ref [] in
let constraints_table = Debian.Evolution.constraints repository in
let realpackages = Hashtbl.create 1023 in
let clusters = Debian.Debutil.cluster repository in
let cluster_iter (sn,sv) l =
List.iter (fun (version,realversion,cluster) ->
List.iter (fun pkg ->
let pn = pkg.Debian.Packages.name in
if Hashtbl.mem constraints_table pn then begin
Hashtbl.add realpackages pn ()
end
) cluster;
let (versionlist, constr) =
Debian.Evolution.all_ver_constr constraints_table cluster
in
version_acc := versionlist @ !version_acc;
Hashtbl.add worktable (sn,version) (cluster,versionlist,constr)
) l
in
Hashtbl.iter cluster_iter clusters;
Hashtbl.iter (fun name constr ->
if not(Hashtbl.mem realpackages name) then begin
let vl = Debian.Evolution.all_versions constr in
let pkg = {
Debian.Packages.default_package with
Debian.Packages.name = name;
version = "1";
}
in
let cluster = [pkg] in
version_acc := vl @ !version_acc;
Hashtbl.add worktable (name,"1") (cluster,vl,constr)
end
) constraints_table;
Hashtbl.clear realpackages;
let versionlist = Util.list_unique ("1"::!version_acc) in
info "Total Names: %d" (Hashtbl.length worktable);
info "Total versions: %d" (List.length versionlist);
let tables = Debian.Debcudf.init_tables ~step:2 ~versionlist repository in
let getv v = Debian.Debcudf.get_cudf_version tables ("",v) in
let pkgset =
CudfAdd.to_set (
Hashtbl.fold (fun (sn,version) (cluster,vl,constr) acc0 ->
let sync_index = ref 1 in
let discr = Debian.Evolution.discriminant (evalsel getv) vl constr in
let acc0 =
List.fold_left (fun l pkg ->
let p = Debian.Debcudf.tocudf ?options tables pkg in
(sync (sn,version,1) p)::l
) acc0 cluster
in
List.fold_left (fun acc1 (target,equiv) ->
incr sync_index;
List.fold_left (fun acc2 pkg ->
let p = Debian.Debcudf.tocudf tables pkg in
let pv = p.Cudf.version in
let target = Debian.Evolution.align pkg.Debian.Packages.version target in
let newv = version_of_target getv target in
let number = Debian.Evolution.string_of_range target in
let equivs = List.map Debian.Evolution.string_of_range equiv in
if newv > pv then begin
let d = dummy (sn,version) p number equivs newv in
if List.length cluster > 1 then
(sync (sn,version,!sync_index) d)::acc2
else
d::acc2
end else acc2
) acc1 cluster
) acc0 discr
) worktable []
)
in
let pkglist = (CudfAdd.Cudf_set.elements pkgset) in
if dump then begin
Cudf_printer.pp_preamble stdout Debian.Debcudf.preamble;
print_newline ();
Cudf_printer.pp_packages stdout (List.sort pkglist);
exit(0)
end;
let universe = Cudf.load_universe pkglist in
let universe_size = Cudf.universe_size universe in
info "Total future: %d" universe_size;
Hashtbl.clear worktable;
Hashtbl.clear constraints_table;
let checklist =
if Option.is_none checklist then []
else
List.map (fun (p,_,v) ->
Cudf.lookup_package universe (p,getv v)
) (Option.get checklist)
in
let pp pkg =
let p =
if String.starts_with pkg.Cudf.package "src/" then
Printf.sprintf "Source conflict (%s)" pkg.Cudf.package
else pkg.Cudf.package
in
let v =
if String.starts_with pkg.Cudf.package "src/" then
string_of_int pkg.Cudf.version
else
try Cudf.lookup_package_property pkg "number"
with Not_found ->
if (pkg.Cudf.version mod 2) = 1 then
Debian.Debcudf.get_real_version tables
(pkg.Cudf.package,pkg.Cudf.version)
else
fatal "Real package without Debian Version"
in
let l =
List.filter_map (fun k ->
try Some(k,Cudf.lookup_package_property pkg k)
with Not_found -> None
) ["architecture";"source";"sourcenumber";"equivs"]
in
(p,v,l)
in
let fmt = Format.std_formatter in
Format.fprintf fmt "@[<v 1>report:@,";
let results = Diagnostic.default_result universe_size in
let callback d =
if summary then Diagnostic.collect results d ;
Diagnostic.fprintf ~pp ~failure ~explain fmt d
in
Util.Timer.start timer;
let i =
if checklist <> [] then
Depsolver.listcheck ~callback ~global_constraints:false universe checklist
else
Depsolver.univcheck ~callback ~global_constraints:false universe
in
ignore(Util.Timer.stop timer ());
if failure then Format.fprintf fmt "@]@.";
Format.fprintf fmt "total-packages: %d@." universe_size;
Format.fprintf fmt "total-broken: %d@." i;
if summary then
Format.fprintf fmt "@[%a@]@." (Diagnostic.pp_summary ~pp ()) results;
results