X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=wrappers%2Fpl_LWP_UserAgent.ml;h=a29383943ea3eb6a74f3e41d1b283925760bcd5b;hb=1e204b159732a1162086091c0cf1ffb675c68217;hp=c6a5b982aca2b43454e8cb6ec99ed3aa601cec80;hpb=885e4318d7a5540f55c3c78c03222f6d9fb6a70f;p=perl4caml.git diff --git a/wrappers/pl_LWP_UserAgent.ml b/wrappers/pl_LWP_UserAgent.ml index c6a5b98..a293839 100644 --- a/wrappers/pl_LWP_UserAgent.ml +++ b/wrappers/pl_LWP_UserAgent.ml @@ -2,13 +2,14 @@ * * Copyright (C) 2003 Merjis Ltd. * - * $Id: pl_LWP_UserAgent.ml,v 1.3 2003-10-16 13:41:07 rich Exp $ + * $Id: pl_LWP_UserAgent.ml,v 1.5 2004-11-25 21:24:51 rich Exp $ *) open Perl open Pl_HTTP_Request open Pl_HTTP_Response +open Pl_HTTP_Cookies let _ = eval "use LWP::UserAgent" @@ -30,6 +31,27 @@ object (self) string_of_sv (call_method sv "from" []) method set_from v = call_method_void sv "from" [sv_of_string v] + method cookie_jar = + let sv = call_method sv "cookie_jar" [] in + new http_cookies sv + method set_cookie_jar (v : http_cookies) = + call_method_void sv "cookie_jar" [v#sv] + method set_cookie_jar_file filename = + let hv = hv_empty () in + hv_set hv "file" (sv_of_string filename); + call_method_void sv "cookie_jar" [hashref hv] + method requests_redirectable = + let sv = call_method sv "requests_redirectable" [] in + let av = deref_array sv in + List.map string_of_sv (list_of_av av) + method set_requests_redirectable methods = + let av = av_empty () in + List.iter (av_push av) (List.map sv_of_string methods); + call_method_void sv "requests_redirectable" [arrayref av] + method add_requests_redirectable method_ = + let sv = call_method sv "requests_redirectable" [] in + let av = deref_array sv in + av_push av (sv_of_string method_) method timeout = int_of_sv (call_method sv "timeout" []) method set_timeout v = @@ -42,14 +64,14 @@ object (self) int_of_sv (call_method sv "max_size" []) method set_max_size v = call_method_void sv "max_size" [sv_of_int v] - method env_proxy = + method env_proxy () = call_method_void sv "env_proxy" [] end (* Note that "new" is a reserved word, so I've appended an _ character. *) let new_ ?agent ?from ?timeout ?use_eval ?parse_head ?max_size - ?env_proxy ?keep_alive () = + ?env_proxy ?keep_alive ?cookie_jar ?cookie_jar_file () = let args = ref [] in let may f = function None -> () | Some v -> f v in may (fun v -> @@ -68,5 +90,12 @@ let new_ ?agent ?from ?timeout ?use_eval ?parse_head ?max_size args := sv_of_string "env_proxy" :: sv_of_bool v :: !args) env_proxy; may (fun v -> args := sv_of_string "keep_alive" :: sv_of_int v :: !args) keep_alive; + may (fun (v : http_cookies) -> + args := sv_of_string "cookie_jar" :: v#sv :: !args) cookie_jar; + may (fun v -> + let hv = hv_empty () in + hv_set hv "file" (sv_of_string v); + let sv = hashref hv in + args := sv_of_string "cookie_jar" :: sv :: !args) cookie_jar_file; let sv = call_class_method "LWP::UserAgent" "new" !args in new lwp_useragent sv