(** Wrapper around Perl [WWW::Mechanize] class. *)
(*  Copyright (C) 2003 Merjis Ltd.

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Library General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library; see the file COPYING.  If not, write to
    the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA 02111-1307, USA.

    $Id: pl_WWW_Mechanize.ml,v 1.8 2008-03-01 13:02:21 rich Exp $
  *)

open Perl

open Pl_LWP_UserAgent

let _ = eval "use WWW::Mechanize"

class www_mechanize sv =

object (self)
  inherit lwp_useragent sv

  method agent_alias alias =
    call_method_void sv "agent_alias" [sv_of_string alias]
  method known_agent_aliases =
    let svlist = call_method_array sv "known_agent_aliases" [] in
    List.map string_of_sv svlist

  method get url =
    call_method_void sv "get" [sv_of_string url]
  method reload () =
    call_method_void sv "reload" []
  method back () =
    call_method_void sv "back" []

  method follow_link ?text ?text_regex ?url ?url_regex ?url_abs ?url_abs_regex
    ?name ?name_regex ?tag ?tag_regex ?n () =
    let args = ref [] in
    let add name f = function
      | None -> ()
      | Some p -> args := sv_of_string name :: f p :: !args
    in
    add "text" sv_of_string text;
    add "text_regex" sv_of_string text_regex;
    add "url" sv_of_string url;
    add "url_regex" sv_of_string url_regex;
    add "url_abs" sv_of_string url_abs;
    add "url_abs_regex" sv_of_string url_abs_regex;
    add "name" sv_of_string name;
    add "name_regex" sv_of_string name_regex;
    add "tag" sv_of_string tag;
    add "tag_regex" sv_of_string tag_regex;
    add "n" sv_of_int n;
    call_method_void sv "follow_link" !args

  method forms =
    let svlist = call_method_array sv "forms" [] in
    List.map (new Pl_HTML_Form.html_form) svlist
  method form_number n =
    let sv = call_method sv "form_number" [sv_of_int n] in
    new Pl_HTML_Form.html_form sv
  method form_name name =
    let sv = call_method sv "form_name" [sv_of_string name] in
    new Pl_HTML_Form.html_form sv

  (* XXX There is an arrayref variant of this method, but what
   * it does is apparently undocumented.
   *)
  method field ?n name value =
    let args = match n with
	None -> [sv_of_string name; sv_of_string value]
      | Some n -> [sv_of_string name; sv_of_string value; sv_of_int n] in
    call_method_void sv "field" args
  method set_fields fields =
    let args = ref [] in
    List.iter (fun (k, v) ->
		 (* Note: reversed k, v because we'll reverse the whole list.*)
		 args := sv_of_string v :: sv_of_string k :: !args) fields;
    let args = List.rev !args in
    call_method_void sv "set_fields" args

  method value ?n name =
    let args = match n with
	None -> [sv_of_string name]
      | Some n -> [sv_of_string name; sv_of_int n] in
    let sv = call_method sv "value" args in
    string_of_sv sv

  (* XXX Doesn't support setting criteria. *)
  method set_visible names =
    let names = List.map sv_of_string names in
    call_method_void sv "set_visible" names

  method tick ?set name value =
    let args = match set with
	None -> [ sv_of_string name; sv_of_string value ]
      | Some b -> [ sv_of_string name; sv_of_string value; sv_of_bool b ] in
    call_method_void sv "tick" args

  method untick name value =
    call_method_void sv "untick" [ sv_of_string name; sv_of_string value ]

  method click ?xy button =
    let args = match xy with
	None -> [ sv_of_string button ]
      | Some (x, y) -> [ sv_of_string button; sv_of_int x; sv_of_int y ] in
    call_method_void sv "click" args
  method click1 () =
    call_method_void sv "click" []
  method click_button ?name ?number ?value ?xy () =
    let args = ref [] in
    let add name f = function
      | None -> ()
      | Some p -> args := sv_of_string name :: f p :: !args
    in
    add "name" sv_of_string name;
    add "number" sv_of_int number;
    add "value" sv_of_string value;
    (match xy with
	 None -> ()
       | Some (x, y) ->
	   args := sv_of_string "x" :: sv_of_int x ::
	     sv_of_string "y" :: sv_of_int y :: !args);
    call_method_void sv "click" !args

  method select name value =
    call_method_void sv "select" [ sv_of_string name; sv_of_string value ]
  method select_multiple name values =
    let av = av_empty () in
    List.iter (av_push av) (List.map sv_of_string values);
    call_method_void sv "select" [ sv_of_string name; arrayref av ]

  method submit () =
    call_method_void sv "submit" []

  method submit_form ?form_number ?form_name ?fields ?button ?xy () =
    let args = ref [] in
    let add name f = function
      | None -> ()
      | Some p -> args := sv_of_string name :: f p :: !args
    in
    add "form_number" sv_of_int form_number;
    add "form_name" sv_of_string form_name;
    (match fields with
     | None -> ()
     | Some fields ->
	 let hv = hv_empty () in
	 List.iter (
	   fun (name, value) ->
	     hv_set hv name (sv_of_string value)
	 ) fields;
	 let sv = hashref hv in
	 args := sv_of_string "fields" :: sv :: !args
    );
    add "button" sv_of_string button;
    (match xy with
     | None -> ()
     | Some (x, y) ->
	 args := sv_of_string "x" :: sv_of_int x ::
	   sv_of_string "y" :: sv_of_int y :: !args);
    let sv = call_method sv "submit_form" !args in
    new Pl_HTTP_Response.http_response sv

  method success =
    let sv = call_method sv "success" [] in
    bool_of_sv sv
  method uri =
    let sv = call_method sv "uri" [] in
    string_of_sv sv
  method response =
    let sv = call_method sv "response" [] in
    new Pl_HTTP_Response.http_response sv
  method res =
    let sv = call_method sv "res" [] in
    new Pl_HTTP_Response.http_response sv
  method status =
    let sv = call_method sv "status" [] in
    int_of_sv sv
  method ct =
    let sv = call_method sv "ct" [] in
    string_of_sv sv
  method base =
    let sv = call_method sv "base" [] in
    string_of_sv sv
  method content =
    let sv = call_method sv "content" [] in
    string_of_sv sv
  (* method current_forms = *)
  method links =
    let svs = call_method_array sv "links" [] in
    List.map (new www_mechanize_link) svs
  method is_html =
    let sv = call_method sv "is_html" [] in
    bool_of_sv sv
  method title =
    let sv = call_method sv "title" [] in
    string_of_sv sv

  (* method find_link .... = *)
  (* method find_all_links .... = *)

  (* method add_header .... = *)
  (* method delete_header .... = *)

  method quiet =
    let sv = call_method sv "quiet" [] in
    bool_of_sv sv
  method set_quiet b =
    call_method_void sv "quiet" [sv_of_bool b]
  (* method stack_depth ... = *)
  method redirect_ok =
    let sv = call_method sv "redirect_ok" [] in
    bool_of_sv sv

  (* method request ... = *)
  (* method update_html ... = *)

end

and www_mechanize_link sv =

object (self)

  method sv = sv

  method url =
    let sv = call_method sv "url" [] in
    string_of_sv sv

  method text =
    let sv = call_method sv "text" [] in
    string_of_sv sv

  method name =
    let sv = call_method sv "name" [] in
    string_of_sv sv

  method tag =
    let sv = call_method sv "tag" [] in
    string_of_sv sv

  method base =
    let sv = call_method sv "base" [] in
    string_of_sv sv

  method url_abs =
    let sv = call_method sv "url_abs" [] in
    string_of_sv sv

end

(* XXX Should be able to pass args to constructor of LWP::UserAgent. *)
(* XXX WWW::Mechanize has additional parameters. *)
let new_ ?autocheck () =
  let args = ref [] in
  let may f = function None -> () | Some v -> f v in
  may (fun v ->
	 args := sv_of_string "autocheck" :: sv_of_bool v :: !args) autocheck;
  let sv = call_class_method "WWW::Mechanize" "new" !args in
  new www_mechanize sv