r5347: *** empty log message ***

This commit is contained in:
Kevin M. Rosenberg
2003-07-20 18:56:55 +00:00
parent 37f9619327
commit ccfeb8799c
5 changed files with 129 additions and 107 deletions

34
README
View File

@ -1,8 +1,25 @@
PURI - Portable URI Library
===========================
AUTHORS
-------
Franz, Inc <http://www.franz.com>
Kevin Rosenberg <kevin@rosenberg.net>
DOWNLOAD
--------
Puri home: http://files.b9.com/puri/
Portable tester home: http://files.b9.com/tester/
SUPPORTED PLATFORMS
-------------------
AllegroCL, CLISP, CMUCL, Lispworks, OpenMCL, SBCL
OVERVIEW
--------
This is portable Universal Resource Identifier library for Common Lisp
programs. It parses URI according to the RFC 2396 specification. It's
is based on Franz, Inc's opensource URI package and has been ported to
@ -14,11 +31,16 @@ library. I've ported that library for use on other CL
implementations. Puri completes 126/126 regression tests successfully.
Franz's unmodified documentation file is included in the file
uri.html. The only divergence in usage between Puri and Franz's
package is that Puri's symbols are located in the package PURI while
Franz's original uses the package NET.URI.
Puri home: http://files.b9.com/puri/
Portable tester home: http://files.b9.com/tester/
uri.html.
DIFFERENCES BETWEEN PURI and NET.URI
------------------------------------
* Puri uses the package 'puri while NET.URI uses the package 'net.uri
* To signal an error parsing a URI, Puri uses the condition
:uri-parse-error while NET.URI uses the condition :parse-error. This
divergence occurs because Franz's parse-error condition uses
:format-control and :format-arguments slots which are not in the ANSI
specification for the parse-error condition.

5
debian/changelog vendored
View File

@ -1,8 +1,9 @@
cl-puri (1.2.6-1) unstable; urgency=low
* Fix .parse-error
* Change parse-error condition to uri-parse-error for
cross-implementation compatibility.
--
-- Kevin M. Rosenberg <kmr@debian.org> Sun, 20 Jul 2003 11:52:03 -0600
cl-puri (1.2.5-1) unstable; urgency=low

View File

@ -20,7 +20,7 @@
(oos 'test-op 'puri-tests))
(defsystem puri-tests
:depends-on (:puri :tester)
:depends-on (:puri :ptester)
:components
((:file "tests")))

View File

@ -22,7 +22,7 @@
;; Original version from ACL 6.1:
;; uri.cl,v 2.3.6.4.2.1 2001/08/09 17:42:39 layer
;;
;; $Id: src.lisp,v 1.8 2003/07/20 16:25:21 kevin Exp $
;; $Id: src.lisp,v 1.9 2003/07/20 18:51:48 kevin Exp $
(defpackage #:puri
(:use #:cl)
@ -55,13 +55,14 @@
#:uri=
#:intern-uri
#:unintern-uri
#:do-all-uris))
#:do-all-uris
#:uri-parse-error ;; Added by KMR
))
(in-package #:puri)
(eval-when (:compile-toplevel)
(declaim (optimize (speed 3))))
(eval-when (:compile-toplevel) (declaim (optimize (speed 3))))
#-allegro
@ -97,19 +98,18 @@
(subseq str 0 size))
#-(or allegro lispworks)
(define-condition parse-error (error)
((fmt-control :initarg :fmt-control
:reader fmt-control)
(fmt-args :initarg :fmt-args
:reader fmt-args))
(:report (lambda (c stream)
(format stream "Parse error: ")
(apply #'format stream (fmt-control c) (fmt-args c)))))
;; KMR: Added new condition to handle cross-implementation variances
;; in the parse-error condition many implementations define
(define-condition uri-parse-error (parse-error)
((fmt-control :initarg :fmt-control :accessor fmt-control)
(fmt-arguments :initarg :fmt-arguments :accessor fmt-arguments ))
(:report (lambda (c stream)
(format stream "Parse error:")
(apply #'format stream (fmt-control c) (fmt-arguments c)))))
#-allegro
(defun .parse-error (fmt &rest args)
(error (make-condition 'parse-error :fmt-control fmt :fmt-args args)))
(error 'uri-parse-error :fmt-control fmt :fmt-arguments args))
#-allegro
(defun internal-reader-error (stream fmt &rest args)
@ -119,7 +119,6 @@
#+allegro (eval-when (:compile-toplevel :load-toplevel :execute)
(import '(excl:*current-case-mode*
excl:delimited-string-to-list
excl::.parse-error
excl::parse-body
excl::internal-reader-error
excl:if*)))

View File

@ -20,10 +20,10 @@
;; Original version from ACL 6.1:
;; t-uri.cl,v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
;;
;; $Id: tests.lisp,v 1.4 2003/07/18 23:33:53 kevin Exp $
;; $Id: tests.lisp,v 1.5 2003/07/20 18:51:48 kevin Exp $
(defpackage #:puri-tests (:use #:puri #:cl #:util.test))
(defpackage #:puri-tests (:use #:puri #:cl #:ptester))
(in-package #:puri-tests)
(unintern-uri t)
@ -90,7 +90,7 @@
("foo/bar;x;y/bam.htm"
"http://a/b/c/foo/bar;x;y/bam.htm"
"http://a/b/c/")))
(push `(util.test:test (intern-uri ,(second x))
(push `(test (intern-uri ,(second x))
(intern-uri (merge-uris (intern-uri ,(first x))
(intern-uri ,(third x))))
:test 'uri=)
@ -115,7 +115,7 @@
(;; %72 is "r", %2f is "/", %3b is ";"
"http://www.franz.com/ba%72%2f%3b;x;y;z/baz/"
"http://www.franz.com/bar%2f%3b;x;y;z/baz/" eq)))
(push `(util.test:test (intern-uri ,(second x))
(push `(test (intern-uri ,(second x))
(intern-uri ,(first x))
:test ',(if (third x)
(third x)
@ -123,125 +123,125 @@
res))
;;;; parsing and equivalence tests
(push `(util.test:test
(push `(test
(parse-uri "http://foo+bar?baz=b%26lob+bof")
(parse-uri (parse-uri "http://foo+bar?baz=b%26lob+bof"))
:test 'uri=)
res)
(push '(util.test:test
(push '(test
(parse-uri "http://www.foo.com")
(parse-uri (parse-uri "http://www.foo.com?")) ; allow ? at end
:test 'uri=)
res)
(push `(util.test:test
(push `(test
"baz=b%26lob+bof"
(uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof"))
:test 'string=)
res)
(push `(util.test:test
(push `(test
"baz=b%26lob+bof%3d"
(uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof%3d"))
:test 'string=)
res)
(push
`(util.test:test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
`(test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
res)
(push
`(util.test:test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
`(test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
res)
(push `(util.test:test-error (parse-uri " ")
:condition-type 'parse-error)
(push `(test-error (parse-uri " ")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "foo ")
:condition-type 'parse-error)
(push `(test-error (parse-uri "foo ")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri " foo ")
:condition-type 'parse-error)
(push `(test-error (parse-uri " foo ")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "<foo")
:condition-type 'parse-error)
(push `(test-error (parse-uri "<foo")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "foo>")
:condition-type 'parse-error)
(push `(test-error (parse-uri "foo>")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "<foo>")
:condition-type 'parse-error)
(push `(test-error (parse-uri "<foo>")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "%")
:condition-type 'parse-error)
(push `(test-error (parse-uri "%")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "foo%xyr")
:condition-type 'parse-error)
(push `(test-error (parse-uri "foo%xyr")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "\"foo\"")
:condition-type 'parse-error)
(push `(test-error (parse-uri "\"foo\"")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test "%20" (format nil "~a" (parse-uri "%20"))
(push `(test "%20" (format nil "~a" (parse-uri "%20"))
:test 'string=)
res)
(push `(util.test:test "&" (format nil "~a" (parse-uri "%26"))
(push `(test "&" (format nil "~a" (parse-uri "%26"))
:test 'string=)
res)
(push
`(util.test:test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
`(test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
:test 'string=)
res)
(push
`(util.test:test "foo%23bar#foobar"
`(test "foo%23bar#foobar"
(format nil "~a" (parse-uri "foo%23bar#foobar"))
:test 'string=)
res)
(push
`(util.test:test "foo%23bar#foobar#baz"
`(test "foo%23bar#foobar#baz"
(format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
:test 'string=)
res)
(push
`(util.test:test "foo%23bar#foobar#baz"
`(test "foo%23bar#foobar#baz"
(format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
:test 'string=)
res)
(push
`(util.test:test "foo%23bar#foobar/baz"
`(test "foo%23bar#foobar/baz"
(format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
:test 'string=)
res)
(push `(util.test:test-error (parse-uri "foobar??")
:condition-type 'parse-error)
(push `(test-error (parse-uri "foobar??")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "foobar?foo?")
:condition-type 'parse-error)
(push `(test-error (parse-uri "foobar?foo?")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test "foobar?%3f"
(push `(test "foobar?%3f"
(format nil "~a" (parse-uri "foobar?%3f"))
:test 'string=)
res)
(push `(util.test:test
(push `(test
"http://foo/bAr;3/baz?baf=3"
(format nil "~a" (parse-uri "http://foo/b%41r;3/baz?baf=3"))
:test 'string=)
res)
(push `(util.test:test
(push `(test
'(:absolute ("/bAr" "3") "baz")
(uri-parsed-path (parse-uri "http://foo/%2fb%41r;3/baz?baf=3"))
:test 'equal)
res)
(push `(util.test:test
(push `(test
"/%2fbAr;3/baz"
(let ((u (parse-uri "http://foo/%2fb%41r;3/baz?baf=3")))
(setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
(uri-path u))
:test 'string=)
res)
(push `(util.test:test
(push `(test
"http://www.verada.com:8010/kapow?name=foo%3Dbar%25"
(format nil "~a"
(parse-uri
"http://www.verada.com:8010/kapow?name=foo%3Dbar%25"))
:test 'string=)
res)
(push `(util.test:test
(push `(test
"ftp://parcftp.xerox.com/pub/pcl/mop/"
(format nil "~a"
(parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/"))
@ -277,7 +277,7 @@
("http://www.franz.com"
"http://www.franz.com"
"/")))
(push `(util.test:test (parse-uri ,(third x))
(push `(test (parse-uri ,(third x))
(enough-uri (parse-uri ,(first x))
(parse-uri ,(second x)))
:test 'uri=)
@ -285,130 +285,130 @@
;;;; urn tests, ideas of which are from rfc2141
(let ((urn "urn:com:foo-the-bar"))
(push `(util.test:test "com" (urn-nid (parse-uri ,urn))
(push `(test "com" (urn-nid (parse-uri ,urn))
:test #'string=)
res)
(push `(util.test:test "foo-the-bar" (urn-nss (parse-uri ,urn))
(push `(test "foo-the-bar" (urn-nss (parse-uri ,urn))
:test #'string=)
res))
(push `(util.test:test-error (parse-uri "urn:")
:condition-type 'parse-error)
(push `(test-error (parse-uri "urn:")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "urn:foo")
:condition-type 'parse-error)
(push `(test-error (parse-uri "urn:foo")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "urn:foo$")
:condition-type 'parse-error)
(push `(test-error (parse-uri "urn:foo$")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "urn:foo_")
:condition-type 'parse-error)
(push `(test-error (parse-uri "urn:foo_")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test-error (parse-uri "urn:foo:foo&bar")
:condition-type 'parse-error)
(push `(test-error (parse-uri "urn:foo:foo&bar")
:condition-type 'uri-parse-error)
res)
(push `(util.test:test (parse-uri "URN:foo:a123,456")
(push `(test (parse-uri "URN:foo:a123,456")
(parse-uri "urn:foo:a123,456")
:test #'uri=)
res)
(push `(util.test:test (parse-uri "URN:foo:a123,456")
(push `(test (parse-uri "URN:foo:a123,456")
(parse-uri "urn:FOO:a123,456")
:test #'uri=)
res)
(push `(util.test:test (parse-uri "urn:foo:a123,456")
(push `(test (parse-uri "urn:foo:a123,456")
(parse-uri "urn:FOO:a123,456")
:test #'uri=)
res)
(push `(util.test:test (parse-uri "URN:FOO:a123%2c456")
(push `(test (parse-uri "URN:FOO:a123%2c456")
(parse-uri "urn:foo:a123%2C456")
:test #'uri=)
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:A123,456")
(parse-uri "urn:FOO:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:A123,456")
(parse-uri "urn:foo:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:A123,456")
(parse-uri "URN:foo:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:a123%2C456")
(parse-uri "urn:FOO:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:a123%2C456")
(parse-uri "urn:foo:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "URN:FOO:a123%2c456")
(parse-uri "urn:foo:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:FOO:a123%2c456")
(parse-uri "urn:foo:a123,456")))
res)
(push `(util.test:test
(push `(test
nil
(uri= (parse-uri "urn:foo:a123%2c456")
(parse-uri "urn:foo:a123,456")))
res)
(push `(util.test:test t
(push `(test t
(uri= (parse-uri "foo") (parse-uri "foo#")))
res)
(push
'(let ((puri::*strict-parse* nil))
(util.test:test-no-error
(test-no-error
(puri:parse-uri
"http://foo.com/bar?a=zip|zop")))
res)
(push
'(util.test:test-error
'(test-error
(puri:parse-uri "http://foo.com/bar?a=zip|zop")
:condition-type 'parse-error)
:condition-type 'uri-parse-error)
res)
(push
'(let ((puri::*strict-parse* nil))
(util.test:test-no-error
(test-no-error
(puri:parse-uri
"http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")))
res)
(push
'(util.test:test-error
'(test-error
(puri:parse-uri
"http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")
:condition-type 'parse-error)
:condition-type 'uri-parse-error)
res)
(push
'(let ((puri::*strict-parse* nil))
(util.test:test-no-error
(test-no-error
(puri:parse-uri
"http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_onWebEvent(hrfTIOLI)?selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&selGetClubOffer.TB_OFFER_ID_ITEM=34487%2e0&selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&^CSpCommand.currRowNumber=5&hrfTIOLI=The+Visual+Basic+6+Programmer%27s+Toolkit&SPIDERSESSION=%3f%3f%3f%3f%3f%5f%3f%3f%3f%40%5b%3f%3f%3f%3fBOs%5cH%3f%3f%3f%3f%3f%3f%3f%3f%3fMMpXO%5f%40JG%7d%40%5c%5f%3f%3f%3fECK%5dt%3fLDT%3fTBD%3fDDTxPEToBS%40%5f%5dBDgXVoKBSDs%7cDT%3fK%3fd%3fTIb%7ceHbkeMfh%60LRpO%5cact%5eUC%7bMu%5fyWUGzLUhP%5ebpdWRka%5dFO%3f%5dBopW%3f%40HMrxbMRd%60LOpuMVga%3fv%3fTS%3fpODT%40O&%5euniqueValue=977933764843")))
res)
(push
'(util.test:test-error
'(test-error
(puri:parse-uri
"http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_onWebEvent(hrfTIOLI)?selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&selGetClubOffer.TB_OFFER_ID_ITEM=34487%2e0&selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&^CSpCommand.currRowNumber=5&hrfTIOLI=The+Visual+Basic+6+Programmer%27s+Toolkit&SPIDERSESSION=%3f%3f%3f%3f%3f%5f%3f%3f%3f%40%5b%3f%3f%3f%3fBOs%5cH%3f%3f%3f%3f%3f%3f%3f%3f%3fMMpXO%5f%40JG%7d%40%5c%5f%3f%3f%3fECK%5dt%3fLDT%3fTBD%3fDDTxPEToBS%40%5f%5dBDgXVoKBSDs%7cDT%3fK%3fd%3fTIb%7ceHbkeMfh%60LRpO%5cact%5eUC%7bMu%5fyWUGzLUhP%5ebpdWRka%5dFO%3f%5dBopW%3f%40HMrxbMRd%60LOpuMVga%3fv%3fTS%3fpODT%40O&%5euniqueValue=977933764843")
:condition-type 'parse-error)
:condition-type 'uri-parse-error)
res)
`(progn ,@(nreverse res))))
(defun do-tests ()
(let ((util.test:*break-on-test-failures* t))
(let ((*break-on-test-failures* t))
(with-tests (:name "puri")
(gen-test-forms)))
t)