a666ecd2b7d8539dc78e6ab998016be9d0fddbcf
[perl4caml.git] / pl_WWW_Mechanize.ml
1 (** Wrapper around Perl [WWW::Mechanize] class.
2   *
3   * Copyright (C) 2004 Merjis Ltd.
4   *
5   * $Id: pl_WWW_Mechanize.ml,v 1.4 2005-02-13 16:33:28 rich Exp $
6   *)
7
8 open Perl
9
10 open Pl_LWP_UserAgent
11
12 let _ = eval "use WWW::Mechanize"
13
14 class www_mechanize sv =
15
16 object (self)
17   inherit lwp_useragent sv
18
19   method agent_alias alias =
20     call_method_void sv "agent_alias" [sv_of_string alias]
21   method known_agent_aliases =
22     let svlist = call_method_array sv "known_agent_aliases" [] in
23     List.map string_of_sv svlist
24
25   method get url =
26     call_method_void sv "get" [sv_of_string url]
27   method reload () =
28     call_method_void sv "reload" []
29   method back () =
30     call_method_void sv "back" []
31
32   method follow_link ?text ?text_regex ?url ?url_regex ?url_abs ?url_abs_regex
33     ?name ?name_regex ?tag ?tag_regex ?n () =
34     let args = ref [] in
35     let add name f = function
36       | None -> ()
37       | Some p -> args := sv_of_string name :: f p :: !args
38     in
39     add "text" sv_of_string text;
40     add "text_regex" sv_of_string text_regex;
41     add "url" sv_of_string url;
42     add "url_regex" sv_of_string url_regex;
43     add "url_abs" sv_of_string url_abs;
44     add "url_abs_regex" sv_of_string url_abs_regex;
45     add "name" sv_of_string name;
46     add "name_regex" sv_of_string name_regex;
47     add "tag" sv_of_string tag;
48     add "tag_regex" sv_of_string tag_regex;
49     add "n" sv_of_int n;
50     call_method_void sv "follow_link" !args
51
52   method forms =
53     let svlist = call_method_array sv "forms" [] in
54     List.map (new Pl_HTML_Form.html_form) svlist
55   method form_number n =
56     let sv = call_method sv "form_number" [sv_of_int n] in
57     new Pl_HTML_Form.html_form sv
58   method form_name name =
59     let sv = call_method sv "form_name" [sv_of_string name] in
60     new Pl_HTML_Form.html_form sv
61
62   (* XXX There is an arrayref variant of this method, but what
63    * it does is apparently undocumented.
64    *)
65   method field ?n name value =
66     let args = match n with
67         None -> [sv_of_string name; sv_of_string value]
68       | Some n -> [sv_of_string name; sv_of_string value; sv_of_int n] in
69     call_method_void sv "field" args
70   method set_fields fields =
71     let args = ref [] in
72     List.iter (fun (k, v) ->
73                  (* Note: reversed k, v because we'll reverse the whole list.*)
74                  args := sv_of_string v :: sv_of_string k :: !args) fields;
75     let args = List.rev !args in
76     call_method_void sv "set_fields" args
77
78   method value ?n name =
79     let args = match n with
80         None -> [sv_of_string name]
81       | Some n -> [sv_of_string name; sv_of_int n] in
82     let sv = call_method sv "value" args in
83     string_of_sv sv
84
85   (* XXX Doesn't support setting criteria. *)
86   method set_visible names =
87     let names = List.map sv_of_string names in
88     call_method_void sv "set_visible" names
89
90   method tick ?set name value =
91     let args = match set with
92         None -> [ sv_of_string name; sv_of_string value ]
93       | Some b -> [ sv_of_string name; sv_of_string value; sv_of_bool b ] in
94     call_method_void sv "tick" args
95
96   method untick name value =
97     call_method_void sv "untick" [ sv_of_string name; sv_of_string value ]
98
99   method click ?xy button =
100     let args = match xy with
101         None -> [ sv_of_string button ]
102       | Some (x, y) -> [ sv_of_string button; sv_of_int x; sv_of_int y ] in
103     call_method_void sv "click" args
104   method click1 () =
105     call_method_void sv "click" []
106   method click_button ?name ?number ?value ?xy () =
107     let args = ref [] in
108     let add name f = function
109       | None -> ()
110       | Some p -> args := sv_of_string name :: f p :: !args
111     in
112     add "name" sv_of_string name;
113     add "number" sv_of_int number;
114     add "value" sv_of_string value;
115     (match xy with
116          None -> ()
117        | Some (x, y) ->
118            args := sv_of_string "x" :: sv_of_int x ::
119              sv_of_string "y" :: sv_of_int y :: !args);
120     call_method_void sv "click" !args
121
122   method select name value =
123     call_method_void sv "select" [ sv_of_string name; sv_of_string value ]
124   method select_multiple name values =
125     let av = av_empty () in
126     List.iter (av_push av) (List.map sv_of_string values);
127     call_method_void sv "select" [ sv_of_string name; arrayref av ]
128
129   method submit () =
130     call_method_void sv "submit" []
131
132   (*method submit_form ?form_number ?form_name ?fields ?button ?xy () *)
133
134   method success =
135     let sv = call_method sv "success" [] in
136     bool_of_sv sv
137   method uri =
138     let sv = call_method sv "uri" [] in
139     string_of_sv sv
140   method response =
141     let sv = call_method sv "response" [] in
142     new Pl_HTTP_Response.http_response sv
143   method res =
144     let sv = call_method sv "res" [] in
145     new Pl_HTTP_Response.http_response sv
146   method status =
147     let sv = call_method sv "status" [] in
148     int_of_sv sv
149   method ct =
150     let sv = call_method sv "ct" [] in
151     string_of_sv sv
152   method base =
153     let sv = call_method sv "base" [] in
154     string_of_sv sv
155   method content =
156     let sv = call_method sv "content" [] in
157     string_of_sv sv
158   (* method current_forms = *)
159   method links =
160     let svs = call_method_array sv "links" [] in
161     List.map (new www_mechanize_link) svs
162   method is_html =
163     let sv = call_method sv "is_html" [] in
164     bool_of_sv sv
165   method title =
166     let sv = call_method sv "title" [] in
167     string_of_sv sv
168
169   (* method find_link .... = *)
170   (* method find_all_links .... = *)
171
172   (* method add_header .... = *)
173   (* method delete_header .... = *)
174
175   method quiet =
176     let sv = call_method sv "quiet" [] in
177     bool_of_sv sv
178   method set_quiet b =
179     call_method_void sv "quiet" [sv_of_bool b]
180   (* method stack_depth ... = *)
181   method redirect_ok =
182     let sv = call_method sv "redirect_ok" [] in
183     bool_of_sv sv
184
185   (* method request ... = *)
186   (* method update_html ... = *)
187
188 end
189
190 (* Not much documentation exists for the WWW::Mechanize::Link class.  As far
191  * as I can see, the only documented method is #url to return the URL. XXX
192  *)
193 and www_mechanize_link sv =
194
195 object (self)
196
197   method sv = sv
198
199   method url =
200     let sv = call_method sv "url" [] in
201     string_of_sv sv
202
203 end
204
205 (* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
206 (* XXX WWW::Mechanize has additional parameters. *)
207 let new_ ?autocheck () =
208   let args = ref [] in
209   let may f = function None -> () | Some v -> f v in
210   may (fun v ->
211          args := sv_of_string "autocheck" :: sv_of_bool v :: !args) autocheck;
212   let sv = call_class_method "WWW::Mechanize" "new" !args in
213   new www_mechanize sv