Changeset 27411 in project
- Timestamp:
- 09/11/12 21:01:54 (9 years ago)
- Location:
- release/4/yelp/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/yelp/trunk/yelp.meta
r23255 r27411 1 1 ((egg "yelp.egg") 2 (synopsis "An interface to the Yelp developerAPI")2 (synopsis "An interface to the (deprecated) Yelp v1.0 API") 3 3 (category web) 4 4 (author "[[derrell piper]]") 5 5 (license "BSD") 6 (doc-from-wiki) 7 (needs json) 6 (needs json http-client) 8 7 (test-depends test) 9 8 (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. 15 27 16 28 (module yelp … … 27 39 find) 28 40 29 (import scheme chicken data-structures ports extras tcp json )30 (require-library tcp json )31 32 ;;;; HT MLrequest/response41 (import scheme chicken data-structures ports extras tcp json http-client) 42 (require-library tcp json http-client) 43 44 ;;;; HTTP request/response 33 45 34 46 (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)) 93 53 94 54 ;; Make a Yelp request and check the Yelp response. … … 308 268 309 269 (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)) 341 303 342 304 ;; Decode JSON response. The JSON egg returns structures as vectors and arrays as lists. -
release/4/yelp/trunk/yelp.setup
r23585 r27411 5 5 'yelp 6 6 '("yelp.so" "yelp.o" "yelp.import.so") 7 '((version 1.0. 2)7 '((version 1.0.3) 8 8 (static "yelp.o")))
Note: See TracChangeset
for help on using the changeset viewer.