From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add related procedures. Date: Thu, 28 Mar 2013 06:08:06 +0400 Message-ID: <87li989szd.fsf_-_@karetnikov.org> References: <87obfchq38.fsf@karetnikov.org> <87sj4ok6sc.fsf@gnu.org> <87sj48gxzp.fsf_-_@karetnikov.org> <87lia09khe.fsf@gnu.org> <874ngbcfbl.fsf_-_@karetnikov.org> <87vc8rq6ol.fsf@gnu.org> <87hajxsx74.fsf@karetnikov.org> <87ppylvprd.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:44105) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UL2EB-0006bM-OX for bug-guix@gnu.org; Wed, 27 Mar 2013 22:06:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UL2E8-0008Di-2U for bug-guix@gnu.org; Wed, 27 Mar 2013 22:06:07 -0400 In-Reply-To: <87ppylvprd.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Tue, 26 Mar 2013 22:02:14 +0100") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: bug-guix@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable I'm attaching the patch. > What about calling that field =E2=80=98doc-urls=E2=80=99 (plural) and hav= ing it hold a > list of URLs? Done. By the way, some fields return "none." Should it be converted to #f? >> And what's the best way to handle 'doc-shop'? Can we ignore it? > What is it? FSF's shop. > Perhaps we don=E2=80=99t need it for our purposes? I think so. > On Guile < 2.0.7, you=E2=80=99ll get a string, so you can just call > =E2=80=98open-input-string=E2=80=99 to wrap it in a port. > On later versions, you=E2=80=99ll get a port. I'm using 2.0.7; 'http-get' returns a string. I used the following: + ((string<=3D? (version) "2.0.7") + (open-input-string data)) + (else data))) >> + (gplv3-status gnu-package-gplv3-status) >> + (activity-status gnu-package-activity-status) >> + (last-contact gnu-package-last-contact) >> + (next-contact gnu-package-next-contact) >> + (note gnu-package-note)) > I=E2=80=99d remove these 5 fields since Brandon mentioned that at least 2= of > them are being moved elsewhere, and we don=E2=80=99t need them anyway. Done. > (It=E2=80=99s surprising that there=E2=80=99s no =E2=80=98license=E2=80= =99 field in the file.) I'll ask Karl about this. --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-gnu-maintenance-Improve-official-gnu-packages-add-re.patch Content-Transfer-Encoding: quoted-printable From=20fdbda64e75e31782a7f08ade46b1ea01a5fd06d3 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 28 Mar 2013 01:50:31 +0000 Subject: [PATCH] gnu-maintenance: Improve 'official-gnu-packages'; add related procedures. * guix/gnu-maintenance.scm (http-fetch): Return an input port. (): Add it. (official-gnu-packages): Use . (find-packages): Add it. (gnu-package?): Adjust accordingly. =2D-- guix/gnu-maintenance.scm | 161 +++++++++++++++++++++++++++++++++++++-----= --- 1 files changed, 132 insertions(+), 29 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89a0174..28c301f 100644 =2D-- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU =2D;;; Copyright =C2=A9 2012 Nikita Karetnikov ;;; Copyright =C2=A9 2010, 2011, 2012, 2013 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +22,7 @@ #:use-module (web client) #:use-module (web response) #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -30,8 +31,22 @@ #:use-module (guix ftp-client) #:use-module (guix utils) #:use-module (guix packages) =2D #:export (official-gnu-packages + #:export (gnu-package-name + gnu-package-mundane-name + gnu-package-copyright-holder + gnu-package-savannah + gnu-package-fsd + gnu-package-language + gnu-package-logo + gnu-package-doc-category + gnu-package-doc-summary + gnu-package-doc-urls + gnu-package-download-url + + official-gnu-packages + find-packages gnu-package? + releases latest-release gnu-package-name->name+version)) @@ -49,29 +64,32 @@ ;;; =20 (define (http-fetch uri) =2D "Return a string containing the textual data at URI, a string." + "Return an input port containing the textual data at URI, a string." (let*-values (((resp data) (http-get (string->uri uri))) ((code) (response-code resp))) (case code ((200) =2D (if data =2D data =2D (begin =2D ;; XXX: Guile 2.0.5 and earlier did not support chunked tra= nsfer =2D ;; encoding, which is required when fetching %PACKAGE-LIST-= URL =2D ;; (see ). =2D ;; Since users may still be using these versions, warn them= and =2D ;; bail out. =2D (format (current-error-port) =2D "warning: using Guile ~a, which does not support HT= TP ~s encoding~%" =2D (version) =2D (response-transfer-encoding resp)) =2D (error "download failed; use a newer Guile" =2D uri resp)))) + (cond ((string<=3D? (version) "2.0.5") + (begin + ;; XXX: Guile 2.0.5 and earlier did not support chunked tr= ansfer + ;; encoding, which is required when fetching %PACKAGE-LIST= -URL + ;; (see ). + ;; Since users may still be using these versions, warn the= m and + ;; bail out. + (format (current-error-port) + "warning: using Guile ~a, ~a ~s encoding~%" + (version) + "which does not support HTTP" + (response-transfer-encoding resp)) + (error "download failed; use a newer Guile" + uri resp))) + ((string<=3D? (version) "2.0.7") + (open-input-string data)) + (else data))) (else =2D (error "download failed:" uri code + (error "download failed" uri code (response-reason-phrase resp)))))) =20 (define %package-list-url @@ -79,16 +97,101 @@ "viewvc/*checkout*/gnumaint/" "gnupackages.txt?root=3Dwomb")) =20 +(define-record-type* + gnu-package-descriptor + make-gnu-package-descriptor + + gnu-package-descriptor? + + (name gnu-package-name) + (mundane-name gnu-package-mundane-name) + (copyright-holder gnu-package-copyright-holder) + (savannah gnu-package-savannah) + (fsd gnu-package-fsd) + (language gnu-package-language) + (logo gnu-package-logo) + (doc-category gnu-package-doc-category) + (doc-summary gnu-package-doc-summary) + (doc-urls gnu-package-doc-urls) + (download-url gnu-package-download-url)) + (define (official-gnu-packages) =2D "Return a list of GNU packages." =2D (define %package-line-rx =2D (make-regexp "^package: (.+)$")) + "Return a list of records, which are GNU packages." + (define (group-package-fields port state) + ;; Return a list of alists. Each alist contains fields of a GNU + ;; package. + (let ((line (read-line port)) + (field-rx (make-regexp "^([[:graph:]]+): (.*)$")) + (doc-urls-rx (make-regexp "^doc-url: (.*)$")) + (end-rx (make-regexp "^# End. .+Do not remove this line.+")= )) + + (define (match-field str) + ;; Packages are separated by empty strings. If STR is an + ;; empty string, create a new list to store fields of a + ;; different package. Otherwise, match and create a key-value + ;; pair. + (match str + ("" + (group-package-fields port (cons '() state))) + (str + (cond ((regexp-exec doc-urls-rx str) + =3D> + (lambda (match) + (if (equal? (assoc-ref (first state) "doc-urls") #f) + (group-package-fields + port (cons (cons (cons "doc-urls" + (list + (match:substring match 1)= )) + (first state)) + (drop state 1))) + (group-package-fields + port (cons (cons (cons "doc-urls" + (cons (match:substring mat= ch 1) + (assoc-ref (first st= ate) + "doc-urls= "))) + (assoc-remove! (first state) + "doc-urls")) + (drop state 1)))))) + ((regexp-exec field-rx str) + =3D> + (lambda (match) + (group-package-fields + port (cons (cons (cons (match:substring match 1) + (match:substring match 2)) + (first state)) + (drop state 1))))) + (else (group-package-fields port state)))))) + + (if (or (eof-object? line) + (regexp-exec end-rx line)) ; don't include dummy fields + (remove null-list? state) + (match-field line)))) + + (define (alist->record alist make keys) + ;; Apply MAKE, which should be a syntactic constructor, to the + ;; values associated with KEYS in ALIST. + (let ((args (map (cut assoc-ref alist <>) keys))) + (apply make args))) + + (reverse + (map (lambda (alist) + (alist->record alist + make-gnu-package-descriptor + (list "package" "mundane-name" "copyright-holder" + "savannah" "fsd" "language" "logo" + "doc-category" "doc-summary" "doc-urls" + "download-url"))) + (group-package-fields (http-fetch %package-list-url) + '(()))))) =20 =2D (let ((lst (string-split (http-fetch %package-list-url) #\nl))) =2D (filter-map (lambda (line) =2D (and=3D> (regexp-exec %package-line-rx line) =2D (cut match:substring <> 1))) =2D lst))) +(define (find-packages regexp) + "Find GNU packages which satisfy REGEXP." + (let ((name-rx (make-regexp regexp))) + (filter (lambda (package) + (and=3D> (false-if-exception + (regexp-exec name-rx (gnu-package-name package))) + (const package))) + (official-gnu-packages)))) =20 (define gnu-package? (memoize @@ -97,10 +200,10 @@ network to check in GNU's database." ;; TODO: Find a way to determine that a package is non-GNU without go= ing ;; through the network. =2D (let ((url (and=3D> (package-source package) origin-uri))) + (let ((url (and=3D> (package-source package) origin-uri)) + (name (package-name package))) (or (and (string? url) (string-prefix? "mirror://gnu" url)) =2D (and (member (package-name package) (official-gnu-packages)) =2D #t)))))) + (not (null-list? (find-packages (format #f "^~a$" name))))))))) =20 ;;; =2D-=20 1.7.5.4 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRU6YLAAoJEM+IQzI9IQ38imUP/jbKFbMSu4NKLlX/CRK04wCs RXQ3S2z7wK8uHhRppkYC4xeqVXiz8O2UJNPnGwkW1bWoy0qBYCCwVadDmFbmO3NA MH7OVbk20atroTwDaAD75bV/tR8NjqTyCcRguHg+V5ZdRfXLbAZDFiK5GWhoH97z kfhrtWhAQWbGanJUIH52VbeXD9GYCRxN8zOaLJ1oDnyvqETXQ9g5OUMnSQW+1YGk uTCwXTBXTS/+aIx40opP4KPzZrx9bYDpVs1IQdqwLDZTUsiqta9SROqGVx0NLNA6 nT/mSfsx+LfR1CImwZ4F9d0jmJb7DV83BmWTL3o1f/I0Yk03K/mUpnZYAqFPk9tQ R6OvUsBU1H4q341q3pyuZr5L0cP32VnsvjgW9N8i9TRW5lO9pktB0Y/ZEEp30JK/ vsYB1CUMsPHwYvuk4qCZQRXkM+1FuuvpuHFkQ9HjmMpDGQWF6yKQgzkmFtX33qsE c4QapgveWYLEYCeMFvKIW0IjQHEZtKZhLsrtZV3Qb/13YiIuXOwiJhAfqI2YOM9p xBTN4mFKOAEGVR6jb/lEW7kY7dU2XdMCe56WQ+jaJJzY7Zm8u6E7woeJjiUHmv97 d3BZ+FLbQGooom66xS2ufwPZ3BSLDnhVNx0HcX9M08Jy/gGllCzRGclKk9eA85oX F57dAiKTbL+Q03JtDTEn =zBiW -----END PGP SIGNATURE----- --==-=-=--