#!/usr/bin/newlisp
-; Strip away arch tail if any
-(define (noarch X) (if (find ":" X) (0 $it X) X))
+; Strip away the arch tail if any of a package
+(define (noarch P) (if (find ":" P) (0 $it P) P))
-; Strip away all version specs from a dependency line
-(define (noversions X)
- (replace " \\([^)]*\\)" (copy X) "" 0))
-
-; Return list of "manually installed"
-(define (manual) (map noarch (exec "apt-mark showmanual")))
-
-; Return list of "all installed"
-(define (installed) (map noarch (exec "apt-mark showinstall")))
+; Determine the list of "all installed"
+(setf INSTALLED (map noarch (exec "apt-mark showinstall")))
+(write-line 2 (format "There are %d installed packages" (length INSTALLED)))
-; Return the provided package, if any, of a given package, or nil
-(define (provides P)
- (if (exec (format "dpkg-query -W -f '${Provides}' %s" P)) ($it 0) nil))
-
-; Return the "raw dependency line" for a package
-(define (raw-depends P)
- (exec (format "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s" P)))
+; Determine the list of "manually installed"
+(setf MANUAL (map noarch (exec "apt-mark showmanual")))
+(write-line 2 (format "There are %d manual packages" (length MANUAL)))
; Set up hash table of provided packages by currently installed. This
; is needed for following up dependencies, which for an option
; dependency only automatically resolves the first of options.
+(write 2 "Initializing 'provided-by' ")
+(setf PROVFMT "dpkg-query -W -f '${Provides}' %s")
(define PROV:PROV nil)
-(write 2 "Initializing ")
-(dolist (P (installed))
- (let ((PV (provides P)))
- (if (= (% (inc COUNT) 100)) (write 2 "."))
- (if (PROV P) (push P (PROV P)) (PROV P (list P)))
- (if (PROV PV) (push P (PROV PV)) (PROV PV (list P)))))
-(dolist (P (PROV))
- (PROV (P 0) (sort (unique (P 1)))))
+(dolist (P INSTALLED)
+ (if (= (% (inc COUNT) 100)) (write 2 "."))
+ (if (PROV P) (push P (PROV P)) (PROV P (list P)))
+ (let (PV (if (exec (format PROVFMT P)) ($it 0)))
+ (when PV (if (PROV PV) (push P (PROV PV)) (PROV PV (list P))))))
+(dolist (P (PROV)) (PROV (P 0) (sort (unique (P 1)))))
(write-line 2 " done")
-; Look up the list of packages that providing the P package
-(define (provided P) (PROV P))
+; set up a hashtable of recommenders
+(write 2 "Initializing 'recommended-by' ")
+(setf COUNT 0)
+(setf RECFMT "dpkg-query -W -f '${Recommends}' %s")
+(define REC:REC nil)
+(dolist (P INSTALLED)
+ (if (= (% (inc COUNT) 100)) (write 2 "."))
+ (dolist (R (exec (format RECFMT P)))
+ (if (REC R) (push P (REC R)) (REC R (list P)))))
+(dolist (P (REC)) (REC (P 0) (sort (unique (P 1)))))
+(write-line 2 " done")
-; Return the "depends choice" of autmatically dependent package
-; considering the options of providing that package as currently
-; installed. Only the first of providers is an automatic dependency.
-; Thus, return a) the depedent package itself if it's the first of its
-; providers, or b) that first of providers if the dependent package is
-; not among the providers (a fully virtual package), or c) nil if the
-; depedent package is a provider but not the first.
+; ========================================
+; Set up hashtable for dependencies without those not installed or
+; shadowed by non-default choice
+
+; Returns the "depends choice" of an automatically dependent package
+; as supported by currently installed packages. Only the first of
+; providers is an automatic dependency. Thus, it returns either a) the
+; depedent package itself if it's the first of its providers, or b)
+; that first of providers if the dependent package is not among the
+; providers (a fully virtual package), or c) nil if the depedent
+; package is a provider but not the first.
(define (depends-choice P)
(let ((Y (if (PROV P) (first $it) nil)))
(if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))
-; Resolve a depedency item with respect to package provisions, where
-; an option depedency only automatically pulls in its first option.
-; May return null
+; Strip away all version specs from a dependency line
+(define (noversions X) (replace " \\([^)]*\\)" (copy X) "" 0))
+
+; Resolves a depedency list with respect to installed package
+; provisions, where in particular an option depedency only
+; automatically pulls in its first option. This may return nil, which
+; is for a choice dependency with installed non-default provisioning.
(define (depends-choices X)
(depends-choice (trim (first (parse (noversions X) "|")))))
-; Fix up a dependency line into list of packages, after cleanup
+; Returns the fixed up a dependency line as list of packages.
(define (depends-fix X)
(clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
-; Return dependencies of a package, with caching.
+(write 2 "Initializing actual 'depends' ")
+(setf COUNT 0)
+(setf DEPFMT "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s")
(define DEP:DEP nil)
-(define (depends X)
- (if (DEP X) $it (DEP X (flat (map depends-fix (raw-depends X))))))
+(dolist (P INSTALLED)
+ (if (= (% (inc COUNT) 100)) (write 2 "."))
+ (DEP P (flat (map depends-fix (exec (format DEPFMT P))))))
+(write-line 2 " done")
+
+; Return the dependencies for installed package of empty list otherwise
+(define (depends P) (or (DEP P) '()))
-; Expand a list of packages to include the closure of dependencies
+; Expands a list of packages to include the closure of its dependencies
(define (closure L)
- (let ((X (sort L)))
- (write-line 2 (format "checking %d manual packages" (length X)))
- (while (!= X (setf L (sort (union X (apply union (map depends X))))))
- (setf X L)
- (write-line 2 (format " %d manual+dependent packages so far" (length X)))
+ (let ((P (sort L)))
+ (write-line 2 (format "checking %d manual packages" (length P)))
+ (while (!= P (setf L (sort (union P (apply union (map depends P))))))
+ (setf P L)
+ (write-line 2 (format " %d with dependencies" (length P)))
)
- X))
+ P))
## main: report the set difference between "all installed" and the
## dependency closure of "manually installed"
-(let ((X (installed)) (Y nil))
- (write-line 2 (format "There are %d installed packages" (length X)))
- (setf Y (difference (installed) (closure (manual))))
+(let ((Y (difference INSTALLED (closure MANUAL))))
(write-line 2 (format "=> %d automatic recommended packages" (length Y)))
(map println Y))
projects / rrq / newlisp-ftw.git / commitdiff