autorecommended.lsp

   1 #!/usr/bin/newlisp
   2
   3 ; Strip away the arch tail if any of a package
   4 (define (noarch P) (if (find ":" P) (0 $it P) P))
   5
   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)))
   9
  10 ; Determine the list of "manually installed"
  11 (setf MANUAL (map noarch (exec "apt-mark showmanual")))
  12 (write-line 2 (format "There are %d manual packages" (length MANUAL)))
  13
  14 ; Set up hash table of provided packages by currently installed. This
  15 ; is needed for following up dependencies, which for an option
  16 ; dependency only automatically resolves the first of options.
  17 (write 2 "Initializing 'provided-by' ")
  18 (setf PROVFMT "dpkg-query -W -f '${Provides}' %s")
  19 (define PROV:PROV nil)
  20 (dolist (P INSTALLED)
  21   (if (= (% (inc COUNT) 100)) (write 2 "."))
  22   (if (PROV P) (push P (PROV P)) (PROV P (list P)))
  23   (let (PV (if (exec (format PROVFMT P)) ($it 0)))
  24     (when PV (if (PROV PV) (push P (PROV PV)) (PROV PV (list P))))))
  25 (dolist (P (PROV)) (PROV (P 0) (sort (unique (P 1)))))
  26 (write-line 2 " done")
  27
  28 ; set up a hashtable of recommenders
  29 (write 2 "Initializing 'recommended-by' ")
  30 (setf COUNT 0)
  31 (setf RECFMT "dpkg-query -W -f '${Recommends}' %s")
  32 (define REC:REC nil)
  33 (dolist (P INSTALLED)
  34   (if (= (% (inc COUNT) 100)) (write 2 "."))
  35   (dolist (R (exec (format RECFMT P)))
  36     (if (REC R) (push P (REC R)) (REC R (list P)))))
  37 (dolist (P (REC)) (REC (P 0) (sort (unique (P 1)))))
  38 (write-line 2 " done")
  39
  40 ; ========================================
  41 ; Set up hashtable for dependencies without those not installed or
  42 ; shadowed by non-default choice
  43
  44 ; Returns the "depends choice" of an automatically dependent package
  45 ; as supported by currently installed packages. Only the first of
  46 ; providers is an automatic dependency. Thus, it returns either a) the
  47 ; depedent package itself if it's the first of its providers, or b)
  48 ; that first of providers if the dependent package is not among the
  49 ; providers (a fully virtual package), or c) nil if the depedent
  50 ; package is a provider but not the first.
  51 (define (depends-choice P)
  52   (let ((Y (if (PROV P) (first $it) nil)))
  53     (if (null? Y) nil (member P (PROV P)) (and (= P Y) P) Y)))
  54
  55 ; Strip away all version specs from a dependency line
  56 (define (noversions X) (replace " \\([^)]*\\)" (copy X) "" 0))
  57
  58 ; Resolves a depedency list with respect to installed package
  59 ; provisions, where in particular an option depedency only
  60 ; automatically pulls in its first option. This may return nil, which
  61 ; is for a choice dependency with installed non-default provisioning.
  62 (define (depends-choices X)
  63   (depends-choice (trim (first (parse (noversions X) "|")))))
  64
  65 ; Returns the fixed up a dependency line as list of packages.
  66 (define (depends-fix X)
  67   (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
  68
  69 (write 2 "Initializing actual 'depends' ")
  70 (setf COUNT 0)
  71 (setf DEPFMT "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s")
  72 (define DEP:DEP nil)
  73 (dolist (P INSTALLED)
  74   (if (= (% (inc COUNT) 100)) (write 2 "."))
  75   (DEP P (flat (map depends-fix (exec (format DEPFMT P))))))
  76 (write-line 2 " done")
  77
  78 ; Return the dependencies for installed package of empty list otherwise
  79 (define (depends P) (or (DEP P) '()))
  80
  81 ; Expands a list of packages to include the closure of its dependencies
  82 (define (closure L)
  83   (let ((P (sort L)))
  84     (write-line 2 (format "checking %d manual packages" (length P)))
  85     (while (!= P (setf L (sort (union P (apply union (map depends P))))))
  86       (setf P L)
  87       (write-line 2 (format " %d with dependencies" (length P)))
  88       )
  89     P))
  90
  91 ## main: report the set difference between "all installed" and the
  92 ## dependency closure of "manually installed"
  93
  94 (let ((Y (difference INSTALLED (closure MANUAL))))
  95   (write-line 2 (format "=> %d automatic recommended packages" (length Y)))
  96   (map println Y))
  97
  98 (exit 0)