yppdb-util.ss
(module yppdb-util mzscheme
  (require (lib "contract.ss")
           (lib "servlet.ss" "web-server")
           (lib "servlet-sig.ss" "web-server")
           (lib "url.ss" "net")
           (lib "etc.ss")
           (lib "list.ss")
           (planet "with-bindings.ss" ("jaymccarthy" "with-bindings.plt" 1)))
  (provide (all-defined)
           (all-from (planet "with-bindings.ss" ("jaymccarthy" "with-bindings.plt" 1))))
  
  (define/contract cdr?
    (list? . -> . list?)
    (lambda (l)
      (if (null? l)
          (list)
          (cdr l))))
  
  (define/contract list/uniqued
    ((listof any/c) . -> . (listof any/c))
    (lambda (l)
      (foldl
       (lambda (c b)
         (if (member c b)
             b
             (append b (list c))))
       `()
       l)))
  
  (define/contract write/string
    (any/c . -> . string?)
    (lambda (a)
      (let ([p (open-output-string)])
        (write a p)
        (get-output-string p))))
  (define/contract read/string
    (string? . -> . any/c)
    (lambda (s)
      (read (open-input-string s))))
  
  (define (base-url request)
    (let* ([url (url->string (request-uri request))]
           [regex (regexp-match "^(.*?\\.ss)(.*?)(\\?.*)?$"
                                (regexp-replace ";id[0-9]+\\*[0-9]+" url ""))])
      (if regex
          (cdr regex)
          url))))