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.1 2004-11-25 21:24:51 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   (* XXX What do these next two functions return? *)
  53   method form_number n =
  54     call_method_void sv "form_number" [sv_of_int n]
  55   method form_name name =
  56     call_method_void sv "form_name" [sv_of_string name]
  57
  58   (* XXX There is an arrayref variant of this method, but what
  59    * it does is apparently undocumented.
  60    *)
  61   method field name value n =
  62     call_method_void sv "field" [sv_of_string name; sv_of_string value;
  63                                  sv_of_int n]
  64   method set_fields fields =
  65     let args = ref [] in
  66     List.iter (fun (k, v) ->
  67                  (* Note: reversed k, v because we'll reverse the whole list.*)
  68                  args := sv_of_string v :: sv_of_string k :: !args) fields;
  69     let args = List.rev !args in
  70     call_method_void sv "set_fields" args
  71
  72   method value name n =
  73     let sv = call_method sv "value" [sv_of_string name; sv_of_int n] in
  74     string_of_sv sv
  75
  76   (* XXX Doesn't support setting criteria. *)
  77   method set_visible names =
  78     let names = List.map sv_of_string names in
  79     call_method_void sv "set_visible" names
  80
  81   method tick ?set name value =
  82     let args = match set with
  83         None -> [ sv_of_string name; sv_of_string value ]
  84       | Some b -> [ sv_of_string name; sv_of_string value; sv_of_bool b ] in
  85     call_method_void sv "tick" args
  86
  87   method untick name value =
  88     call_method_void sv "untick" [ sv_of_string name; sv_of_string value ]
  89
  90   method click ?xy button =
  91     let args = match xy with
  92         None -> [ sv_of_string button ]
  93       | Some (x, y) -> [ sv_of_string button; sv_of_int x; sv_of_int y ] in
  94     call_method_void sv "click" args
  95   method click1 () =
  96     call_method_void sv "click" []
  97   method click_button ?name ?number ?value ?xy () =
  98     let args = ref [] in
  99     let add name f = function
 100       | None -> ()
 101       | Some p -> args := sv_of_string name :: f p :: !args
 102     in
 103     add "name" sv_of_string name;
 104     add "number" sv_of_int number;
 105     add "value" sv_of_string value;
 106     (match xy with
 107          None -> ()
 108        | Some (x, y) ->
 109            args := sv_of_string "x" :: sv_of_int x ::
 110              sv_of_string "y" :: sv_of_int y :: !args);
 111     call_method_void sv "click" !args
 112
 113   method select name value =
 114     call_method_void sv "select" [ sv_of_string name; sv_of_string value ]
 115   method select_multiple name values =
 116     let av = av_empty () in
 117     List.iter (av_push av) (List.map sv_of_string values);
 118     call_method_void sv "select" [ sv_of_string name; arrayref av ]
 119
 120   method submit () =
 121     call_method_void sv "submit" []
 122
 123   (*method submit_form ?form_number ?form_name ?fields ?button ?xy () *)
 124
 125   method success =
 126     let sv = call_method sv "success" [] in
 127     bool_of_sv sv
 128   method uri =
 129     let sv = call_method sv "uri" [] in
 130     string_of_sv sv
 131   method response =
 132     let sv = call_method sv "response" [] in
 133     new Pl_HTTP_Response.http_response sv
 134   method res =
 135     let sv = call_method sv "res" [] in
 136     new Pl_HTTP_Response.http_response sv
 137   method status =
 138     let sv = call_method sv "status" [] in
 139     int_of_sv sv
 140   method ct =
 141     let sv = call_method sv "ct" [] in
 142     string_of_sv sv
 143   method base =
 144     let sv = call_method sv "base" [] in
 145     string_of_sv sv
 146   method content =
 147     let sv = call_method sv "content" [] in
 148     string_of_sv sv
 149   (* method forms = *)
 150   (* method current_forms = *)
 151   (* method links = *)
 152   method is_html =
 153     let sv = call_method sv "is_html" [] in
 154     bool_of_sv sv
 155   method title =
 156     let sv = call_method sv "title" [] in
 157     string_of_sv sv
 158
 159   (* method find_link .... = *)
 160   (* method find_all_links .... = *)
 161
 162   (* method add_header .... = *)
 163   (* method delete_header .... = *)
 164
 165   method quiet =
 166     let sv = call_method sv "quiet" [] in
 167     bool_of_sv sv
 168   method set_quiet b =
 169     call_method_void sv "quiet" [sv_of_bool b]
 170   (* method stack_depth ... = *)
 171   method redirect_ok =
 172     let sv = call_method sv "redirect_ok" [] in
 173     bool_of_sv sv
 174
 175   (* method request ... = *)
 176   (* method update_html ... = *)
 177
 178 end
 179
 180 (* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
 181 (* XXX WWW::Mechanize has additional parameters. *)
 182 let new_ () =
 183   let sv = call_class_method "WWW::Mechanize" "new" [] in
 184   new www_mechanize sv