File: uri.lisp

package info (click to toggle)
cl-imho 1.2.1-1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 1,604 kB
  • ctags: 1,104
  • sloc: lisp: 6,569; ansic: 2,120; makefile: 222; sh: 143
file content (47 lines) | stat: -rw-r--r-- 1,708 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: imho -*-
;;; $Id: uri.lisp,v 1.16 2001/11/12 20:07:08 jesse Exp $
;;;
;;; Copyright (c) 1999, 2000, 2001 onShore Development, Inc.
;;;
;;; See the file 'COPYING' in this directory for terms.

(in-package :imho)

;; Wants to be based on: RFC 2396 - URI Generic Syntax - August 1998

(defun parse-uri-segment (list string)
  (if (null string)
      (values (nreverse (cons string list)) nil)
    (let ((next (position #\/ string)))
      (if (null next)
	  (let ((query (position #\? string)))
	    (if (null query)
		(values (nreverse (cons string list)) nil)
	      (values (nreverse (cons (subseq string 0 query) list)) "[query]")))
	(parse-uri-segment (cons (subseq string 0 next) list) (subseq string (+ 1 next)))))))

(defun absolute-url (url)
  (eql (aref url 0) #\/))

(defun parse-absolute-uri (string)
  (if (not (absolute-url string))
      (error "Not an absolute URI"))
  (parse-uri-segment nil (subseq string 1)))
    
(defun urldecode (string)
  (let* ((string (char-replace #\+ #\Space string))
         (encoded-char-count (char-count #\% string)))
    (if (= 0 encoded-char-count)
        string
        (let ((newstring (make-string (- (length string) (* 2 encoded-char-count))))
              (offset 0))
          (dotimes (i (length string))
            (if (char= #\% (aref string i))
                (let ((newchar (code-char (parse-integer string :start (+ 1 i) :end (+ 3 i) :radix 16))))
                  (setf (aref newstring offset) newchar)
                  (incf i 2))
                (setf (aref newstring offset)
                      (aref string i)))
            (incf offset))
          newstring))))