*
* Copyright (C) 2003 Merjis Ltd.
*
- * $Id: pl_LWP_UserAgent.ml,v 1.4 2004-11-22 17:08:36 rich Exp $
+ * $Id: pl_LWP_UserAgent.ml,v 1.5 2004-11-25 21:24:51 rich Exp $
*)
open Perl
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 =
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
--- /dev/null
+(** Wrapper around Perl [WWW::Mechanize] class.
+ *
+ * Copyright (C) 2004 Merjis Ltd.
+ *
+ * $Id: pl_WWW_Mechanize.ml,v 1.1 2004-11-25 21:24:51 rich Exp $
+ *)
+
+open Perl
+
+open Pl_LWP_UserAgent
+
+let _ = eval "use WWW::Mechanize"
+
+class www_mechanize sv =
+
+object (self)
+ inherit lwp_useragent sv
+
+ method agent_alias alias =
+ call_method_void sv "agent_alias" [sv_of_string alias]
+ method known_agent_aliases =
+ let svlist = call_method_array sv "known_agent_aliases" [] in
+ List.map string_of_sv svlist
+
+ method get url =
+ call_method_void sv "get" [sv_of_string url]
+ method reload () =
+ call_method_void sv "reload" []
+ method back () =
+ call_method_void sv "back" []
+
+ method follow_link ?text ?text_regex ?url ?url_regex ?url_abs ?url_abs_regex
+ ?name ?name_regex ?tag ?tag_regex ?n () =
+ let args = ref [] in
+ let add name f = function
+ | None -> ()
+ | Some p -> args := sv_of_string name :: f p :: !args
+ in
+ add "text" sv_of_string text;
+ add "text_regex" sv_of_string text_regex;
+ add "url" sv_of_string url;
+ add "url_regex" sv_of_string url_regex;
+ add "url_abs" sv_of_string url_abs;
+ add "url_abs_regex" sv_of_string url_abs_regex;
+ add "name" sv_of_string name;
+ add "name_regex" sv_of_string name_regex;
+ add "tag" sv_of_string tag;
+ add "tag_regex" sv_of_string tag_regex;
+ add "n" sv_of_int n;
+ call_method_void sv "follow_link" !args
+
+ (* XXX What do these next two functions return? *)
+ method form_number n =
+ call_method_void sv "form_number" [sv_of_int n]
+ method form_name name =
+ call_method_void sv "form_name" [sv_of_string name]
+
+ (* XXX There is an arrayref variant of this method, but what
+ * it does is apparently undocumented.
+ *)
+ method field name value n =
+ call_method_void sv "field" [sv_of_string name; sv_of_string value;
+ sv_of_int n]
+ method set_fields fields =
+ let args = ref [] in
+ List.iter (fun (k, v) ->
+ (* Note: reversed k, v because we'll reverse the whole list.*)
+ args := sv_of_string v :: sv_of_string k :: !args) fields;
+ let args = List.rev !args in
+ call_method_void sv "set_fields" args
+
+ method value name n =
+ let sv = call_method sv "value" [sv_of_string name; sv_of_int n] in
+ string_of_sv sv
+
+ (* XXX Doesn't support setting criteria. *)
+ method set_visible names =
+ let names = List.map sv_of_string names in
+ call_method_void sv "set_visible" names
+
+ method tick ?set name value =
+ let args = match set with
+ None -> [ sv_of_string name; sv_of_string value ]
+ | Some b -> [ sv_of_string name; sv_of_string value; sv_of_bool b ] in
+ call_method_void sv "tick" args
+
+ method untick name value =
+ call_method_void sv "untick" [ sv_of_string name; sv_of_string value ]
+
+ method click ?xy button =
+ let args = match xy with
+ None -> [ sv_of_string button ]
+ | Some (x, y) -> [ sv_of_string button; sv_of_int x; sv_of_int y ] in
+ call_method_void sv "click" args
+ method click1 () =
+ call_method_void sv "click" []
+ method click_button ?name ?number ?value ?xy () =
+ let args = ref [] in
+ let add name f = function
+ | None -> ()
+ | Some p -> args := sv_of_string name :: f p :: !args
+ in
+ add "name" sv_of_string name;
+ add "number" sv_of_int number;
+ add "value" sv_of_string value;
+ (match xy with
+ None -> ()
+ | Some (x, y) ->
+ args := sv_of_string "x" :: sv_of_int x ::
+ sv_of_string "y" :: sv_of_int y :: !args);
+ call_method_void sv "click" !args
+
+ method select name value =
+ call_method_void sv "select" [ sv_of_string name; sv_of_string value ]
+ method select_multiple name values =
+ let av = av_empty () in
+ List.iter (av_push av) (List.map sv_of_string values);
+ call_method_void sv "select" [ sv_of_string name; arrayref av ]
+
+ method submit () =
+ call_method_void sv "submit" []
+
+ (*method submit_form ?form_number ?form_name ?fields ?button ?xy () *)
+
+ method success =
+ let sv = call_method sv "success" [] in
+ bool_of_sv sv
+ method uri =
+ let sv = call_method sv "uri" [] in
+ string_of_sv sv
+ method response =
+ let sv = call_method sv "response" [] in
+ new Pl_HTTP_Response.http_response sv
+ method res =
+ let sv = call_method sv "res" [] in
+ new Pl_HTTP_Response.http_response sv
+ method status =
+ let sv = call_method sv "status" [] in
+ int_of_sv sv
+ method ct =
+ let sv = call_method sv "ct" [] in
+ string_of_sv sv
+ method base =
+ let sv = call_method sv "base" [] in
+ string_of_sv sv
+ method content =
+ let sv = call_method sv "content" [] in
+ string_of_sv sv
+ (* method forms = *)
+ (* method current_forms = *)
+ (* method links = *)
+ method is_html =
+ let sv = call_method sv "is_html" [] in
+ bool_of_sv sv
+ method title =
+ let sv = call_method sv "title" [] in
+ string_of_sv sv
+
+ (* method find_link .... = *)
+ (* method find_all_links .... = *)
+
+ (* method add_header .... = *)
+ (* method delete_header .... = *)
+
+ method quiet =
+ let sv = call_method sv "quiet" [] in
+ bool_of_sv sv
+ method set_quiet b =
+ call_method_void sv "quiet" [sv_of_bool b]
+ (* method stack_depth ... = *)
+ method redirect_ok =
+ let sv = call_method sv "redirect_ok" [] in
+ bool_of_sv sv
+
+ (* method request ... = *)
+ (* method update_html ... = *)
+
+end
+
+(* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
+(* XXX WWW::Mechanize has additional parameters. *)
+let new_ () =
+ let sv = call_class_method "WWW::Mechanize" "new" [] in
+ new www_mechanize sv
git.annexia.org / perl4caml.git / commitdiff