basis/http/client/post-data/post-data.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs destructors http io io.encodings.ascii
   4 io.encodings.binary io.encodings.string io.encodings.utf8
   5 io.files io.files.info io.pathnames kernel math.parser sequences
   6 strings urls.encoding ;
   7 IN: http.client.post-data
   8
   9 TUPLE: measured-stream stream size ;
  10
  11 C: <measured-stream> measured-stream
  12
  13 <PRIVATE
  14
  15 GENERIC: (set-post-data-headers) ( header data -- header )
  16
  17 M: sequence (set-post-data-headers)
  18     length "content-length" pick set-at ;
  19
  20 M: measured-stream (set-post-data-headers)
  21     size>> "content-length" pick set-at ;
  22
  23 M: object (set-post-data-headers)
  24     drop "chunked" "transfer-encoding" pick set-at ;
  25
  26 PRIVATE>
  27
  28 : set-post-data-headers ( header post-data -- header )
  29     [ data>> (set-post-data-headers) ]
  30     [ content-type>> "content-type" pick set-at ] bi ;
  31
  32 <PRIVATE
  33
  34 GENERIC: (write-post-data) ( data -- )
  35
  36 M: sequence (write-post-data) write ;
  37
  38 M: measured-stream (write-post-data)
  39     stream>> [ [ write ] each-block ] with-input-stream ;
  40
  41 : write-chunk ( chunk -- )
  42     [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ;
  43
  44 M: object (write-post-data)
  45     [ [ write-chunk ] each-block ] with-input-stream
  46     "0;\r\n" ascii encode write ;
  47
  48 GENERIC: >post-data ( object -- post-data )
  49
  50 M: f >post-data ;
  51
  52 M: post-data >post-data ;
  53
  54 M: string >post-data
  55     utf8 encode
  56     "application/octet-stream" <post-data>
  57         swap >>data ;
  58
  59 M: assoc >post-data
  60     "application/x-www-form-urlencoded" <post-data>
  61         swap >>params ;
  62
  63 M: object >post-data
  64     "application/octet-stream" <post-data>
  65         swap >>data ;
  66
  67 : pathname>measured-stream ( pathname -- stream )
  68     string>>
  69     [ binary <file-reader> &dispose ]
  70     [ file-info size>> ] bi
  71     <measured-stream> ;
  72
  73 : normalize-post-data ( request -- request )
  74     dup post-data>> [
  75         dup params>> [
  76             assoc>query ascii encode >>data
  77         ] when*
  78         dup data>> pathname? [
  79             [ pathname>measured-stream ] change-data
  80         ] when
  81         drop
  82     ] when* ;
  83
  84 PRIVATE>
  85
  86 : unparse-post-data ( request -- request )
  87     [ >post-data ] change-post-data
  88     normalize-post-data ;
  89
  90 : write-post-data ( request -- request )
  91     dup post-data>> [ data>> (write-post-data) ] when* ;