Fixed loads of bugs. It now works. Ready to integrate in assessortool.
authorrich <rich>
Tue, 14 Oct 2003 16:05:21 +0000 (16:05 +0000)
committerrich <rich>
Tue, 14 Oct 2003 16:05:21 +0000 (16:05 +0000)
14 files changed:
.depend
Makefile
examples/.cvsignore
examples/google.ml [new file with mode: 0644]
examples/loadpage.ml
perl.ml
perl.mli
perl_c.c
wrappers/pl_HTML_Element.ml
wrappers/pl_Net_Google.ml [new file with mode: 0644]
wrappers/pl_Net_Google_Cache.ml [new file with mode: 0644]
wrappers/pl_Net_Google_Response.ml [new file with mode: 0644]
wrappers/pl_Net_Google_Search.ml [new file with mode: 0644]
wrappers/pl_Net_Google_Spelling.ml [new file with mode: 0644]

diff --git a/.depend b/.depend
index e160297..df0f9dd 100644 (file)
--- a/.depend
+++ b/.depend
@@ -2,6 +2,8 @@ perl.cmo: perl.cmi
 perl.cmx: perl.cmi 
 perl_init.cmo: perl.cmi 
 perl_init.cmx: perl.cmx 
+examples/google.cmo: perl.cmi wrappers/pl_Net_Google.cmo 
+examples/google.cmx: perl.cmx wrappers/pl_Net_Google.cmx 
 examples/loadpage.cmo: perl.cmi wrappers/pl_HTML_Element.cmo \
     wrappers/pl_HTML_TreeBuilder.cmo wrappers/pl_HTTP_Request.cmo \
     wrappers/pl_LWP_UserAgent.cmo 
@@ -30,5 +32,19 @@ wrappers/pl_LWP_UserAgent.cmo: perl.cmi wrappers/pl_HTTP_Request.cmo \
     wrappers/pl_HTTP_Response.cmo 
 wrappers/pl_LWP_UserAgent.cmx: perl.cmx wrappers/pl_HTTP_Request.cmx \
     wrappers/pl_HTTP_Response.cmx 
+wrappers/pl_Net_Google.cmo: perl.cmi wrappers/pl_Net_Google_Cache.cmo \
+    wrappers/pl_Net_Google_Search.cmo wrappers/pl_Net_Google_Spelling.cmo 
+wrappers/pl_Net_Google.cmx: perl.cmx wrappers/pl_Net_Google_Cache.cmx \
+    wrappers/pl_Net_Google_Search.cmx wrappers/pl_Net_Google_Spelling.cmx 
+wrappers/pl_Net_Google_Cache.cmo: perl.cmi 
+wrappers/pl_Net_Google_Cache.cmx: perl.cmx 
+wrappers/pl_Net_Google_Response.cmo: perl.cmi 
+wrappers/pl_Net_Google_Response.cmx: perl.cmx 
+wrappers/pl_Net_Google_Search.cmo: perl.cmi \
+    wrappers/pl_Net_Google_Response.cmo 
+wrappers/pl_Net_Google_Search.cmx: perl.cmx \
+    wrappers/pl_Net_Google_Response.cmx 
+wrappers/pl_Net_Google_Spelling.cmo: perl.cmi 
+wrappers/pl_Net_Google_Spelling.cmx: perl.cmx 
 wrappers/pl_URI.cmo: perl.cmi 
 wrappers/pl_URI.cmx: perl.cmx 
index c365c0a..1365ff1 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 # Interface to Perl from OCaml.
 # Copyright (C) 2003 Merjis Ltd.
-# $Id: Makefile,v 1.6 2003-10-12 17:33:14 rich Exp $
+# $Id: Makefile,v 1.7 2003-10-14 16:05:21 rich Exp $
 
 include Makefile.config
 
@@ -18,7 +18,14 @@ OCAMLOPTFLAGS := -w s $(OCAMLOPTINCS)
 CC := gcc
 CFLAGS := -Wall -Wno-unused -I$(PERLINCDIR)
 
+LIBPERL := $(shell perl -MExtUtils::Embed -e ldopts)
+
 WRAPPERS := \
+       wrappers/pl_Net_Google_Cache.cmo \
+       wrappers/pl_Net_Google_Response.cmo \
+       wrappers/pl_Net_Google_Search.cmo \
+       wrappers/pl_Net_Google_Spelling.cmo \
+       wrappers/pl_Net_Google.cmo \
        wrappers/pl_HTML_Element.cmo \
        wrappers/pl_HTML_Parser.cmo \
        wrappers/pl_HTML_TreeBuilder.cmo \
@@ -26,17 +33,18 @@ WRAPPERS := \
        wrappers/pl_HTTP_Message.cmo \
        wrappers/pl_HTTP_Request.cmo \
        wrappers/pl_HTTP_Response.cmo \
-       wrappers/pl_LWP_UserAgent.cmo
+       wrappers/pl_LWP_UserAgent.cmo \
+       wrappers/pl_Net_Google.cmo
 
 all:   perl.cma perl.cmxa perl_init.cmo perl_init.cmx all-examples
 
 perl.cma: perl.cmo perl_c.o $(WRAPPERS)
-       $(OCAMLMKLIB) -o perl $^ -lperl
+       $(OCAMLMKLIB) -o perl $(LIBPERL) $^
 
 perl.cmxa: perl.cmx perl_c.o $(WRAPPERS:.cmo=.cmx)
-       $(OCAMLMKLIB) -o perl $^ -lperl
+       $(OCAMLMKLIB) -o perl $(LIBPERL) $^
 
-all-examples: examples/test examples/loadpage
+all-examples: examples/test examples/loadpage examples/google
 
 examples/test: examples/test.cmo
        $(OCAMLC) $(OCAMLCFLAGS) perl.cma perl_init.cmo $^ -o $@
@@ -50,6 +58,12 @@ examples/loadpage: examples/loadpage.cmo
 #examples/loadpage.opt: examples/loadpage.cmx
 #      $(OCAMLOPT) $(OCAMLOPTFLAGS) perl.cmxa perl_init.cmx $^ -o $@
 
+examples/google: examples/google.cmo
+       $(OCAMLC) $(OCAMLCFLAGS) perl.cma perl_init.cmo $^ -o $@
+
+#examples/google.opt: examples/google.cmx
+#      $(OCAMLOPT) $(OCAMLOPTFLAGS) perl.cmxa perl_init.cmx $^ -o $@
+
 %.cmi: %.mli
        $(OCAMLC) $(OCAMLCFLAGS) -c $<
 
@@ -66,7 +80,7 @@ examples/loadpage: examples/loadpage.cmo
 JUNKFILES = core *~ *.bak *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so
 
 clean:
-       rm -f examples/test examples/loadpage
+       rm -f examples/test examples/loadpage examples/google
        for d in . examples wrappers; do (cd $$d; rm -f $(JUNKFILES)); done
 
 # Build dependencies.
index 4114948..c39553a 100644 (file)
@@ -4,4 +4,5 @@
 *.cma
 *.cmxa
 test
-loadpage
\ No newline at end of file
+loadpage
+google
\ No newline at end of file
diff --git a/examples/google.ml b/examples/google.ml
new file mode 100644 (file)
index 0000000..47bd8e4
--- /dev/null
@@ -0,0 +1,34 @@
+(* Example program which uses Net::Google to query Google.
+ * You will need to have a Google API key in ~/.googlekey for this to work.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: google.ml,v 1.1 2003-10-14 16:05:21 rich Exp $
+ *)
+
+open Printf
+
+open Pl_Net_Google
+
+let () =
+  (* This is a hack which shouldn't be needed in future. *)
+  Perl.eval "use Net::Google";
+
+  (* Load Google API key. *)
+  let home = Sys.getenv "HOME" in
+  let chan = open_in (home ^ "/.googlekey") in
+  let key = input_line chan in
+  close_in chan;
+
+  (* Create the Google query object. *)
+  let google = Pl_Net_Google.new_ ~key () in
+
+  (* Search. *)
+  let search = google#search () in
+  search#set_query "merjis";
+  search#set_max_results 5;
+
+  printf "Top 5 results for \"merjis\":\n"; flush stdout;
+
+  List.iter
+    (fun response ->
+       printf "* %s\n  <URL:%s>\n\n" response#title response#url
+    ) search#results;
index d73bf9c..9f67907 100644 (file)
@@ -1,7 +1,7 @@
 (* Example program which uses LWP::UserAgent and HTML::TreeBuilder to
  * download an HTTP page and parse it.
  * Copyright (C) 2003 Merjis Ltd.
- * $Id: loadpage.ml,v 1.1 2003-10-12 17:33:14 rich Exp $
+ * $Id: loadpage.ml,v 1.2 2003-10-14 16:05:21 rich Exp $
  *)
 
 open Printf
@@ -14,7 +14,7 @@ open Pl_HTML_Element
 let () =
   (* This is a hack which shouldn't be needed in future. *)
   Perl.eval "use LWP::UserAgent";
-  Perl.eval "use Net::HTTP";
+  Perl.eval "use HTML::TreeBuilder";
 
   let site =
     if Array.length Sys.argv >= 2 then
diff --git a/perl.ml b/perl.ml
index 7069d35..a82755b 100644 (file)
--- a/perl.ml
+++ b/perl.ml
@@ -1,11 +1,12 @@
 (* Interface to Perl from OCaml.
  * Copyright (C) 2003 Merjis Ltd.
- * $Id: perl.ml,v 1.4 2003-10-12 17:33:14 rich Exp $
+ * $Id: perl.ml,v 1.5 2003-10-14 16:05:21 rich Exp $
  *)
 
 type t
 
 type sv
+type av
 
 exception Perl_failure of string
 
@@ -54,9 +55,43 @@ type sv_t    = SVt_NULL
 
 external sv_type : sv -> sv_t = "perl4caml_sv_type"
 
+let string_of_sv_t = function
+    SVt_NULL  -> "SVt_NULL"
+  | SVt_IV    -> "SVt_IV"
+  | SVt_NV    -> "SVt_NV"
+  | SVt_PV    -> "SVt_PV"
+  | SVt_RV    -> "SVt_RV"
+  | SVt_PVAV  -> "SVt_PVAV"
+  | SVt_PVHV  -> "SVt_PVHV"
+  | SVt_PVCV  -> "SVt_PVCV"
+  | SVt_PVGV  -> "SVt_PVGV"
+  | SVt_PVMG  -> "SVt_PVMG"
+
 external deref : sv -> sv = "perl4caml_deref"
+external deref_array : sv -> av = "perl4caml_deref_array"
+
+external av_empty : unit -> av = "perl4caml_av_empty"
+external av_of_sv_list : sv list -> av = "perl4caml_av_of_sv_list"
+external av_push : av -> sv -> unit = "perl4caml_av_push"
+external av_pop : av -> sv = "perl4caml_av_pop"
+external av_shift : av -> sv = "perl4caml_av_shift"
+external av_unshift : av -> sv -> unit = "perl4caml_av_unshift"
+external av_length : av -> int = "perl4caml_av_length"
+external av_set : av -> int -> sv -> unit = "perl4caml_av_set"
+external av_get : av -> int -> sv = "perl4caml_av_get"
+external av_clear : av -> unit = "perl4caml_av_clear"
+external av_undef : av -> unit = "perl4caml_av_undef"
+external av_extend : av -> int -> unit = "perl4caml_av_extend"
+
+let av_map f av =
+  let list = ref [] in
+  for i = 0 to av_length av - 1 do
+    list := f (av_get av i) :: !list
+  done;
+  List.rev !list
 
 external get_sv : ?create:bool -> string -> sv = "perl4caml_get_sv"
+external get_av : ?create:bool -> string -> av = "perl4caml_get_av"
 
 external call : ?sv:sv -> ?fn:string -> sv list -> sv
   = "perl4caml_call"
index 2c60907..7bf89c3 100644 (file)
--- a/perl.mli
+++ b/perl.mli
@@ -2,7 +2,7 @@
   *
   * Copyright (C) 2003 Merjis Ltd.
   *
-  * $Id: perl.mli,v 1.4 2003-10-12 17:33:14 rich Exp $
+  * $Id: perl.mli,v 1.5 2003-10-14 16:05:21 rich Exp $
   *)
 
 type t
@@ -11,6 +11,14 @@ type t
 type sv
 (** Perl scalar value. *)
 
+type av
+(** Perl array value. *)
+
+(*
+type hv
+(** Perl hash value. *)
+*)
+
 exception Perl_failure of string
 (** [die] in Perl code is translated automatically into this exception. *)
 
@@ -107,18 +115,20 @@ external sv_type : sv -> sv_t = "perl4caml_sv_type"
 (** Return the type of data contained in an [SV]. Somewhat equivalent to
   * calling Perl's [ref] function.
   *)
+val string_of_sv_t : sv_t -> string
+(** Return a printable string for an [sv_t] ([SV] type). *)
 
 external deref : sv -> sv = "perl4caml_deref"
 (** The input is a reference to a scalar. This returns the underlying
   * scalar [SV]. If the input is not a reference to a scalar, throws
   * [Invalid_arg].
   *)
-(*
 external deref_array : sv -> av = "perl4caml_deref_array"
 (** The input is a reference to an array. This returns the underlying
   * array [AV]. If the input is not a reference to an array, throws
   * [Invalid_arg].
   *)
+(*
 external deref_hash : sv -> hv = "perl4caml_deref_hash"
 (** The input is a reference to a hash. This returns the underlying
   * hash [HV]. If the input is not a reference to a hash, throws
@@ -126,6 +136,37 @@ external deref_hash : sv -> hv = "perl4caml_deref_hash"
   *)
 *)
 
+external av_empty : unit -> av = "perl4caml_av_empty"
+(** Create an empty [AV] (array). *)
+external av_of_sv_list : sv list -> av = "perl4caml_av_of_sv_list"
+(** Create an array from a list of [SVs]. *)
+external av_push : av -> sv -> unit = "perl4caml_av_push"
+(** Append the [SV] to the end of the array. Same as Perl [push @av, $sv]. *)
+external av_pop : av -> sv = "perl4caml_av_pop"
+(** Remove the [SV] at the end of the array and return it. Same as
+  * Perl [$sv = pop @av]. *)
+external av_shift : av -> sv = "perl4caml_av_shift"
+(** Remove the [SV] at the beginning of the array and return it. Same as
+  * Perl [$sv = shift @av]. *)
+external av_unshift : av -> sv -> unit = "perl4caml_av_unshift"
+(** Prepend the [SV] to the start of the array. Same as Perl
+  * [unshift @av, $sv]. *)
+external av_length : av -> int = "perl4caml_av_length"
+(** Return the length of the [AV]. *)
+external av_set : av -> int -> sv -> unit = "perl4caml_av_set"
+(** Replace the i'th element of the [AV] with [SV]. *)
+external av_get : av -> int -> sv = "perl4caml_av_get"
+(** Get the i'th element of the [AV]. *)
+external av_clear : av -> unit = "perl4caml_av_clear"
+(** Remove all elements from the [AV]. Same as Perl [@av = ()]. *)
+external av_undef : av -> unit = "perl4caml_av_undef"
+(** Delete the [AV] (and all elements in it). Same as Perl [undef @av]. *)
+external av_extend : av -> int -> unit = "perl4caml_av_extend"
+(** Extend the [AV] so it contains at least [n+1] elements. *)
+val av_map : (sv -> 'a) -> av -> 'a list
+(** Map a function over the elements in the [AV], return a list of the
+  * results. *)
+
 external get_sv : ?create:bool -> string -> sv = "perl4caml_get_sv"
 (** Return a scalar value by name. For example, if you have a symbol
   * called [$a] in Perl, then [get_sv "a"] will return its value.
@@ -136,6 +177,8 @@ external get_sv : ?create:bool -> string -> sv = "perl4caml_get_sv"
   * not exist, then Perl will create the symbol (with value [undef]) and
   * this function will return the [SV] for [undef].
   *)
+external get_av : ?create:bool -> string -> av = "perl4caml_get_av"
+(** Same as {!get_sv} except will return and/or create [@a]. *)
 
 external call : ?sv:sv -> ?fn:string -> sv list -> sv
   = "perl4caml_call"
index 2a9e71d..bf78580 100644 (file)
--- a/perl_c.c
+++ b/perl_c.c
@@ -1,6 +1,6 @@
 /* Interface to Perl from OCaml.
  * Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.4 2003-10-12 17:33:14 rich Exp $
+ * $Id: perl_c.c,v 1.5 2003-10-14 16:05:21 rich Exp $
  */
 
 #include <stdio.h>
@@ -40,6 +40,17 @@ static value unoption (value option, value deflt);
 #define Perl_val(plv) (Voidptr_val (PerlInterpreter, (plv)))
 #define Val_sv(sv) (Val_voidptr ((sv)))
 #define Sv_val(svv) (Voidptr_val (SV, (svv)))
+#define Val_av(av) (Val_voidptr ((av)))
+#define Av_val(avv) (Voidptr_val (AV, (avv)))
+
+static void
+xs_init (pTHX)
+{
+  char *file = __FILE__;
+  EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+
+  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
 
 CAMLprim value
 perl4caml_init (value unit)
@@ -53,7 +64,7 @@ perl4caml_init (value unit)
   my_perl = perl_alloc ();
   perl_construct (my_perl);
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-  perl_parse (my_perl, NULL, argc, argv, NULL);
+  perl_parse (my_perl, xs_init, argc, argv, NULL);
   /*perl_run (my_perl);*/
 
   return Val_unit;
@@ -85,7 +96,7 @@ perl4caml_create (value optargs, value unit)
   my_perl = perl_alloc ();
   perl_construct (my_perl);
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-  perl_parse (my_perl, NULL, argc, argv, NULL);
+  perl_parse (my_perl, xs_init, argc, argv, NULL);
   /*perl_run (my_perl);*/
 
   CAMLreturn (Val_perl (my_perl));
@@ -254,6 +265,163 @@ perl4caml_deref (value svv)
 }
 
 CAMLprim value
+perl4caml_deref_array (value svv)
+{
+  CAMLparam1 (svv);
+  CAMLlocal1 (ravv);
+  SV *sv = Sv_val (svv);
+
+  if (SvTYPE (sv) != SVt_RV)
+    invalid_argument ("deref_array: SV is not a reference");
+  switch (SvTYPE (SvRV (sv))) {
+  case SVt_PVAV:
+    break;
+  default:
+    invalid_argument ("deref_array: SV is not a reference to an array");
+  }
+  ravv = Val_av ((AV *) SvRV (sv));
+  CAMLreturn (ravv);
+}
+
+CAMLprim value
+perl4caml_av_empty (value unit)
+{
+  CAMLparam1 (unit);
+  AV *av = newAV ();
+  CAMLreturn (Val_av (av));
+}
+
+/* We don't know in advance how long the list will be, which makes this
+ * a little harder.
+ */
+CAMLprim value
+perl4caml_av_of_sv_list (value svlistv)
+{
+  CAMLparam1 (svlistv);
+  CAMLlocal1 (svv);
+  SV *sv, **svlist = 0;
+  int alloc = 0, size = 0;
+  AV *av;
+
+  for (; svlistv != Val_int (0); svlistv = Field (svlistv, 1))
+    {
+      svv = Field (svlistv, 0);
+      sv = Sv_val (svv);
+      if (size >= alloc) {
+       alloc = alloc == 0 ? 1 : alloc * 2;
+       svlist = realloc (svlist, alloc * sizeof (SV *));
+      }
+      svlist[size++] = sv;
+    }
+
+  av = av_make (size, svlist);
+
+  if (alloc > 0) free (svlist);        /* Free memory allocated to SV list. */
+
+  CAMLreturn (Val_av (av));
+}
+
+/* XXX av_map would be faster if we also had sv_list_of_av. */
+
+CAMLprim value
+perl4caml_av_push (value avv, value svv)
+{
+  CAMLparam2 (avv, svv);
+  AV *av = Av_val (avv);
+  SV *sv = Sv_val (svv);
+  av_push (av, sv);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+perl4caml_av_pop (value avv)
+{
+  CAMLparam1 (avv);
+  AV *av = Av_val (avv);
+  SV *sv = av_pop (av);
+  CAMLreturn (Val_sv (sv));
+}
+
+CAMLprim value
+perl4caml_av_unshift (value avv, value svv)
+{
+  CAMLparam2 (avv, svv);
+  AV *av = Av_val (avv);
+  SV *sv = Sv_val (svv);
+  av_unshift (av, 1);
+  SvREFCNT_inc (sv);
+  if (av_store (av, 0, sv) == 0)
+    SvREFCNT_dec (sv);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+perl4caml_av_shift (value avv)
+{
+  CAMLparam1 (avv);
+  AV *av = Av_val (avv);
+  SV *sv = av_shift (av);
+  CAMLreturn (Val_sv (sv));
+}
+
+CAMLprim value
+perl4caml_av_length (value avv)
+{
+  CAMLparam1 (avv);
+  AV *av = Av_val (avv);
+  CAMLreturn (Val_int (av_len (av) + 1));
+}
+
+CAMLprim value
+perl4caml_av_set (value avv, value i, value svv)
+{
+  CAMLparam3 (avv, i, svv);
+  AV *av = Av_val (avv);
+  SV *sv = Sv_val (svv);
+  SvREFCNT_inc (sv);
+  if (av_store (av, Int_val (i), sv) == 0)
+    SvREFCNT_dec (sv);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+perl4caml_av_get (value avv, value i)
+{
+  CAMLparam2 (avv, i);
+  AV *av = Av_val (avv);
+  SV **svp = av_fetch (av, Int_val (i), 0);
+  if (svp == 0) invalid_argument ("av_get: index out of bounds");
+  CAMLreturn (Val_sv (*svp));
+}
+
+CAMLprim value
+perl4caml_av_clear (value avv)
+{
+  CAMLparam1 (avv);
+  AV *av = Av_val (avv);
+  av_clear (av);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+perl4caml_av_undef (value avv)
+{
+  CAMLparam1 (avv);
+  AV *av = Av_val (avv);
+  av_undef (av);
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+perl4caml_av_extend (value avv, value i)
+{
+  CAMLparam2 (avv, i);
+  AV *av = Av_val (avv);
+  av_extend (av, Int_val (i));
+  CAMLreturn (Val_unit);
+}
+
+CAMLprim value
 perl4caml_get_sv (value optcreate, value name)
 {
   CAMLparam2 (optcreate, name);
@@ -267,6 +435,20 @@ perl4caml_get_sv (value optcreate, value name)
   CAMLreturn (Val_sv (sv));
 }
 
+CAMLprim value
+perl4caml_get_av (value optcreate, value name)
+{
+  CAMLparam2 (optcreate, name);
+  CAMLlocal1 (create);
+  AV *av;
+
+  create = unoption (optcreate, Val_false);
+  av = get_av (String_val (name), create == Val_true ? TRUE : FALSE);
+  if (av == NULL) raise_not_found ();
+
+  CAMLreturn (Val_av (av));
+}
+
 static inline void
 check_perl_failure ()
 {
index 6430985..7c6f470 100644 (file)
@@ -1,6 +1,6 @@
 (* Wrapper around Perl HTML::Element class.
  * Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTML_Element.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTML_Element.ml,v 1.2 2003-10-14 16:05:22 rich Exp $
  *)
 
 open Perl
@@ -43,10 +43,17 @@ object (self)
     let svlist = call_method_array sv "content_list" [] in
     List.map
       (fun c ->
-        match sv_type c with
-            SVt_PV -> String (string_of_sv c)
-          | SVt_RV -> Element (new html_element (deref c))
-          | _ -> failwith "HTML::Element content_type: unknown type"
+        (* Not very satisfactory, but sv_type fails to discern the type
+         * for some reason. XXX
+         *)
+        let str = string_of_sv c in
+        let marker = "HTML::Element=HASH(" in
+        let marker_len = String.length marker in
+        if String.length str > marker_len &&
+          String.sub str 0 marker_len = marker then
+            Element (new html_element c)
+        else
+          String (string_of_sv c)
       ) svlist
   method all_attr =
     let svlist = call_method_array sv "all_attr" [] in
diff --git a/wrappers/pl_Net_Google.ml b/wrappers/pl_Net_Google.ml
new file mode 100644 (file)
index 0000000..0ebebbe
--- /dev/null
@@ -0,0 +1,71 @@
+(* Wrapper around Perl Net::Google class.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: pl_Net_Google.ml,v 1.1 2003-10-14 16:05:22 rich Exp $
+ *)
+
+open Perl
+
+open Pl_Net_Google_Cache
+open Pl_Net_Google_Search
+open Pl_Net_Google_Spelling
+
+let may f = function None -> () | Some v -> f v
+
+class net_google sv =
+
+object (self)
+
+  method search ?key ?starts_at ?max_results ?lr ?ie ?oe ?safe ?filter () =
+    let args = ref [] in
+    may (fun v ->
+          args := sv_of_string "key" :: sv_of_string v :: !args) key;
+    may (fun v ->
+          args := sv_of_string "starts_at" :: sv_of_int v :: !args) starts_at;
+    may (fun v ->
+          args := sv_of_string "max_results" :: sv_of_int v :: !args)
+      max_results;
+    may (fun v ->
+          args := sv_of_string "lr" :: sv_of_string v :: !args) lr;
+    may (fun v ->
+          args := sv_of_string "ie" :: sv_of_string v :: !args) ie;
+    may (fun v ->
+          args := sv_of_string "oe" :: sv_of_string v :: !args) oe;
+    may (fun v ->
+          args := sv_of_string "safe" :: sv_of_bool v :: !args) safe;
+    may (fun v ->
+          args := sv_of_string "filter" :: sv_of_bool v :: !args) filter;
+    let sv = call_method sv "search" !args in
+    new net_google_search sv
+
+  method spelling ?key ?phrase ?debug () =
+    let args = ref [] in
+    may (fun v ->
+          args := sv_of_string "key" :: sv_of_string v :: !args) key;
+    may (fun v ->
+          args := sv_of_string "phrase" :: sv_of_string v :: !args) phrase;
+    may (fun v ->
+          args := sv_of_string "debug" :: sv_of_int v :: !args) debug;
+    let sv = call_method sv "spelling" !args in
+    new net_google_spelling sv
+
+  method cache ?key ?url ?debug () =
+    let args = ref [] in
+    may (fun v ->
+          args := sv_of_string "key" :: sv_of_string v :: !args) key;
+    may (fun v ->
+          args := sv_of_string "url" :: sv_of_string v :: !args) url;
+    may (fun v ->
+          args := sv_of_string "debug" :: sv_of_int v :: !args) debug;
+    let sv = call_method sv "cache" !args in
+    new net_google_cache sv
+
+end
+
+let new_ ?key ?debug () =
+  let args = ref [] in
+  may (fun v ->
+        args := sv_of_string "key" :: sv_of_string v :: !args) key;
+  may (fun v ->
+        args := sv_of_string "debug" :: sv_of_int v :: !args) debug;
+  let sv = call_class_method "Net::Google" "new" !args in
+  new net_google sv
diff --git a/wrappers/pl_Net_Google_Cache.ml b/wrappers/pl_Net_Google_Cache.ml
new file mode 100644 (file)
index 0000000..542914f
--- /dev/null
@@ -0,0 +1,27 @@
+(* Wrapper around Perl Net::Google::Cache class.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: pl_Net_Google_Cache.ml,v 1.1 2003-10-14 16:05:22 rich Exp $
+ *)
+
+open Perl
+
+class net_google_cache sv =
+
+object (self)
+
+  method key =
+    string_of_sv (call_method sv "key" [])
+  method set_key v =
+    call_method_void sv "key" [sv_of_string v]
+  method url =
+    string_of_sv (call_method sv "url" [])
+  method set_url v =
+    call_method_void sv "url" [sv_of_string v]
+  method get =
+    let sv = call_method sv "get" [] in
+    if sv_is_undef sv then raise Not_found;
+    string_of_sv sv
+
+end
+
+(* let new_ = ... *)
diff --git a/wrappers/pl_Net_Google_Response.ml b/wrappers/pl_Net_Google_Response.ml
new file mode 100644 (file)
index 0000000..a134d10
--- /dev/null
@@ -0,0 +1,55 @@
+(* Wrapper around Perl Net::Google::Reponse class.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: pl_Net_Google_Response.ml,v 1.1 2003-10-14 16:05:22 rich Exp $
+ *)
+
+open Perl
+
+class net_google_response sv =
+
+object (self)
+
+  method documentFiltering =
+    bool_of_sv (call_method sv "documentFiltering" [])
+  method searchComments =
+    string_of_sv (call_method sv "searchComments" [])
+  method estimateTotalResultsNumber =
+    int_of_sv (call_method sv "estimateTotalResultsNumber" [])
+  method estimateIsExact =
+    bool_of_sv (call_method sv "estimateIsExact" [])
+  method searchQuery =
+    string_of_sv (call_method sv "searchQuery" [])
+  method startIndex =
+    int_of_sv (call_method sv "startIndex" [])
+  method endIndex =
+    int_of_sv (call_method sv "endIndex" [])
+  method searchTips =
+    string_of_sv (call_method sv "searchTips" [])
+  method directoryCategories =
+    let sv = call_method sv "directoryCategories" [] in
+    let av = deref_array sv in
+    av_map (fun sv -> new net_google_response sv) av
+  method searchTime =
+    float_of_sv (call_method sv "searchTime" [])
+  method toString =
+    string_of_sv (call_method sv "toString" [])
+  method title =
+    string_of_sv (call_method sv "title" [])
+  method url =
+    string_of_sv (call_method sv "URL" [])
+  method snippet =
+    string_of_sv (call_method sv "snippet" [])
+  method cachedSize =
+    string_of_sv (call_method sv "cachedSize" [])
+  method directoryTitle =
+    string_of_sv (call_method sv "directoryTitle" [])
+  method summary =
+    string_of_sv (call_method sv "summary" [])
+  method hostName =
+    string_of_sv (call_method sv "hostName" [])
+
+  (* method directoryCategory *)
+
+end
+
+(* let new_ = ... *)
diff --git a/wrappers/pl_Net_Google_Search.ml b/wrappers/pl_Net_Google_Search.ml
new file mode 100644 (file)
index 0000000..ad9d715
--- /dev/null
@@ -0,0 +1,61 @@
+(* Wrapper around Perl Net::Google::Search class.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: pl_Net_Google_Search.ml,v 1.1 2003-10-14 16:05:22 rich Exp $
+ *)
+
+open Perl
+
+open Pl_Net_Google_Response
+
+class net_google_search sv =
+
+object (self)
+
+  method key =
+    string_of_sv (call_method sv "key" [])
+  method set_key v =
+    call_method_void sv "key" [sv_of_string v]
+  method query =
+    string_of_sv (call_method sv "query" [])
+  method set_query v =
+    call_method_void sv "query" [sv_of_string v]
+  method starts_at =
+    int_of_sv (call_method sv "starts_at" [])
+  method set_starts_at v =
+    call_method_void sv "starts_at" [sv_of_int v]
+  method max_results =
+    int_of_sv (call_method sv "max_results" [])
+  method set_max_results v =
+    call_method_void sv "max_results" [sv_of_int v]
+  method restrict types =
+    string_of_sv (call_method sv "restrict" (List.map sv_of_string types))
+  method filter =
+    bool_of_sv (call_method sv "filter" [])
+  method set_filter v =
+    call_method_void sv "filter" [sv_of_bool v]
+  method safe =
+    bool_of_sv (call_method sv "safe" [])
+  method set_safe v =
+    call_method_void sv "safe" [sv_of_bool v]
+  method lr langs =
+    string_of_sv (call_method sv "lr" (List.map sv_of_string langs))
+  method ie encs =
+    string_of_sv (call_method sv "ie" (List.map sv_of_string encs))
+  method oe encs =
+    string_of_sv (call_method sv "oe" (List.map sv_of_string encs))
+  method return_estimatedTotal =
+    bool_of_sv (call_method sv "return_estimatedTotal" [])
+  method set_return_estimatedTotal v =
+    call_method_void sv "return_estimatedTotal" [sv_of_bool v]
+  method response =
+    let sv = call_method sv "response" [] in
+    let av = deref_array sv in
+    av_map (fun sv -> new net_google_response sv) av
+  method results =
+    let sv = call_method sv "results" [] in
+    let av = deref_array sv in
+    av_map (fun sv -> new net_google_response sv) av
+
+end
+
+(* let new_ = ... *)
diff --git a/wrappers/pl_Net_Google_Spelling.ml b/wrappers/pl_Net_Google_Spelling.ml
new file mode 100644 (file)
index 0000000..7fdc189
--- /dev/null
@@ -0,0 +1,23 @@
+(* Wrapper around Perl Net::Google::Spelling class.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: pl_Net_Google_Spelling.ml,v 1.1 2003-10-14 16:05:22 rich Exp $
+ *)
+
+open Perl
+
+class net_google_spelling sv =
+
+object (self)
+
+  method key =
+    string_of_sv (call_method sv "key" [])
+  method set_key v =
+    call_method_void sv "key" [sv_of_string v]
+  method phrase phrases =
+    string_of_sv (call_method sv "phrase" (List.map sv_of_string phrases))
+  method suggest =
+    string_of_sv (call_method sv "suggest" [])
+
+end
+
+(* let new_ = ... *)