wrappers/pl_LWP_UserAgent.ml

   1 (** Wrapper around Perl [LWP::UserAgent] class. *)
   2 (*  Copyright (C) 2003 Merjis Ltd.
   3
   4     This library is free software; you can redistribute it and/or
   5     modify it under the terms of the GNU Library General Public
   6     License as published by the Free Software Foundation; either
   7     version 2 of the License, or (at your option) any later version.
   8
   9     This library is distributed in the hope that it will be useful,
  10     but WITHOUT ANY WARRANTY; without even the implied warranty of
  11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12     Library General Public License for more details.
  13
  14     You should have received a copy of the GNU General Public License
  15     along with this library; see the file COPYING.  If not, write to
  16     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  17     Boston, MA 02111-1307, USA.
  18
  19     $Id: pl_LWP_UserAgent.ml,v 1.6 2008-03-01 13:02:21 rich Exp $
  20   *)
  21
  22 open Perl
  23
  24 open Pl_HTTP_Request
  25 open Pl_HTTP_Response
  26 open Pl_HTTP_Cookies
  27
  28 let _ = eval "use LWP::UserAgent"
  29
  30 class lwp_useragent sv =
  31
  32 object (self)
  33
  34   method simple_request (request : http_request) =
  35     let sv = call_method sv "simple_request" [request#sv] in
  36     new http_response sv
  37   method request (request : http_request) =
  38     let sv = call_method sv "request" [request#sv] in
  39     new http_response sv
  40   method agent =
  41     string_of_sv (call_method sv "agent" [])
  42   method set_agent v =
  43     call_method_void sv "agent" [sv_of_string v]
  44   method from =
  45     string_of_sv (call_method sv "from" [])
  46   method set_from v =
  47     call_method_void sv "from" [sv_of_string v]
  48   method cookie_jar =
  49     let sv = call_method sv "cookie_jar" [] in
  50     new http_cookies sv
  51   method set_cookie_jar (v : http_cookies) =
  52     call_method_void sv "cookie_jar" [v#sv]
  53   method set_cookie_jar_file filename =
  54     let hv = hv_empty () in
  55     hv_set hv "file" (sv_of_string filename);
  56     call_method_void sv "cookie_jar" [hashref hv]
  57   method requests_redirectable =
  58     let sv = call_method sv "requests_redirectable" [] in
  59     let av = deref_array sv in
  60     List.map string_of_sv (list_of_av av)
  61   method set_requests_redirectable methods =
  62     let av = av_empty () in
  63     List.iter (av_push av) (List.map sv_of_string methods);
  64     call_method_void sv "requests_redirectable" [arrayref av]
  65   method add_requests_redirectable method_ =
  66     let sv = call_method sv "requests_redirectable" [] in
  67     let av = deref_array sv in
  68     av_push av (sv_of_string method_)
  69   method timeout =
  70     int_of_sv (call_method sv "timeout" [])
  71   method set_timeout v =
  72     call_method_void sv "timeout" [sv_of_int v]
  73   method parse_head =
  74     bool_of_sv (call_method sv "parse_head" [])
  75   method set_parse_head v =
  76     call_method_void sv "parse_head" [sv_of_bool v]
  77   method max_size =
  78     int_of_sv (call_method sv "max_size" [])
  79   method set_max_size v =
  80     call_method_void sv "max_size" [sv_of_int v]
  81   method env_proxy () =
  82     call_method_void sv "env_proxy" []
  83
  84 end
  85
  86 (* Note that "new" is a reserved word, so I've appended an _ character. *)
  87 let new_ ?agent ?from ?timeout ?use_eval ?parse_head ?max_size
  88     ?env_proxy ?keep_alive ?cookie_jar ?cookie_jar_file () =
  89   let args = ref [] in
  90   let may f = function None -> () | Some v -> f v in
  91   may (fun v ->
  92          args := sv_of_string "agent" :: sv_of_string v :: !args) agent;
  93   may (fun v ->
  94          args := sv_of_string "from" :: sv_of_string v :: !args) from;
  95   may (fun v ->
  96          args := sv_of_string "timeout" :: sv_of_int v :: !args) timeout;
  97   may (fun v ->
  98          args := sv_of_string "use_eval" :: sv_of_bool v :: !args) use_eval;
  99   may (fun v ->
 100          args := sv_of_string "parse_head" :: sv_of_bool v :: !args)parse_head;
 101   may (fun v ->
 102          args := sv_of_string "max_size" :: sv_of_int v :: !args) max_size;
 103   may (fun v ->
 104          args := sv_of_string "env_proxy" :: sv_of_bool v :: !args) env_proxy;
 105   may (fun v ->
 106          args := sv_of_string "keep_alive" :: sv_of_int v :: !args) keep_alive;
 107   may (fun (v : http_cookies) ->
 108          args := sv_of_string "cookie_jar" :: v#sv :: !args) cookie_jar;
 109   may (fun v ->
 110          let hv = hv_empty () in
 111          hv_set hv "file" (sv_of_string v);
 112          let sv = hashref hv in
 113          args := sv_of_string "cookie_jar" :: sv :: !args) cookie_jar_file;
 114   let sv = call_class_method "LWP::UserAgent" "new" !args in
 115   new lwp_useragent sv