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