3 ; Strip away the arch tail if any of a package
4 (define (noarch P) (if (find ":" P) (0 $it P) P))
6 ; Determine the list of "all installed"
7 (setf INSTALLED (map noarch (exec "apt-mark showinstall")))
8 (write-line 2 (format "There are %d installed packages" (length INSTALLED)))
10 ; Returns list of parsed result lines
11 (define (dpkg-exec FMT) (map (fn (S) (parse S " ")) (exec FMT)))
13 ; Set up hash table of provided packages by currently installed. This
14 ; is needed for following up dependencies, which for an option
15 ; dependency only automatically resolves the first of options.
16 (write 2 "Initializing 'provided-by' ")
17 (setf PROVFMT "dpkg-query -W -f '${Package} ${Provides}\\n' %s")
18 (define PROV:PROV nil)
19 (dolist (P INSTALLED) (if (PROV P) (push P (PROV P)) (PROV P (list P))))
20 (dolist (PL (explode INSTALLED 1000))
22 (dolist (PPV (dpkg-exec (format PROVFMT (join PL " "))))
25 (when PV (if (PROV PV) (push P (PROV PV)) (PROV PV (list P))))))))
26 (dolist (P (PROV)) (PROV (P 0) (sort (unique (P 1)))))
27 (write-line 2 " done")
29 ; set up a hashtable of recommenders
30 (write 2 "Initializing 'recommended-by' ")
31 (setf RECFMT "dpkg-query -W -f '${Package} ${Recommends}' %s")
33 (dolist (PL (explode INSTALLED 1000))
35 (dolist (RR (dpkg-exec (format RECFMT (join PL " "))))
38 (if (REC R) (push P (REC R)) (REC R (list P)))))))
39 (dolist (P (REC)) (REC (P 0) (sort (unique (P 1)))))
40 (write-line 2 " done")
42 ; ========================================
43 ; Set up hashtable for dependencies without those not installed or
44 ; shadowed by non-default choice
46 ; Returns the "depends choice" of an automatically dependent package
47 ; as supported by currently installed packages. Only the first of
48 ; providers is an automatic dependency. Thus, it returns either a) the
49 ; depedent package itself if it's the first of its providers, or b)
50 ; that first of providers if the dependent package is not among the
51 ; providers (a fully virtual package), or c) nil if the depedent
52 ; package is a provider but not the first.
53 (define (depends-choice P)
54 (let ((Y (if (PROV P) (first $it) nil)))
55 (if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))
57 ; Strip away all version specs from a dependency line
58 (define (noversions X) (replace " \\([^)]*\\)" (copy X) "" 0))
60 ; Resolves a depedency list with respect to installed package
61 ; provisions, where in particular an option depedency only
62 ; automatically pulls in its first option. This may return nil, which
63 ; is for a choice dependency with installed non-default provisioning.
64 (define (depends-choices X)
65 (depends-choice (trim (first (parse (noversions X) "|")))))
67 ; Returns the fixed up a dependency line as list of packages.
68 (define (depends-fix X)
69 (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
71 (write 2 "Initializing actual 'depends' ")
72 (setf DEPFMT "dpkg-query -W -f '${Package} ${Pre-Depends} ${Depends}\\n' %s")
74 (dolist (PL (explode INSTALLED 1000))
76 (dolist (RR (exec (format DEPFMT (join PL " "))))
77 (when (regex "([^ ]+) (.*)" RR)
78 (let ((P $1) (RL (flat (depends-fix $2))))
80 (write-line 2 " done")
82 ; Return the dependencies for installed package of empty list otherwise
83 (define (depends P) (or (DEP P) '()))
85 ; Determine the list of "manually installed"
86 (setf MANUAL (map noarch (exec "apt-mark showmanual")))
88 ; Expands a list of packages to include the closure of its dependencies
91 (write-line 2 (format "checking %d manual packages" (length P)))
92 (while (!= P (setf L (sort (union P (apply union (map depends P))))))
94 (write-line 2 (format " %d with dependencies" (length P)))
98 ## main: report the set difference between "all installed" and the
99 ## dependency closure of "manually installed"
101 (let ((Y (difference INSTALLED (closure MANUAL))))
102 (write-line 2 (format "=> %d automatic recommended packages" (length Y)))