1 (** Wrapper around Perl [WWW::Mechanize] class. *)
2 (* Copyright (C) 2003 Merjis Ltd.
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.
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.
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.
19 $Id: pl_WWW_Mechanize.ml,v 1.8 2008-03-01 13:02:21 rich Exp $
26 let _ = eval "use WWW::Mechanize"
28 class www_mechanize sv =
31 inherit lwp_useragent sv
33 method agent_alias alias =
34 call_method_void sv "agent_alias" [sv_of_string alias]
35 method known_agent_aliases =
36 let svlist = call_method_array sv "known_agent_aliases" [] in
37 List.map string_of_sv svlist
40 call_method_void sv "get" [sv_of_string url]
42 call_method_void sv "reload" []
44 call_method_void sv "back" []
46 method follow_link ?text ?text_regex ?url ?url_regex ?url_abs ?url_abs_regex
47 ?name ?name_regex ?tag ?tag_regex ?n () =
49 let add name f = function
51 | Some p -> args := sv_of_string name :: f p :: !args
53 add "text" sv_of_string text;
54 add "text_regex" sv_of_string text_regex;
55 add "url" sv_of_string url;
56 add "url_regex" sv_of_string url_regex;
57 add "url_abs" sv_of_string url_abs;
58 add "url_abs_regex" sv_of_string url_abs_regex;
59 add "name" sv_of_string name;
60 add "name_regex" sv_of_string name_regex;
61 add "tag" sv_of_string tag;
62 add "tag_regex" sv_of_string tag_regex;
64 call_method_void sv "follow_link" !args
67 let svlist = call_method_array sv "forms" [] in
68 List.map (new Pl_HTML_Form.html_form) svlist
69 method form_number n =
70 let sv = call_method sv "form_number" [sv_of_int n] in
71 new Pl_HTML_Form.html_form sv
72 method form_name name =
73 let sv = call_method sv "form_name" [sv_of_string name] in
74 new Pl_HTML_Form.html_form sv
76 (* XXX There is an arrayref variant of this method, but what
77 * it does is apparently undocumented.
79 method field ?n name value =
80 let args = match n with
81 None -> [sv_of_string name; sv_of_string value]
82 | Some n -> [sv_of_string name; sv_of_string value; sv_of_int n] in
83 call_method_void sv "field" args
84 method set_fields fields =
86 List.iter (fun (k, v) ->
87 (* Note: reversed k, v because we'll reverse the whole list.*)
88 args := sv_of_string v :: sv_of_string k :: !args) fields;
89 let args = List.rev !args in
90 call_method_void sv "set_fields" args
92 method value ?n name =
93 let args = match n with
94 None -> [sv_of_string name]
95 | Some n -> [sv_of_string name; sv_of_int n] in
96 let sv = call_method sv "value" args in
99 (* XXX Doesn't support setting criteria. *)
100 method set_visible names =
101 let names = List.map sv_of_string names in
102 call_method_void sv "set_visible" names
104 method tick ?set name value =
105 let args = match set with
106 None -> [ sv_of_string name; sv_of_string value ]
107 | Some b -> [ sv_of_string name; sv_of_string value; sv_of_bool b ] in
108 call_method_void sv "tick" args
110 method untick name value =
111 call_method_void sv "untick" [ sv_of_string name; sv_of_string value ]
113 method click ?xy button =
114 let args = match xy with
115 None -> [ sv_of_string button ]
116 | Some (x, y) -> [ sv_of_string button; sv_of_int x; sv_of_int y ] in
117 call_method_void sv "click" args
119 call_method_void sv "click" []
120 method click_button ?name ?number ?value ?xy () =
122 let add name f = function
124 | Some p -> args := sv_of_string name :: f p :: !args
126 add "name" sv_of_string name;
127 add "number" sv_of_int number;
128 add "value" sv_of_string value;
132 args := sv_of_string "x" :: sv_of_int x ::
133 sv_of_string "y" :: sv_of_int y :: !args);
134 call_method_void sv "click" !args
136 method select name value =
137 call_method_void sv "select" [ sv_of_string name; sv_of_string value ]
138 method select_multiple name values =
139 let av = av_empty () in
140 List.iter (av_push av) (List.map sv_of_string values);
141 call_method_void sv "select" [ sv_of_string name; arrayref av ]
144 call_method_void sv "submit" []
146 method submit_form ?form_number ?form_name ?fields ?button ?xy () =
148 let add name f = function
150 | Some p -> args := sv_of_string name :: f p :: !args
152 add "form_number" sv_of_int form_number;
153 add "form_name" sv_of_string form_name;
157 let hv = hv_empty () in
160 hv_set hv name (sv_of_string value)
162 let sv = hashref hv in
163 args := sv_of_string "fields" :: sv :: !args
165 add "button" sv_of_string button;
169 args := sv_of_string "x" :: sv_of_int x ::
170 sv_of_string "y" :: sv_of_int y :: !args);
171 let sv = call_method sv "submit_form" !args in
172 new Pl_HTTP_Response.http_response sv
175 let sv = call_method sv "success" [] in
178 let sv = call_method sv "uri" [] in
181 let sv = call_method sv "response" [] in
182 new Pl_HTTP_Response.http_response sv
184 let sv = call_method sv "res" [] in
185 new Pl_HTTP_Response.http_response sv
187 let sv = call_method sv "status" [] in
190 let sv = call_method sv "ct" [] in
193 let sv = call_method sv "base" [] in
196 let sv = call_method sv "content" [] in
198 (* method current_forms = *)
200 let svs = call_method_array sv "links" [] in
201 List.map (new www_mechanize_link) svs
203 let sv = call_method sv "is_html" [] in
206 let sv = call_method sv "title" [] in
209 (* method find_link .... = *)
210 (* method find_all_links .... = *)
212 (* method add_header .... = *)
213 (* method delete_header .... = *)
216 let sv = call_method sv "quiet" [] in
219 call_method_void sv "quiet" [sv_of_bool b]
220 (* method stack_depth ... = *)
222 let sv = call_method sv "redirect_ok" [] in
225 (* method request ... = *)
226 (* method update_html ... = *)
230 and www_mechanize_link sv =
237 let sv = call_method sv "url" [] in
241 let sv = call_method sv "text" [] in
245 let sv = call_method sv "name" [] in
249 let sv = call_method sv "tag" [] in
253 let sv = call_method sv "base" [] in
257 let sv = call_method sv "url_abs" [] in
262 (* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
263 (* XXX WWW::Mechanize has additional parameters. *)
264 let new_ ?autocheck () =
266 let may f = function None -> () | Some v -> f v in
268 args := sv_of_string "autocheck" :: sv_of_bool v :: !args) autocheck;
269 let sv = call_class_method "WWW::Mechanize" "new" !args in