From: rich Date: Tue, 14 Oct 2003 16:05:21 +0000 (+0000) Subject: Fixed loads of bugs. It now works. Ready to integrate in assessortool. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=9e543055271a1ec799d56f507ab048c78d3d7a88;p=perl4caml.git Fixed loads of bugs. It now works. Ready to integrate in assessortool. --- diff --git a/.depend b/.depend index e160297..df0f9dd 100644 --- 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 diff --git a/Makefile b/Makefile index c365c0a..1365ff1 100644 --- 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. diff --git a/examples/.cvsignore b/examples/.cvsignore index 4114948..c39553a 100644 --- a/examples/.cvsignore +++ b/examples/.cvsignore @@ -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 index 0000000..47bd8e4 --- /dev/null +++ b/examples/google.ml @@ -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 \n\n" response#title response#url + ) search#results; diff --git a/examples/loadpage.ml b/examples/loadpage.ml index d73bf9c..9f67907 100644 --- a/examples/loadpage.ml +++ b/examples/loadpage.ml @@ -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 --- 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" diff --git a/perl.mli b/perl.mli index 2c60907..7bf89c3 100644 --- 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" diff --git a/perl_c.c b/perl_c.c index 2a9e71d..bf78580 100644 --- 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 @@ -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 () { diff --git a/wrappers/pl_HTML_Element.ml b/wrappers/pl_HTML_Element.ml index 6430985..7c6f470 100644 --- a/wrappers/pl_HTML_Element.ml +++ b/wrappers/pl_HTML_Element.ml @@ -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 index 0000000..0ebebbe --- /dev/null +++ b/wrappers/pl_Net_Google.ml @@ -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 index 0000000..542914f --- /dev/null +++ b/wrappers/pl_Net_Google_Cache.ml @@ -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 index 0000000..a134d10 --- /dev/null +++ b/wrappers/pl_Net_Google_Response.ml @@ -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 index 0000000..ad9d715 --- /dev/null +++ b/wrappers/pl_Net_Google_Search.ml @@ -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 index 0000000..7fdc189 --- /dev/null +++ b/wrappers/pl_Net_Google_Spelling.ml @@ -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_ = ... *)