← Back to branch summary

~ubuntu-branches/ubuntu/trusty/librep/trusty

« back to all changes in this revision

Viewing changes to lisp/rep/www/cgi-get.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2001-11-13 15:06:22 UTC
  • Revision ID: james.westby@ubuntu.com-20011113150622-vgmgmk6srj3kldr3
Tags: upstream-0.15.2
Import upstream version 0.15.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/rep/www/cgi-get.jl
 
1
;; cgi-get.jl -- return the parameters from a CGI GET request
 
2
;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
 
3
 
 
4
;; $Id: cgi-get.jl,v 1.9 2001/09/15 21:43:12 jsh Exp $
 
5
 
 
6
;; This file is part of librep.
 
7
 
 
8
;; librep is free software; you can redistribute it and/or modify it
 
9
;; under the terms of the GNU General Public License as published by
 
10
;; the Free Software Foundation; either version 2, or (at your option)
 
11
;; any later version.
 
12
 
 
13
;; librep is distributed in the hope that it will be useful, but
 
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
;; GNU General Public License for more details.
 
17
 
 
18
;; You should have received a copy of the GNU General Public License
 
19
;; along with librep; see the file COPYING.  If not, write to
 
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
21
 
 
22
(declare (unsafe-for-call/cc))
 
23
 
 
24
(define-structure rep.www.cgi-get
 
25
 
 
26
    (export cgi-get-params)
 
27
 
 
28
    (open rep
 
29
          rep.system
 
30
          rep.regexp
 
31
          rep.test.framework)
 
32
 
 
33
  (define-structure-alias cgi-get rep.www.cgi-get)
 
34
 
 
35
  (define unquote-plus-map (let ((map (make-string (1+ ?+)))
 
36
                                 (i 0))
 
37
                             (while (< i ?+)
 
38
                               (aset map i i)
 
39
                               (setq i (1+ i)))
 
40
                             (aset map ?+ ? )
 
41
                             map))
 
42
 
 
43
  (defun cgi-get-params (#!optional query-string)
 
44
    (unless query-string
 
45
      (setq query-string (getenv "QUERY_STRING")))
 
46
    (let
 
47
        ((point 0)
 
48
         (params nil)
 
49
         name value)
 
50
      (while (string-looking-at "([^=]+)=([^&]*)(&|$)" query-string point)
 
51
        (setq point (match-end))
 
52
        (setq name (intern
 
53
                    (unquote
 
54
                     (substring query-string (match-start 1) (match-end 1)))))
 
55
        (setq value (unquote
 
56
                     (substring query-string (match-start 2) (match-end 2))))
 
57
        (when (string= value "")
 
58
          (setq value nil))
 
59
        (setq params (cons (cons name value) params)))
 
60
      (nreverse params)))
 
61
 
 
62
  (defsubst hexdigit (char)
 
63
    (if (and (>= char ?0) (<= char ?9))
 
64
        (- char ?0)
 
65
      (+ (- (char-upcase char) ?A) 10)))
 
66
 
 
67
  (defun unquote (string)
 
68
    (let
 
69
        ((frags nil)
 
70
         (point 0))
 
71
      (setq string (translate-string string unquote-plus-map))
 
72
      (while (string-match "%.." string point)
 
73
        (setq frags (cons (substring string point (match-start)) frags))
 
74
        (setq point (match-end))
 
75
        (setq frags (cons (+ (* (hexdigit (aref string (- point 2))) 16)
 
76
                             (hexdigit (aref string (1- point)))) frags)))
 
77
      (if (zerop point)
 
78
          string
 
79
        (setq frags (cons (substring string point) frags))
 
80
        (apply concat (nreverse frags)))))
 
81
 
 
82
 
 
83
;; Tests
 
84
 
 
85
  (define (self-test)
 
86
    (test (equal (cgi-get-params "")
 
87
                 '()))
 
88
    (test (equal (cgi-get-params "foo=bar")
 
89
                 '((foo . "bar"))))
 
90
    (test (equal (cgi-get-params "foo=bar&baz=quux")
 
91
                 '((foo . "bar") (baz . "quux"))))
 
92
    (test (equal (cgi-get-params "foo=&baz=quux")
 
93
                 '((foo . ()) (baz . "quux"))))
 
94
    (test (equal (cgi-get-params "foo=%3A%2F%3D")
 
95
                 '((foo . ":/="))))
 
96
    (test (equal (cgi-get-params "foo=+bar+")
 
97
                 '((foo . " bar ")))))
 
98
 
 
99
  ;;###autoload
 
100
  (define-self-test 'rep.www.cgi-get self-test))