wrappers/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.6 2005-08-16 15:39:22 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     let args = ref [] in
 134     let add name f = function
 135       | None -> ()
 136       | Some p -> args := sv_of_string name :: f p :: !args
 137     in
 138     add "form_number" sv_of_int form_number;
 139     add "form_name" sv_of_string form_name;
 140     (match fields with
 141      | None -> ()
 142      | Some fields ->
 143          let hv = hv_empty () in
 144          List.iter (
 145            fun (name, value) ->
 146              hv_set hv name (sv_of_string value)
 147          ) fields;
 148          let sv = hashref hv in
 149          args := sv_of_string "fields" :: sv :: !args
 150     );
 151     add "button" sv_of_string button;
 152     (match xy with
 153      | None -> ()
 154      | Some (x, y) ->
 155          args := sv_of_string "x" :: sv_of_int x ::
 156            sv_of_string "y" :: sv_of_int y :: !args);
 157     let sv = call_method sv "submit_form" !args in
 158     new Pl_HTTP_Response.http_response sv
 159
 160   method success =
 161     let sv = call_method sv "success" [] in
 162     bool_of_sv sv
 163   method uri =
 164     let sv = call_method sv "uri" [] in
 165     string_of_sv sv
 166   method response =
 167     let sv = call_method sv "response" [] in
 168     new Pl_HTTP_Response.http_response sv
 169   method res =
 170     let sv = call_method sv "res" [] in
 171     new Pl_HTTP_Response.http_response sv
 172   method status =
 173     let sv = call_method sv "status" [] in
 174     int_of_sv sv
 175   method ct =
 176     let sv = call_method sv "ct" [] in
 177     string_of_sv sv
 178   method base =
 179     let sv = call_method sv "base" [] in
 180     string_of_sv sv
 181   method content =
 182     let sv = call_method sv "content" [] in
 183     string_of_sv sv
 184   (* method current_forms = *)
 185   method links =
 186     let svs = call_method_array sv "links" [] in
 187     List.map (new www_mechanize_link) svs
 188   method is_html =
 189     let sv = call_method sv "is_html" [] in
 190     bool_of_sv sv
 191   method title =
 192     let sv = call_method sv "title" [] in
 193     string_of_sv sv
 194
 195   (* method find_link .... = *)
 196   (* method find_all_links .... = *)
 197
 198   (* method add_header .... = *)
 199   (* method delete_header .... = *)
 200
 201   method quiet =
 202     let sv = call_method sv "quiet" [] in
 203     bool_of_sv sv
 204   method set_quiet b =
 205     call_method_void sv "quiet" [sv_of_bool b]
 206   (* method stack_depth ... = *)
 207   method redirect_ok =
 208     let sv = call_method sv "redirect_ok" [] in
 209     bool_of_sv sv
 210
 211   (* method request ... = *)
 212   (* method update_html ... = *)
 213
 214 end
 215
 216 and www_mechanize_link sv =
 217
 218 object (self)
 219
 220   method sv = sv
 221
 222   method url =
 223     let sv = call_method sv "url" [] in
 224     string_of_sv sv
 225
 226   method text =
 227     let sv = call_method sv "text" [] in
 228     string_of_sv sv
 229
 230   method name =
 231     let sv = call_method sv "name" [] in
 232     string_of_sv sv
 233
 234   method tag =
 235     let sv = call_method sv "tag" [] in
 236     string_of_sv sv
 237
 238   method base =
 239     let sv = call_method sv "base" [] in
 240     string_of_sv sv
 241
 242 end
 243
 244 (* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
 245 (* XXX WWW::Mechanize has additional parameters. *)
 246 let new_ ?autocheck () =
 247   let args = ref [] in
 248   let may f = function None -> () | Some v -> f v in
 249   may (fun v ->
 250          args := sv_of_string "autocheck" :: sv_of_bool v :: !args) autocheck;
 251   let sv = call_class_method "WWW::Mechanize" "new" !args in
 252   new www_mechanize sv