Changeset 27411 in project


Ignore:
Timestamp:
09/11/12 21:01:54 (9 years ago)
Author:
ddp
Message:

switch to http-client

Location:
release/4/yelp/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/yelp/trunk/yelp.meta

    r23255 r27411  
    11((egg "yelp.egg")
    2  (synopsis "An interface to the Yelp developer API")
     2 (synopsis "An interface to the (deprecated) Yelp v1.0 API")
    33 (category web)
    44 (author "[[derrell piper]]")
    55 (license "BSD")
    6  (doc-from-wiki)
    7  (needs json)
     6 (needs json http-client)
    87 (test-depends test)
    98 (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

    r20268 r27411  
    1 ;; Copyright (c) 2009 Derrell Piper.
    2 ;;
    3 ;; This program is free software: you can redistribute it and/or modify it
    4 ;; under the terms of the GNU General Public License as published by the Free
    5 ;; Software Foundation, either version 3 of the License, or (at your option)
    6 ;; any later version.
    7 ;;
    8 ;; This program is distributed in the hope that it will be useful, but WITHOUT
    9 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
    10 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
    11 ;; more details.
    12 ;;
    13 ;; A full copy of the GPL license can be found at
    14 ;; <http://www.gnu.org/licenses/>.
     1;; Copyright (c) 2009, Derrell Piper
     2;; All rights reserved.
     3
     4;; Redistribution and use in source and binary forms, with or without
     5;; modification, are permitted provided that the following conditions are met:
     6
     7;; 1. Redistributions of source code must retain the above copyright notice, this
     8;;    list of conditions and the following disclaimer.
     9;; 2. Redistributions in binary form must reproduce the above copyright notice,
     10;;    this list of conditions and the following disclaimer in the documentation
     11;;    and/or other materials provided with the distribution.
     12
     13;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
     14;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
     15;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
     16;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
     17;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
     18;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
     19;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
     20;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
     21;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
     22;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     23
     24;; The views and conclusions contained in the software and documentation are those
     25;; of the authors and should not be interpreted as representing official policies,
     26;; either expressed or implied, of the FreeBSD Project.
    1527
    1628(module yelp
     
    2739   find)
    2840
    29 (import scheme chicken data-structures ports extras tcp json)
    30 (require-library tcp json)
    31 
    32 ;;;; HTML request/response
     41(import scheme chicken data-structures ports extras tcp json http-client)
     42(require-library tcp json http-client)
     43
     44;;;; HTTP request/response
    3345
    3446(define (yelp-do request)
    35 
    36   (define yelp-server "api.yelp.com")
    37   (define yelp-port 80)
    38 
    39   (define crlf (string #\return #\linefeed))
    40   (define content-length "Content-Length: ")
    41 
    42   ;; HTTP/1.1 200 OK
    43   (define (html-response-ok? response #!optional (port #t))
    44     (let* ((r (substring response 9 12))
    45            (code (string-ref r 0)))
    46       (cond ((char=? code #\3)
    47              (format port "Redirect: ~a~%" r))
    48             ((char=? code #\4)
    49              (format port "Client error: ~a~%" r))
    50             ((char=? code #\5)
    51              (format port "Server error: ~a~%" r)))
    52       (string=? r "200")))
    53 
    54   (call/cc
    55    (lambda (return)
    56      (let-values (((in out) (tcp-connect yelp-server yelp-port)))
    57        (condition-case
    58         (begin
    59           (format out "GET /~a&ywsid=~a HTTP/1.0~a" request ywsid crlf)
    60           (format out "User-Agent: Chicken/~a (~a)~a" (chicken-version) (software-version) crlf)
    61           (format out "Accept: */*~a" crlf)
    62           (format out "Host: api.yelp.com~a" crlf)
    63           (format out "Connection: Keep-Alive~a" crlf)
    64           (format out "~a" crlf)
    65           (flush-output out)
    66           (let ((response (read-line in))
    67                 (json #f)
    68                 (json-length 0))
    69             (if (html-response-ok? response)
    70                 (let loop ()
    71                   (let ((header (read-line in)))
    72                     (if (= 0 (string-length header))
    73                         (begin
    74                           (let json-loop ((next 0))
    75                             (when (< next json-length)
    76                               (string-set! json next (read-char in))
    77                               (json-loop (+ 1 next))))
    78                           (close-input-port in)
    79                           (close-output-port out)
    80                           (return json)))
    81                     (if (and (> (string-length header) (string-length content-length))
    82                              (string=? content-length (substring header 0 (string-length content-length))))
    83                         (begin
    84                           (set! json-length (string->number (substring header (string-length content-length) (string-length header))))
    85                           (set! json (make-string json-length))))
    86                     (loop)))
    87                 (return #f))))
    88         (e ()
    89            (format #t "yelp-do: exception: ~a~%" e)
    90            (close-input-port in)
    91            (close-output-port out)
    92            (return #f)))))))
     47  (let-values (((result request-uri response)
     48                (with-input-from-request
     49                 (with-output-to-string
     50                   (lambda ()
     51                     (format #t "http://api.yelp.com/~a&ywsid=~a" request ywsid))) #f read-string)))
     52    result))
    9353
    9454;; Make a Yelp request and check the Yelp response.
     
    308268
    309269  (if (valid? object)
    310       (begin
    311         (and-let* ((categories (find object "businesses.categories"))
    312                    (len (length categories)))
    313           (format port "Categories: ")
    314           (let loop ((i 0))
    315             (if (< i len)
    316                 (let ((c (list-ref categories i)))
    317                   (format port "~a~a" (find c "name") (if (< i (- len 1)) ", " ""))
    318                   (loop (+ 1 i)))))
    319           (newline))
    320         (display-if port (json-find object "businesses.neighborhoods.name") "Neighborhood: ~a~%")
    321         (display-if port (json-find object "businesses.name"))
    322         (display-if port (json-find object "businesses.address1"))
    323         (display-if port (json-find object "businesses.address2"))
    324         (display-if port (json-find object "businesses.address3"))
    325         (format port "~a, ~a ~a~%"
    326                 (json-find object "businesses.city")
    327                 (json-find object "businesses.state")
    328                 (json-find object "businesses.zip"))
    329         (display-if port (pretty-phone (json-find object "businesses.phone")))
    330 
    331         (and-let* ((latitude (json-find object "businesses.latitude"))
    332                    (lat (number->string latitude))
    333                    (longitude (json-find object "businesses.longitude"))
    334                    (lon (number->string longitude))
    335                    (a (substring-index "." lat))
    336                    (a-end (min (+ a 7) (string-length lat)))
    337                    (l (substring-index "." lon))
    338                    (l-end (min (+ l 7) (string-length lon))))
    339           (format port "~a ~a~%" (substring lat 0 a-end) (substring lon 0 l-end))))
    340       'yelp-invalid-response))
     270      (if (not (find object "businesses.categories"))
     271          (format port "Business not found~%")
     272          (begin
     273            (and-let* ((categories (find object "businesses.categories"))
     274                       (len (length categories)))
     275              (format port "Categories: ")
     276              (let loop ((i 0))
     277                (if (< i len)
     278                    (let ((c (list-ref categories i)))
     279                      (format port "~a~a" (find c "name") (if (< i (- len 1)) ", " ""))
     280                      (loop (+ 1 i)))))
     281              (newline))
     282            (display-if port (json-find object "businesses.neighborhoods.name") "Neighborhood: ~a~%")
     283            (display-if port (json-find object "businesses.name"))
     284            (display-if port (json-find object "businesses.address1"))
     285            (display-if port (json-find object "businesses.address2"))
     286            (display-if port (json-find object "businesses.address3"))
     287            (format port "~a, ~a ~a~%"
     288                    (json-find object "businesses.city")
     289                    (json-find object "businesses.state")
     290                    (json-find object "businesses.zip"))
     291            (display-if port (pretty-phone (json-find object "businesses.phone")))
     292
     293            (and-let* ((latitude (json-find object "businesses.latitude"))
     294                       (lat (number->string latitude))
     295                       (longitude (json-find object "businesses.longitude"))
     296                       (lon (number->string longitude))
     297                       (a (substring-index "." lat))
     298                       (a-end (min (+ a 7) (string-length lat)))
     299                       (l (substring-index "." lon))
     300                       (l-end (min (+ l 7) (string-length lon))))
     301              (format port "~a ~a~%" (substring lat 0 a-end) (substring lon 0 l-end)))))
     302      'yelp-request-invalid))
    341303
    342304;; Decode JSON response.  The JSON egg returns structures as vectors and arrays as lists.
  • release/4/yelp/trunk/yelp.setup

    r23585 r27411  
    55 'yelp
    66 '("yelp.so" "yelp.o" "yelp.import.so")
    7  '((version 1.0.2)
     7 '((version 1.0.3)
    88   (static "yelp.o")))
Note: See TracChangeset for help on using the changeset viewer.