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))))
|