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 ; Returns list of parsed result lines
  11 (define (dpkg-exec FMT) (map (fn (S) (parse S " ")) (exec FMT)))
  12
  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 10000))
  21   (write 2 ".")
  22   (dolist (PPV (dpkg-exec (format PROVFMT (join PL " "))))
  23     (let ((P (PPV 0)))
  24       (dolist (PV (1 PPV))
  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")
  28
  29 ; set up a hashtable of recommenders
  30 (write 2 "Initializing 'recommended-by' ")
  31 (setf RECFMT "dpkg-query -W -f '${Package} ${Recommends}' %s")
  32 (define REC:REC nil)
  33 (dolist (PL (explode INSTALLED 10000))
  34   (write 2 ".")
  35   (dolist (RR  (dpkg-exec (format RECFMT (join PL " "))))
  36     (let ((P (RR 0)))
  37       (dolist (R (1 RR))
  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")
  41
  42 ; ========================================
  43 ; Set up hashtable for dependencies without those not installed or
  44 ; shadowed by non-default choice
  45
  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)))
  56
  57 ; Strip away all version specs from a dependency line
  58 (define (noversions X) (replace " \\([^)]*\\)" (copy X) "" 0))
  59
  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) "|")))))
  66
  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 ","))))))
  70
  71 (write 2 "Initializing actual 'depends' ")
  72 (setf DEPFMT "dpkg-query -W -f '${Package} ${Pre-Depends} ${Depends}\\n' %s")
  73 (define DEP:DEP nil)
  74 (dolist (PL (explode INSTALLED 10000))
  75   (write 2 ".")
  76   (dolist (RR (exec (format DEPFMT (join PL " "))))
  77     (when (regex "([^ ]+) (.*)" RR)
  78       (let ((P $1) (RL (flat (depends-fix $2))))
  79         (DEP P RL)))))
  80 (write-line 2 " done")
  81
  82 ; Return the dependencies for installed package of empty list otherwise
  83 (define (depends P) (or (DEP P) '()))
  84
  85 ; Determine the list of "manually installed"
  86 (setf MANUAL (map noarch (exec "apt-mark showmanual")))
  87
  88 ; Expands a list of packages to include the closure of its dependencies
  89 (define (closure L)
  90   (let ((P (sort L)))
  91     (write-line 2 (format "checking %d manual packages" (length P)))
  92     (while (!= P (setf L (sort (union P (apply union (map depends P))))))
  93       (setf P L)
  94       (write-line 2 (format " %d with dependencies" (length P)))
  95       )
  96     P))
  97
  98 ## main: report the set difference between "all installed" and the
  99 ## dependency closure of "manually installed"
 100
 101 (let ((Y (difference INSTALLED (closure MANUAL))))
 102   (write-line 2 (format "=> %d automatic recommended packages" (length Y)))
 103   (map (fn (P) (println P " by " (join (or (REC P) '("???")) " "))) Y))
 104
 105 (exit 0)