From 54bef4cfa1a35728a7d75757462fb362ee97f4d3 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 7 Jun 2010 09:48:13 -0400 Subject: [PATCH] Per installer pages --- collects/meta/web/download/data.rkt | 150 ++++++++++++++++-- .../meta/web/download/installer-pages.rkt | 51 ++++++ collects/meta/web/www/download.rkt | 4 +- 3 files changed, 193 insertions(+), 12 deletions(-) create mode 100644 collects/meta/web/download/installer-pages.rkt diff --git a/collects/meta/web/download/data.rkt b/collects/meta/web/download/data.rkt index 9697ac542b..7ec0acadfd 100644 --- a/collects/meta/web/download/data.rkt +++ b/collects/meta/web/download/data.rkt @@ -38,11 +38,99 @@ ["201" "July 2002"] ["200" "June 2002"] ["103p1" "August 2001"] + ["103" "September 2000"] + ["053" "July 1998"] + )) + +(define -platform-names- + `(;; source platforms + ["win" "Windows"] + ["mac" "Macintosh"] + ["unix" "Unix"] + ;; binary platforms + ["i386-win32" "Windows x86"] + ["(ppc|i386)-osx-mac" + ,(lambda (_ cpu) + (format "Macintosh OS X (~a)" (if (equal? cpu "ppc") "PPC" "Intel")))] + ["(ppc|68k)-mac-classic" "Macintosh Classic (\\1)"] + ["(ppc|i386)-darwin" + ,(lambda (_ cpu) + (format "Macintosh Darwin (~a)" + (if (equal? cpu "ppc") "PPC" "Intel")))] + ["i386-linux(-gcc2)?" "Linux (i386)"] + ["i386-linux-fc([0-9]+)" "Linux - Fedora Core \\1 (i386)"] + ["(i386|x86_64)-linux-f([0-9]+)" "Linux - Fedora \\2 (\\1)"] + ["i386-linux-debian" "Linux - Debian Stable (i386)"] + ["i386-linux-debian-(testing|unstable)" "Linux - Debian \\1 (i386)"] + ["i386-linux-ubuntu[0-9]*" "Linux - Ubuntu (i386)"] + ["i386-linux-ubuntu-([a-z]*)" "Linux - Ubuntu \\1 (i386)"] + ["i386-freebsd" "FreeBSD (i386)"] + ["sparc-solaris" "Sparc Solaris (SunOS)"] + ["i386-kernel" "x86 Standalone Kernel"] + )) + +(define -file-type-names- + '(["sh" "Self-extracting shell script"] + ["exe" "Windows Installer"] + ["tgz" "Gzipped TAR Archive"] + ["zip" "Zipped Archive"] + ["dmg" "Disk Image"] + ["plt" "Racket Package"] + ["sit" "StuffIt Archive"])) + +(define -mirrors- + ;; This is a sequence of + ;; (location url reposnisble-name email [techincal-contact]) + '(("Main download (USA, Massachusetts, Northeastern University)" + "http://download.racket-lang.org/installers/" + "Eli Barzilay" + "eli@barzilay.org") + #; + ("USA, Illinois (Northwestern University)" + "http://www.eecs.northwestern.edu/racket/" + "Robby Findler" + "robby@eecs.northwestern.edu") + #; + ("USA, Utah (University of Utah)" + "http://www.cs.utah.edu/plt/download/" + "Matthew Flatt" + "mflatt@cs.utah.edu") + #; ; Scheme guy left + ("France (Institut Pasteur)" + "ftp://ftp.pasteur.fr/pub/computing/Scheme/plt-scheme/" + "Marc Badouin" + "babafou@pasteur.fr" + "Pasteur Institute FTP ftpmain@pasteur.fr") + (("Germany (Universität Tübingen)") + "http://mirror.informatik.uni-tuebingen.de/mirror/racket/" + "Marcus Crestani" + "crestani@informatik.uni-tuebingen.de") + ("Belgium (Infogroep, Vrije Universiteit Brussel)" + "ftp://infogroep.be/pub/racket/installers/" + "Infogroep" + "research@infogroep.be") + #; ; ftp down (permanently?) + ("Mexico (Wish Computing)" + "ftp://morpheus.wish.com.mx/pub/plt/" + "Francisco Solsona" + "solsona@acm.org") + #; + ("Austria (Vienna University of Technology)" + "http://gd.tuwien.ac.at/languages/scheme/plt/" + "Rudolf Ladner" + "ladner@zid.tuwien.ac.at") + #; + ("Turkey, Istanbul (Bilgi University)" + "http://russell.cs.bilgi.edu.tr/plt-bundles/" + "Onur Gungor" + "onurgu@cs.bilgi.edu.tr") )) ;; ---------------------------------------------------------------------------- -(provide versions+dates all-versions current-version) +(provide versions+dates all-versions current-version version->date + (struct-out mirror) mirrors + (struct-out installer) all-installers platform->name suffix->name) (require racket/list racket/file version/utils racket/runtime-path) @@ -50,25 +138,45 @@ (define versions+dates (sort -versions+dates- < - #:key (compose version->integer car) #:cache-keys? #t)) + #:key (lambda (vd) + (version->integer (regexp-replace #rx"^0+" (car vd) ""))) + #:cache-keys? #t)) (define all-versions (map car versions+dates)) (define current-version (last all-versions)) +(define version->date + (let ([t (make-hash)]) + (for ([vd (in-list versions+dates)]) + (hash-set! t (car vd) (cadr vd))) + (lambda (v) + (hash-ref t v (lambda () + (error 'version->date "unknown version: ~e" v)))))) + +;; ---------------------------------------------------------------------------- + +(struct mirror (location url person email)) + +(define mirrors + (map (lambda (m) + (mirror (car m) (regexp-replace #rx"/?$" (cadr m) "/") + (caddr m) (cadddr m))) + -mirrors-)) + ;; ---------------------------------------------------------------------------- (define-runtime-path installers-data "installers.txt") (struct installer (path ; path to file from the installers directory + file ; just the file name version ; version of the installer (as a string) size ; human-readable size string package ; package kind symbol 'racket or 'racket-textual binary? ; #t = binary distribution, #f = source distribution platform ; platform name string (generic for srcs, cpu-os for bins) - suffix ; string - )) + suffix)) ; string (define installer-rx (pregexp (string-append @@ -79,16 +187,17 @@ "([0-9p.]+)" ; version "/" "(racket(?:-textual)?)" ; package - "/\\4-\\3-" ; -- + "/(" ; file + "\\4-\\3-" ; -- "(bin|src)-" ; binary/source "([^.]+)" ; platform "\\." "([a-z]+)" ; suffix - ")$"))) + "))$"))) -(define (make-installer size path version package type platform suffix) - (installer path version size (string->symbol package) (equal? "bin" type) - platform suffix)) +(define (make-installer size path version package file type platform suffix) + (installer path file version size (string->symbol package) + (equal? "bin" type) platform suffix)) (define (parse-installers in) (port-count-lines! in) @@ -98,4 +207,25 @@ (error 'installers "bad installer data line#~a: ~s" num line)))))) -(define installers (call-with-input-file installers-data parse-installers)) +(define all-installers (call-with-input-file installers-data parse-installers)) + +(define platform-names + (for/list ([pn (in-list -platform-names-)]) + (list (regexp (string-append "^" (car pn) "$")) (cadr pn)))) + +(define platform-names-table (make-hash)) + +(define (platform->name platform) + (hash-ref! platform-names-table platform + (lambda () + (or (for/or ([pn (in-list platform-names)]) + ;; find out if a regexp applied by checking if the result is + ;; different (relies on regexp-replace returning the same string + ;; when fails) + (let ([new (regexp-replace (car pn) platform (cadr pn))]) + (and (not (eq? new platform)) new))) + (error 'platform->name "unrecognized platform: ~e" platform))))) + +(define (suffix->name suffix) + (cond [(assoc suffix -file-type-names-) => cadr] + [else (error 'suffix->name "unrecognized suffix: ~e" suffix)])) diff --git a/collects/meta/web/download/installer-pages.rkt b/collects/meta/web/download/installer-pages.rkt new file mode 100644 index 0000000000..81639641e3 --- /dev/null +++ b/collects/meta/web/download/installer-pages.rkt @@ -0,0 +1,51 @@ +#lang at-exp s-exp "shared.rkt" + +(require "data.rkt") + +(define (render-installer-page installer) + (define path (installer-path installer)) + (define file (installer-file installer)) + (define html-file (string-append (regexp-replace* #rx"\\." file "-") ".html")) + (define version (installer-version installer)) + (define date (version->date version)) + (define package + (string-titlecase + (regexp-replace #rx"-" (->string (installer-package installer)) " "))) + (define size (installer-size installer)) + (define type (if (installer-binary? installer) "" " source")) + (define platform (platform->name (installer-platform installer))) + (define title @text{Download @package v@|version type| for @platform}) + (define suffix-desc (suffix->name (installer-suffix installer))) + (define (row label text) + @tr[valign: 'top]{ + @td[align: 'right]{@b{@label}:} + @td{@nbsp} + @td[align: 'left]{@text}}) + @page[#:file html-file #:title title]{ + @table[width: "90%" align: 'center]{ + @tr[valign: 'top]{ + @td[width: "50%"]{ + @table{@(row "Package" package) + @(row "Version" @list{@version (@date)}) + @(row "Platform" platform) + @(row "Type" suffix-desc) + @(row "File" file) + @(row "Size" size)}} + @td[width: "50%"]{ + Download links: + @div[style: "font-size: 75%; text-align: right; float: right;"]{ + (Choose the nearest site)} + @ul{@(map (lambda (m) + @li{@a[href: (list (mirror-url m) path)]{ + @(mirror-location m)}}) + mirrors)}}}} + @;TODO: decide whether this is really needed + @; (looks redundant now that all of the installers are pretty standard) + @;section{Installation instructions} + @;(bundle-installation-instructions bundle) + @;br{} + @;div[align: 'right]{(@(link-to 'license))} + }) + +(provide installer-pages) +(define installer-pages (map render-installer-page all-installers)) diff --git a/collects/meta/web/www/download.rkt b/collects/meta/web/www/download.rkt index 54d155f512..5d3e8892c1 100644 --- a/collects/meta/web/www/download.rkt +++ b/collects/meta/web/www/download.rkt @@ -1,13 +1,13 @@ #lang at-exp s-exp "shared.rkt" -(require "../download/data.rkt") +(require "../download/installer-pages.rkt") (provide download-button) (define download (page #:link-title "Download" #:window-title "Download Racket" #:file "download/" - "Download page comes here.")) + (ul (map li installer-pages)))) (define download-button (let ([img1 (copyfile (in-here "download.png"))]