Changeset 27411 in project

Timestamp:

09/11/12 21:01:54 (9 years ago)

Author:

ddp

Message:

switch to http-client

Location:

release/4/yelp/trunk

Files:

• yelp.meta (modified) (1 diff)
• yelp.scm (modified) (3 diffs)
• yelp.setup (modified) (1 diff)

release/4/yelp/trunk/yelp.meta

@@ -1 +1 @@
 ((egg "yelp.egg")
- (synopsis "An interface to the Yelp developer API")
+ (synopsis "An interface to the (deprecated) Yelp v1.0 API")
  (category web)
  (author "[[derrell piper]]")
  (license "BSD")
- (doc-from-wiki)
- (needs json)
+ (needs json http-client)
  (test-depends test)
  (files "yelp.meta" "yelp.setup" "api-review-search.pdf" "api-phone.pdf" "api-neighborhood.pdf" "yelp.release-info" "yelp.scm" "tests/run.scm"))

release/4/yelp/trunk/yelp.scm

@@ -1 @@
-;; Copyright (c) 2009 Derrell Piper.
-;;
-;; 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 3 of the License, 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.
-;;
-;; A full copy of the GPL license can be found at
-;; <http://www.gnu.org/licenses/>.
+;; Copyright (c) 2009, Derrell Piper
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met: 
+
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer. 
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution. 
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;; The views and conclusions contained in the software and documentation are those
+;; of the authors and should not be interpreted as representing official policies, 
+;; either expressed or implied, of the FreeBSD Project.
 
 (module yelp
@@ -27 +39 @@
    find)
 
-(import scheme chicken data-structures ports extras tcp json)
-(require-library tcp json)
-
-;;;; HTML request/response
+(import scheme chicken data-structures ports extras tcp json http-client)
+(require-library tcp json http-client)
+
+;;;; HTTP request/response
 
 (define (yelp-do request)
-
-  (define yelp-server "api.yelp.com")
-  (define yelp-port 80)
-
-  (define crlf (string #\return #\linefeed))
-  (define content-length "Content-Length: ")
-
-  ;; HTTP/1.1 200 OK
-  (define (html-response-ok? response #!optional (port #t))
-    (let* ((r (substring response 9 12))
-           (code (string-ref r 0)))
-      (cond ((char=? code #\3)
-             (format port "Redirect: ~a~%" r))
-            ((char=? code #\4)
-             (format port "Client error: ~a~%" r))
-            ((char=? code #\5)
-             (format port "Server error: ~a~%" r)))
-      (string=? r "200")))
-
-  (call/cc
-   (lambda (return)
-     (let-values (((in out) (tcp-connect yelp-server yelp-port)))
-       (condition-case
-        (begin
-          (format out "GET /~a&ywsid=~a HTTP/1.0~a" request ywsid crlf)
-          (format out "User-Agent: Chicken/~a (~a)~a" (chicken-version) (software-version) crlf)
-          (format out "Accept: */*~a" crlf)
-          (format out "Host: api.yelp.com~a" crlf)
-          (format out "Connection: Keep-Alive~a" crlf)
-          (format out "~a" crlf)
-          (flush-output out)
-          (let ((response (read-line in))
-                (json #f)
-                (json-length 0))
-            (if (html-response-ok? response)
-                (let loop ()
-                  (let ((header (read-line in)))
-                    (if (= 0 (string-length header))
-                        (begin
-                          (let json-loop ((next 0))
-                            (when (< next json-length)
-                              (string-set! json next (read-char in))
-                              (json-loop (+ 1 next))))
-                          (close-input-port in)
-                          (close-output-port out)
-                          (return json)))
-                    (if (and (> (string-length header) (string-length content-length))
-                             (string=? content-length (substring header 0 (string-length content-length))))
-                        (begin
-                          (set! json-length (string->number (substring header (string-length content-length) (string-length header))))
-                          (set! json (make-string json-length))))
-                    (loop)))
-                (return #f))))
-        (e ()
-           (format #t "yelp-do: exception: ~a~%" e)
-           (close-input-port in)
-           (close-output-port out)
-           (return #f)))))))
+  (let-values (((result request-uri response)
+                (with-input-from-request 
+                 (with-output-to-string 
+                   (lambda ()
+                     (format #t "http://api.yelp.com/~a&ywsid=~a" request ywsid))) #f read-string)))
+    result))
 
 ;; Make a Yelp request and check the Yelp response.
@@ -308 +268 @@
 
   (if (valid? object)
-      (begin
-        (and-let* ((categories (find object "businesses.categories"))
-                   (len (length categories)))
-          (format port "Categories: ")
-          (let loop ((i 0))
-            (if (< i len)
-                (let ((c (list-ref categories i)))
-                  (format port "~a~a" (find c "name") (if (< i (- len 1)) ", " ""))
-                  (loop (+ 1 i)))))
-          (newline))
-        (display-if port (json-find object "businesses.neighborhoods.name") "Neighborhood: ~a~%")
-        (display-if port (json-find object "businesses.name"))
-        (display-if port (json-find object "businesses.address1"))
-        (display-if port (json-find object "businesses.address2"))
-        (display-if port (json-find object "businesses.address3"))
-        (format port "~a, ~a ~a~%"
-                (json-find object "businesses.city")
-                (json-find object "businesses.state")
-                (json-find object "businesses.zip"))
-        (display-if port (pretty-phone (json-find object "businesses.phone")))
-
-        (and-let* ((latitude (json-find object "businesses.latitude"))
-                   (lat (number->string latitude))
-                   (longitude (json-find object "businesses.longitude"))
-                   (lon (number->string longitude))
-                   (a (substring-index "." lat))
-                   (a-end (min (+ a 7) (string-length lat)))
-                   (l (substring-index "." lon))
-                   (l-end (min (+ l 7) (string-length lon))))
-          (format port "~a ~a~%" (substring lat 0 a-end) (substring lon 0 l-end))))
-      'yelp-invalid-response))
+      (if (not (find object "businesses.categories"))
+          (format port "Business not found~%")
+          (begin
+            (and-let* ((categories (find object "businesses.categories"))
+                       (len (length categories)))
+              (format port "Categories: ")
+              (let loop ((i 0))
+                (if (< i len)
+                    (let ((c (list-ref categories i)))
+                      (format port "~a~a" (find c "name") (if (< i (- len 1)) ", " ""))
+                      (loop (+ 1 i)))))
+              (newline))
+            (display-if port (json-find object "businesses.neighborhoods.name") "Neighborhood: ~a~%")
+            (display-if port (json-find object "businesses.name"))
+            (display-if port (json-find object "businesses.address1"))
+            (display-if port (json-find object "businesses.address2"))
+            (display-if port (json-find object "businesses.address3"))
+            (format port "~a, ~a ~a~%"
+                    (json-find object "businesses.city")
+                    (json-find object "businesses.state")
+                    (json-find object "businesses.zip"))
+            (display-if port (pretty-phone (json-find object "businesses.phone")))
+
+            (and-let* ((latitude (json-find object "businesses.latitude"))
+                       (lat (number->string latitude))
+                       (longitude (json-find object "businesses.longitude"))
+                       (lon (number->string longitude))
+                       (a (substring-index "." lat))
+                       (a-end (min (+ a 7) (string-length lat)))
+                       (l (substring-index "." lon))
+                       (l-end (min (+ l 7) (string-length lon))))
+              (format port "~a ~a~%" (substring lat 0 a-end) (substring lon 0 l-end)))))
+      'yelp-request-invalid))
 
 ;; Decode JSON response.  The JSON egg returns structures as vectors and arrays as lists.

release/4/yelp/trunk/yelp.setup

@@ -5 +5 @@
  'yelp
  '("yelp.so" "yelp.o" "yelp.import.so")
- '((version 1.0.2)
+ '((version 1.0.3)
    (static "yelp.o")))