| 1 | #!/bin/sh |
| 2 | # aside from this initial boilerplate, this is actually -*- scheme -*- code |
| 3 | main='(module-ref (resolve-module '\''(scripts api-diff)) '\'main')' |
| 4 | exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" |
| 5 | !# |
| 6 | ;;; api-diff --- diff guile-api.alist files |
| 7 | |
| 8 | ;; Copyright (C) 2002 Free Software Foundation, Inc. |
| 9 | ;; |
| 10 | ;; This program is free software; you can redistribute it and/or |
| 11 | ;; modify it under the terms of the GNU General Public License as |
| 12 | ;; published by the Free Software Foundation; either version 2, or |
| 13 | ;; (at your option) any later version. |
| 14 | ;; |
| 15 | ;; This program is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 18 | ;; General Public License for more details. |
| 19 | ;; |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with this software; see the file COPYING. If not, write to |
| 22 | ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
| 23 | ;; Boston, MA 02111-1307 USA |
| 24 | |
| 25 | ;;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | |
| 29 | ;; Usage: api-diff [-d GROUPS] ALIST-FILE-A ALIST-FILE-B |
| 30 | ;; |
| 31 | ;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B |
| 32 | ;; and display a (count) summary of the groups defined therein. |
| 33 | ;; Optional arg "--details" (or "-d") specifies a comma-separated |
| 34 | ;; list of groups, in which case api-diff displays instead the |
| 35 | ;; elements added and deleted for each of the specified groups. |
| 36 | ;; |
| 37 | ;; For scheme programming, this module exports the proc: |
| 38 | ;; (api-diff A-file B-file) |
| 39 | ;; |
| 40 | ;; Note that the convention is that the "older" alist/file is |
| 41 | ;; specified first. |
| 42 | ;; |
| 43 | ;; TODO: Develop scheme interface. |
| 44 | |
| 45 | ;;; Code: |
| 46 | |
| 47 | (define-module (scripts api-diff) |
| 48 | :use-module (ice-9 common-list) |
| 49 | :use-module (ice-9 format) |
| 50 | :use-module (ice-9 getopt-long) |
| 51 | :autoload (srfi srfi-13) (string-tokenize) |
| 52 | :export (api-diff)) |
| 53 | |
| 54 | (define (read-alist-file file) |
| 55 | (with-input-from-file file |
| 56 | (lambda () (read)))) |
| 57 | |
| 58 | (define put set-object-property!) |
| 59 | (define get object-property) |
| 60 | |
| 61 | (define (read-api-alist-file file) |
| 62 | (let* ((alist (read-alist-file file)) |
| 63 | (meta (assq-ref alist 'meta)) |
| 64 | (interface (assq-ref alist 'interface))) |
| 65 | (put interface 'meta meta) |
| 66 | (put interface 'groups (let ((ht (make-hash-table 31))) |
| 67 | (for-each (lambda (group) |
| 68 | (hashq-set! ht group '())) |
| 69 | (assq-ref meta 'groups)) |
| 70 | ht)) |
| 71 | interface)) |
| 72 | |
| 73 | (define (hang-by-the-roots interface) |
| 74 | (let ((ht (get interface 'groups))) |
| 75 | (for-each (lambda (x) |
| 76 | (for-each (lambda (group) |
| 77 | (hashq-set! ht group |
| 78 | (cons (car x) |
| 79 | (hashq-ref ht group)))) |
| 80 | (assq-ref x 'groups))) |
| 81 | interface)) |
| 82 | interface) |
| 83 | |
| 84 | (define (diff? a b) |
| 85 | (let ((result (set-difference a b))) |
| 86 | (if (null? result) |
| 87 | #f ; CL weenies bite me |
| 88 | result))) |
| 89 | |
| 90 | (define (diff+note! a b note-removals note-additions note-same) |
| 91 | (let ((same? #t)) |
| 92 | (cond ((diff? a b) => (lambda (x) (note-removals x) (set! same? #f)))) |
| 93 | (cond ((diff? b a) => (lambda (x) (note-additions x) (set! same? #f)))) |
| 94 | (and same? (note-same)))) |
| 95 | |
| 96 | (define (group-diff i-old i-new . options) |
| 97 | (let* ((i-old (hang-by-the-roots i-old)) |
| 98 | (g-old (hash-fold acons '() (get i-old 'groups))) |
| 99 | (g-old-names (map car g-old)) |
| 100 | (i-new (hang-by-the-roots i-new)) |
| 101 | (g-new (hash-fold acons '() (get i-new 'groups))) |
| 102 | (g-new-names (map car g-new))) |
| 103 | (cond ((null? options) |
| 104 | (diff+note! g-old-names g-new-names |
| 105 | (lambda (removals) |
| 106 | (format #t "groups-removed: ~A\n" removals)) |
| 107 | (lambda (additions) |
| 108 | (format #t "groups-added: ~A\n" additions)) |
| 109 | (lambda () #t)) |
| 110 | (for-each (lambda (group) |
| 111 | (let* ((old (assq-ref g-old group)) |
| 112 | (new (assq-ref g-new group)) |
| 113 | (old-count (and old (length old))) |
| 114 | (new-count (and new (length new))) |
| 115 | (delta (and old new (- new-count old-count)))) |
| 116 | (format #t " ~5@A ~5@A ~5@A ~A\n" |
| 117 | (or old-count "-") |
| 118 | (or new-count "-") |
| 119 | (or delta "-") |
| 120 | group))) |
| 121 | (sort (union g-old-names g-new-names) |
| 122 | (lambda (a b) |
| 123 | (string<? (symbol->string a) |
| 124 | (symbol->string b)))))) |
| 125 | ((assq-ref options 'details) |
| 126 | => (lambda (groups) |
| 127 | (for-each (lambda (group) |
| 128 | (let* ((old (or (assq-ref g-old group) '())) |
| 129 | (new (or (assq-ref g-new group) '())) |
| 130 | (>>! (lambda (label ls) |
| 131 | (format #t "~A ~A:\n" group label) |
| 132 | (for-each (lambda (x) |
| 133 | (format #t " ~A\n" x)) |
| 134 | ls)))) |
| 135 | (diff+note! old new |
| 136 | (lambda (removals) |
| 137 | (>>! 'removals removals)) |
| 138 | (lambda (additions) |
| 139 | (>>! 'additions additions)) |
| 140 | (lambda () |
| 141 | (format #t "~A: no changes\n" |
| 142 | group))))) |
| 143 | groups))) |
| 144 | (else |
| 145 | (error "api-diff: group-diff: bad options"))))) |
| 146 | |
| 147 | (define (api-diff . args) |
| 148 | (let* ((p (getopt-long (cons 'api-diff args) |
| 149 | '((details (single-char #\d) |
| 150 | (value #t)) |
| 151 | ;; Add options here. |
| 152 | ))) |
| 153 | (rest (option-ref p '() '("/dev/null" "/dev/null"))) |
| 154 | (i-old (read-api-alist-file (car rest))) |
| 155 | (i-new (read-api-alist-file (cadr rest))) |
| 156 | (options '())) |
| 157 | (cond ((option-ref p 'details #f) |
| 158 | => (lambda (groups) |
| 159 | (set! options (cons (cons 'details |
| 160 | (map string->symbol |
| 161 | (string-tokenize |
| 162 | groups |
| 163 | #\,))) |
| 164 | options))))) |
| 165 | (apply group-diff i-old i-new options))) |
| 166 | |
| 167 | (define main api-diff) |
| 168 | |
| 169 | ;;; api-diff ends here |