This eliminates the need for multiple "dpkg-query --show" calls
---
src/dpkg.ml | 77 +++++++++++++++----------------------------------------------
1 file changed, 19 insertions(+), 58 deletions(-)
diff --git a/src/dpkg.ml b/src/dpkg.ml
index efc8123..c4a4316 100644
--- a/src/dpkg.ml
+++ b/src/dpkg.ml
@@ -52,70 +52,31 @@ type dpkg_t = {
(* Memo from package type to internal dpkg_t. *)
let dpkg_of_pkg, pkg_of_dpkg = get_memo_functions ()
-(* Memo of dpkg_package_of_string. *)
-let dpkgh = Hashtbl.create 13
-
+let dpkg_packages = Hashtbl.create 13
let dpkg_package_of_string str =
- (* Parse an dpkg name into the fields like name and version. Since
- * the package is installed (see check below), it's easier to use
- * dpkg-query itself to do this parsing rather than haphazardly
- * parsing it ourselves.
- *)
- let parse_dpkg str =
+ if Hashtbl.length dpkg_packages == 0 then (
let cmd =
- sprintf "%s --show --showformat='${Package} ${Version}
${Architecture}\\n' %s"
- Config.dpkg_query
- (quote str) in
+ sprintf "%s --show --showformat='${Package} ${Version} ${Architecture}
${Status}\\n'"
+ Config.dpkg_query in
let lines = run_command_get_lines cmd in
-
- let pkgs = List.map (
+ List.iter (
fun line ->
- let line = string_split " " line in
- match line with
- | [ name; version; arch ] ->
- assert (version <> "");
- { name = name; version = version; arch = arch }
- | xs -> assert false)
- lines in
-
- (* On multiarch setups, only consider the primary architecture *)
- try
- List.find (fun pkg ->
- pkg.arch = dpkg_primary_arch () || pkg.arch = "all") pkgs
- with
- Not_found -> assert false
-
- (* Check if a package is installed. *)
- and check_dpkg_installed name =
- let cmd =
- sprintf "%s --show %s >/dev/null 2>&1" Config.dpkg_query (quote
name) in
- if 0 <> Sys.command cmd then false
- else (
- (* dpkg-query --show can return information about packages which
- * are not installed. These have no version information.
- *)
- let cmd =
- sprintf "%s --show --showformat='${Version}' %s"
- Config.dpkg_query (quote name) in
- let lines = run_command_get_lines cmd in
- match lines with
- | [] | [""] -> false
- | _ -> true
- )
- in
-
+ match string_split " " line with
+ | [ name; version; arch; _; _; "installed" ] ->
+ Hashtbl.add dpkg_packages name { name; version; arch }
+ | _ -> ();
+ ) lines
+ );
+ let candidates = Hashtbl.find_all dpkg_packages str in
+ (* On multiarch setups, only consider the primary architecture *)
try
- Hashtbl.find dpkgh str
+ let pkg = List.find (
+ fun cand ->
+ cand.arch = dpkg_primary_arch () || cand.arch = "all"
+ ) candidates in
+ Some (pkg_of_dpkg pkg)
with
- Not_found ->
- let r =
- if check_dpkg_installed str then (
- let dpkg = parse_dpkg str in
- Some (pkg_of_dpkg dpkg)
- )
- else None in
- Hashtbl.add dpkgh str r;
- r
+ Not_found -> None
let dpkg_package_to_string pkg =
let dpkg = dpkg_of_pkg pkg in
--
1.9.0