summaryrefslogtreecommitdiffstatshomepage
path: root/tekuti
diff options
context:
space:
mode:
authorGravatar Andy Wingo2011-02-22 22:16:19 +0100
committerGravatar Andy Wingo2011-02-22 22:19:30 +0100
commit1636c96f9ff85de266e96b7724f07a44ec255924 (patch)
tree52392a7b31661e1e5e23718fc36d4f8c760abc8c /tekuti
parent800e7d9a05bb33d711ce3c39e83886ec548209c9 (diff)
downloadtekuti-1636c96f9ff85de266e96b7724f07a44ec255924.tar.gz
tekuti-1636c96f9ff85de266e96b7724f07a44ec255924.zip
remove obsolete (tekuti url)
* tekuti/url.scm: Remove. * Makefile.am: Remove url.scm * tekuti/post.scm: Remove reference to (tekuti url). (parse-post-data): Use uri-encode.
Diffstat (limited to 'tekuti')
-rw-r--r--tekuti/post.scm6
-rw-r--r--tekuti/url.scm187
2 files changed, 3 insertions, 190 deletions
diff --git a/tekuti/post.scm b/tekuti/post.scm
index d280ac2..939afe6 100644
--- a/tekuti/post.scm
+++ b/tekuti/post.scm
@@ -26,9 +26,9 @@
(define-module (tekuti post)
#:use-module (srfi srfi-1)
+ #:use-module (web uri)
#:use-module (tekuti match-bind)
#:use-module (tekuti util)
- #:use-module (tekuti url)
#:use-module (tekuti comment)
#:use-module (tekuti config)
#:use-module (tekuti git)
@@ -190,10 +190,10 @@
(comment_status . ,(if comments-open? "open" "closed"))
(timestamp . ,timestamp)
(name . ,name)
- (key . ,(url:encode
+ (key . ,(uri-encode
(string-append (date->string (timestamp->date timestamp)
"~Y/~m/~d/")
- (url:encode name))))))))
+ (uri-encode name))))))))
(define (make-new-post post-data)
(munge-post #f (parse-post-data post-data)))
diff --git a/tekuti/url.scm b/tekuti/url.scm
deleted file mode 100644
index dc50dea..0000000
--- a/tekuti/url.scm
+++ /dev/null
@@ -1,187 +0,0 @@
-;;; www/url.scm --- URL manipulation tools
-
-;; Copyright (C) 1997,2001,2002 Free Software Foundation, Inc.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;; Boston, MA 02111-1307 USA
-;;
-
-;;; Commentary:
-
-;; This module exports the following procedures:
-;; (url:scheme url)
-;; (url:address url)
-;; (url:unknown url)
-;; (url:user url)
-;; (url:host url)
-;; (url:port url)
-;; (url:path url)
-;; (url:make scheme . args)
-;; (url:make-http host port path)
-;; (url:make-ftp user host port path)
-;; (url:make-mailto address)
-;; (url:parse url)
-;; (url:unparse url)
-;; (url:decode str)
-;; (url:encode str reserved-chars)
-
-;;; Code:
-
-
-;; TODO:
-;; * support `user:password@' strings where appropriate in URLs.
-;; * make URL parsing smarter. This is good for most TCP/IP-based
-;; URL schemes, but parsing is actually specific to each URL scheme.
-;; * fill out url:encode, include facilities for URL-scheme-specific
-;; encoding methods (e.g. a url-scheme-reserved-char-alist)
-
-(define-module (tekuti url)
- #:use-module ((srfi srfi-1) #:select (filter))
- #:use-module (ice-9 regex))
-
-;; `url:scheme' is an unfortunate term, but it is the technical
-;; name for that portion of the URL according to RFC 1738. Sigh.
-
-(define-public (url:scheme url) (vector-ref url 0))
-(define-public (url:address url) (vector-ref url 1))
-(define-public (url:unknown url) (vector-ref url 1))
-(define-public (url:user url) (vector-ref url 1))
-(define-public (url:host url) (vector-ref url 2))
-(define-public (url:port url) (vector-ref url 3))
-(define-public (url:path url) (vector-ref url 4))
-
-(define-public (url:make scheme . args)
- (apply vector scheme args))
-(define-public (url:make-http host port path)
- (vector 'http #f host port path))
-(define-public (url:make-ftp user host port path)
- (vector 'ftp user host port path))
-(define-public (url:make-mailto address)
- (vector 'mailto address))
-
-(define http-regexp (make-regexp "^http://([^:/]+)(:([0-9]+))?(/(.*))?$"))
-(define ftp-regexp
- (make-regexp "^ftp://(([^@:/]+)@)?([^:/]+)(:([0-9]+))?(/(.*))?$"))
-(define mailto-regexp (make-regexp "^mailto:(.*)$"))
-
-(define-public (url:parse url)
- (cond
- ((regexp-exec http-regexp url)
- => (lambda (m)
- (url:make-http (match:substring m 1)
- (cond ((match:substring m 3) => string->number)
- (else #f))
- (match:substring m 5))))
-
- ((regexp-exec ftp-regexp url)
- => (lambda (m)
- (url:make-ftp (match:substring m 2)
- (match:substring m 3)
- (cond ((match:substring m 5) => string->number)
- (else #f))
- (match:substring m 7))))
-
- ((regexp-exec mailto-regexp url)
- => (lambda (m)
- (url:make-mailto (match:substring m 1))))
-
- (else
- (url:make 'unknown url))))
-
-
-(define-public (url:unparse url)
- (define (pathy scheme username url) ; username not used!
- (format #f "~A://~A~A~A"
- scheme
- (url:host url)
- (cond ((url:port url) => (lambda (port) (format #f ":~A" port)))
- (else ""))
- (cond ((url:path url) => (lambda (path) (format #f "/~A" path)))
- (else ""))))
- (case (url:scheme url)
- ((http) (pathy 'http #f url))
- ((ftp) (pathy 'ftp (url:user url) url))
- ((mailto) (format #f "mailto:~A" (url:address url)))
- ((unknown) (url:unknown url))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (url-decode STR)
-;; Turn + into space, and hex-encoded %XX strings into their
-;; eight-bit characters. Is a regexp faster than character
-;; scanning? Does it incur more overhead (which may be more
-;; important for code that frequently gets restarted)?
-
-(define-public (url:decode str)
- (regexp-substitute/global
- #f "\\+|%([0-9A-Fa-f][0-9A-Fa-f])" str
- 'pre
- (lambda (m)
- (cond ((string=? "+" (match:substring m 0)) " ")
- (else (integer->char
- (string->number
- (match:substring m 1)
- 16)))))
- 'post))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (url-encode STR)
-;; The inverse of url-decode. Can't be done easily with
-;; a regexp: we would have to construct a regular expression
-;; like "[\277-\377]", for example, and Guile strings don't
-;; let you interpolate character literals. Pity.
-;; URL-encode any characters in STR that are not safe: these
-;; include any character not in the SAFE-CHARS list and any
-;; character that *is* in the RESERVED-CHARS list argument.
-
-(define-public (url:encode str)
- (with-output-to-string
- (lambda ()
- (for-each (lambda (ch)
- (if (safe-char? ch)
- (display ch)
- (begin
- (display #\%)
- (display (number->string (char->integer ch) 16)))))
- (string->list str)))))
-
-(define special-chars
- (string->list "$-_.+!*'()"))
-(define reserved-chars
- (string->list ";/?:@&="))
-
-(define (safe-char? ch)
- ;; ``Thus, only alphanumerics, the special characters "$-_.+!*'(),", and
- ;; reserved characters used for their reserved purposes may be used
- ;; unencoded within a URL.'' RFC 1738, #2.2.
- (or (char-alphabetic? ch)
- (char-numeric? ch)
- (memv ch special-chars)))
-
-(define-public (url:path-part path)
- (substring path 0 (or (string-index path #\?) (string-length path))))
-
-(define-public (url:query-part path)
- (let ((q (string-index path #\?)))
- (if q (substring path (1+ q)) #f)))
-
-(define-public (url:path-split path)
- (filter (lambda (x) (not (string-null? x)))
- (map url:decode (string-split (url:path-part path) #\/))))
-
-(define-public (url:path-join path)
- (string-join (map url:encode path) "/"))
-
-;;; www/url.scm ends here