From: rich <rich>
Date: Fri, 26 Nov 2004 13:33:10 +0000 (+0000)
Subject: More wrapping paper.
X-Git-Url: http://git.annexia.org/?p=perl4caml.git;a=commitdiff_plain;h=95114635aee7abc960959ed6502d11b4dc421e1a

More wrapping paper.
---

diff --git a/.depend b/.depend
index 7cb0eba..40f224f 100644
--- a/.depend
+++ b/.depend
@@ -22,6 +22,8 @@ wrappers/pl_Date_Parse.cmo: perl.cmi
 wrappers/pl_Date_Parse.cmx: perl.cmx 
 wrappers/pl_HTML_Element.cmo: perl.cmi 
 wrappers/pl_HTML_Element.cmx: perl.cmx 
+wrappers/pl_HTML_Form.cmo: perl.cmi wrappers/pl_HTTP_Response.cmo 
+wrappers/pl_HTML_Form.cmx: perl.cmx wrappers/pl_HTTP_Response.cmx 
 wrappers/pl_HTML_Parser.cmo: perl.cmi 
 wrappers/pl_HTML_Parser.cmx: perl.cmx 
 wrappers/pl_HTML_TreeBuilder.cmo: perl.cmi wrappers/pl_HTML_Element.cmo \
@@ -64,7 +66,7 @@ wrappers/pl_Template.cmo: perl.cmi
 wrappers/pl_Template.cmx: perl.cmx 
 wrappers/pl_URI.cmo: perl.cmi 
 wrappers/pl_URI.cmx: perl.cmx 
-wrappers/pl_WWW_Mechanize.cmo: perl.cmi wrappers/pl_HTTP_Response.cmo \
-    wrappers/pl_LWP_UserAgent.cmo 
-wrappers/pl_WWW_Mechanize.cmx: perl.cmx wrappers/pl_HTTP_Response.cmx \
-    wrappers/pl_LWP_UserAgent.cmx 
+wrappers/pl_WWW_Mechanize.cmo: perl.cmi wrappers/pl_HTML_Form.cmo \
+    wrappers/pl_HTTP_Response.cmo wrappers/pl_LWP_UserAgent.cmo 
+wrappers/pl_WWW_Mechanize.cmx: perl.cmx wrappers/pl_HTML_Form.cmx \
+    wrappers/pl_HTTP_Response.cmx wrappers/pl_LWP_UserAgent.cmx 
diff --git a/Makefile b/Makefile
index bf1444e..3766908 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 # Interface to Perl from OCaml.
 # Copyright (C) 2003 Merjis Ltd.
-# $Id: Makefile,v 1.24 2004-11-25 21:33:20 rich Exp $
+# $Id: Makefile,v 1.25 2004-11-26 13:33:10 rich Exp $
 
 include Makefile.config
 
@@ -49,6 +49,7 @@ WRAPPERS := \
 	wrappers/pl_HTTP_Request.cmo \
 	wrappers/pl_HTTP_Request_Common.cmo \
 	wrappers/pl_HTTP_Response.cmo \
+	wrappers/pl_HTML_Form.cmo \
 	wrappers/pl_LWP_UserAgent.cmo \
 	wrappers/pl_Template.cmo \
 	wrappers/pl_WWW_Mechanize.cmo
diff --git a/wrappers/pl_HTML_Form.ml b/wrappers/pl_HTML_Form.ml
new file mode 100644
index 0000000..ebe3a39
--- /dev/null
+++ b/wrappers/pl_HTML_Form.ml
@@ -0,0 +1,30 @@
+(** Wrapper around Perl [HTML::Form] class.
+  *
+  * Copyright (C) 2003 Merjis Ltd.
+  *
+  * $Id: pl_HTML_Form.ml,v 1.1 2004-11-26 13:33:10 rich Exp $
+  *)
+
+open Perl
+
+open Pl_HTTP_Response
+
+let _ = eval "use HTML::Form"
+
+class html_form (sv : sv) =
+
+object (self)
+  method sv = sv
+
+  (* No methods wrapped yet! *)
+
+end
+
+let parse_document html_document base_uri =
+  let svlist = call_class_method_array "HTML::Form" "parse"
+		 [sv_of_string html_document; sv_of_string base_uri] in
+  List.map (new html_form) svlist
+
+let parse_response (res : http_response) =
+  let svlist = call_class_method_array "HTML::Form" "parse" [res#sv] in
+  List.map (new html_form) svlist
diff --git a/wrappers/pl_HTTP_Headers.ml b/wrappers/pl_HTTP_Headers.ml
index 7f7b2c9..cdab7ca 100644
--- a/wrappers/pl_HTTP_Headers.ml
+++ b/wrappers/pl_HTTP_Headers.ml
@@ -2,7 +2,7 @@
   *
   * Copyright (C) 2003 Merjis Ltd.
   *
-  * $Id: pl_HTTP_Headers.ml,v 1.1 2004-11-22 17:08:36 rich Exp $
+  * $Id: pl_HTTP_Headers.ml,v 1.2 2004-11-26 13:33:10 rich Exp $
   *)
 
 open Perl
@@ -13,6 +13,8 @@ class http_headers sv =
 
 object (self)
 
+  method sv = sv
+
   method header key =
     string_of_sv (call_method sv "header" [sv_of_string key])
   method set_header key value =
diff --git a/wrappers/pl_WWW_Mechanize.ml b/wrappers/pl_WWW_Mechanize.ml
index a29a5a9..2582b9d 100644
--- a/wrappers/pl_WWW_Mechanize.ml
+++ b/wrappers/pl_WWW_Mechanize.ml
@@ -2,7 +2,7 @@
   *
   * Copyright (C) 2004 Merjis Ltd.
   *
-  * $Id: pl_WWW_Mechanize.ml,v 1.1 2004-11-25 21:24:51 rich Exp $
+  * $Id: pl_WWW_Mechanize.ml,v 1.2 2004-11-26 13:33:10 rich Exp $
   *)
 
 open Perl
@@ -49,18 +49,24 @@ object (self)
     add "n" sv_of_int n;
     call_method_void sv "follow_link" !args
 
-  (* XXX What do these next two functions return? *)
+  method forms =
+    let svlist = call_method_array sv "forms" [] in
+    List.map (new Pl_HTML_Form.html_form) svlist
   method form_number n =
-    call_method_void sv "form_number" [sv_of_int n]
+    let sv = call_method sv "form_number" [sv_of_int n] in
+    new Pl_HTML_Form.html_form sv
   method form_name name =
-    call_method_void sv "form_name" [sv_of_string 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 name value n =
-    call_method_void sv "field" [sv_of_string name; sv_of_string value;
-				 sv_of_int n]
+  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) ->
@@ -69,8 +75,11 @@ object (self)
     let args = List.rev !args in
     call_method_void sv "set_fields" args
 
-  method value name n =
-    let sv = call_method sv "value" [sv_of_string name; sv_of_int n] in
+  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. *)
@@ -146,7 +155,6 @@ object (self)
   method content =
     let sv = call_method sv "content" [] in
     string_of_sv sv
-  (* method forms = *)
   (* method current_forms = *)
   (* method links = *)
   method is_html =