Initialization is done automatically.
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 \
examples/loadpage.cmx: perl.cmx wrappers/pl_HTML_Element.cmx \
wrappers/pl_HTML_TreeBuilder.cmx wrappers/pl_HTTP_Request.cmx \
wrappers/pl_LWP_UserAgent.cmx
-examples/test.cmo: perl.cmi
-examples/test.cmx: perl.cmx
+examples/test.cmo: perl.cmi wrappers/pl_Net_Google.cmo
+examples/test.cmx: perl.cmx wrappers/pl_Net_Google.cmx
wrappers/pl_HTML_Element.cmo: perl.cmi
wrappers/pl_HTML_Element.cmx: perl.cmx
wrappers/pl_HTML_Parser.cmo: perl.cmi
# Interface to Perl from OCaml.
# Copyright (C) 2003 Merjis Ltd.
-# $Id: Makefile,v 1.9 2003-10-15 09:49:52 rich Exp $
+# $Id: Makefile,v 1.10 2003-10-15 16:51:12 rich Exp $
include Makefile.config
LIBPERL := $(shell perl -MExtUtils::Embed -e ldopts)
+# XXX Hack required by ocamlopt, and sometimes ocamlc.
+# To work out what this should be, try:
+# `shell perl -MExtUtils::Embed -e ldopts'
+DYNALOADER_HACK := /usr/lib/perl/5.8.1/auto/DynaLoader/DynaLoader.a
+
WRAPPERS := \
wrappers/pl_Net_Google_Cache.cmo \
wrappers/pl_Net_Google_Response.cmo \
wrappers/pl_HTTP_Response.cmo \
wrappers/pl_LWP_UserAgent.cmo
-all: perl4caml.cma perl4caml.cmxa perl_init.cmo perl_init.cmx all-examples
+all: perl4caml.cma perl4caml.cmxa all-examples
perl4caml.cma: perl.cmo perl_c.o $(WRAPPERS)
$(OCAMLMKLIB) -o perl4caml $(LIBPERL) $^
perl4caml.cmxa: perl.cmx perl_c.o $(WRAPPERS:.cmo=.cmx)
$(OCAMLMKLIB) -o perl4caml $(LIBPERL) $^
-all-examples: examples/test examples/loadpage examples/google
+all-examples: examples/test examples/loadpage examples/google \
+ examples/test.opt examples/loadpage.opt examples/google.opt
examples/test: examples/test.cmo
- $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma perl_init.cmo $^ -o $@
+ $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@
-#examples/test.opt: examples/test.cmx
-# $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa perl_init.cmx $^ -o $@
+examples/test.opt: examples/test.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa $(DYNALOADER_HACK) $^ -o $@
examples/loadpage: examples/loadpage.cmo
- $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma perl_init.cmo $^ -o $@
+ $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@
-#examples/loadpage.opt: examples/loadpage.cmx
-# $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa perl_init.cmx $^ -o $@
+examples/loadpage.opt: examples/loadpage.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa $(DYNALOADER_HACK) $^ -o $@
examples/google: examples/google.cmo
- $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma perl_init.cmo $^ -o $@
+ $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@
-#examples/google.opt: examples/google.cmx
-# $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa perl_init.cmx $^ -o $@
+examples/google.opt: examples/google.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) perl4caml.cmxa $(DYNALOADER_HACK) $^ -o $@
%.cmi: %.mli
$(OCAMLC) $(OCAMLCFLAGS) -c $<
# Install.
install:
+ rm -rf $(OCAMLLIBDIR)/perl
install -c -m 0755 -d $(OCAMLLIBDIR)/perl
install -c -m 0755 -d $(OCAMLLIBDIR)/stublibs
install -c -m 0644 perl.cmi perl.mli perl4caml.cma perl4caml.cmxa \
- perl_init.cmo perl_init.cmx perl4caml.a libperl4caml.a \
+ perl4caml.a libperl4caml.a \
$(WRAPPERS:.cmo=.ml) $(WRAPPERS:.cmo=.cmi) $(OCAMLLIBDIR)/perl
install -c -m 0644 dllperl4caml.so $(OCAMLLIBDIR)/stublibs
*.cmxa
test
loadpage
-google
\ No newline at end of file
+google
+test.opt
+loadpage.opt
+google.opt
\ No newline at end of file
(* 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 $
+ * $Id: google.ml,v 1.2 2003-10-15 16:51:12 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
(fun response ->
printf "* %s\n <URL:%s>\n\n" response#title response#url
) search#results;
+
+ (* Destroy the Perl interpreter. *)
+ Perl.destroy (Perl.current_interpreter ())
(* 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.2 2003-10-14 16:05:21 rich Exp $
+ * $Id: loadpage.ml,v 1.3 2003-10-15 16:51:12 rich Exp $
*)
open Printf
open Pl_HTML_Element
let () =
- (* This is a hack which shouldn't be needed in future. *)
- Perl.eval "use LWP::UserAgent";
- Perl.eval "use HTML::TreeBuilder";
-
let site =
if Array.length Sys.argv >= 2 then
Sys.argv.(1)
print tree;
(* Destroy the Perl interpreter. *)
- Perl.destroy ()
+ Perl.destroy (Perl.current_interpreter ())
(* Simple test of the API.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: test.ml,v 1.2 2003-10-12 17:33:14 rich Exp $
+ * $Id: test.ml,v 1.3 2003-10-15 16:51:12 rich Exp $
*)
open Printf
+(* XXX Hack to workaround some sort of linking bug in OCaml. Without this
+ * the Perl module isn't initialized and this code crashes.
+ *)
+let f = Pl_Net_Google.may
+
let () =
(* Load "test.pl". *)
Perl.eval "require 'examples/test.pl'";
printf "TestClass.foo is %d\n" (Perl.int_of_sv sv); flush stdout;
(* Destroy the interpreter. *)
- Perl.destroy ()
+ Perl.destroy (Perl.current_interpreter ())
(* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl.ml,v 1.5 2003-10-14 16:05:21 rich Exp $
+ * $Id: perl.ml,v 1.6 2003-10-15 16:51:12 rich Exp $
*)
type t
exception Perl_failure of string
+external create : ?args:string array -> unit -> t
+ = "perl4caml_create"
+
+(* Initialization. This must happen first, otherwise other parts of the
+ * program will segfault because of a missing interpreter.
+ *)
external c_init : unit -> unit = "perl4caml_init"
-let init () =
+let () =
+ (* Leave this debugging message in for now until init support in OCaml
+ * is debugged.
+ *)
+ prerr_endline "perl_init: Initialising Perl support ...";
Callback.register_exception "perl4caml_perl_failure" (Perl_failure "");
- c_init () (* Initialise C code. *)
+ c_init (); (* Initialise C code. *)
+ (* Create the default interpreter. *)
+ create ~args:[| ""; "-w"; "-e"; "0" |] ();
+ ()
-external destroy : unit -> unit
- = "perl4caml_destroy"
+external current_interpreter : unit -> t
+ = "perl4caml_current_interpreter"
-external create : ?args:string array -> unit -> t
- = "perl4caml_create"
+external destroy : t -> unit
+ = "perl4caml_destroy"
external set_context : t -> unit
= "perl4caml_set_context"
*
* Copyright (C) 2003 Merjis Ltd.
*
- * $Id: perl.mli,v 1.5 2003-10-14 16:05:21 rich Exp $
+ * $Id: perl.mli,v 1.6 2003-10-15 16:51:12 rich Exp $
*)
type t
exception Perl_failure of string
(** [die] in Perl code is translated automatically into this exception. *)
-val init : unit -> unit
-(** Don't call this. Instead link your program with [perl_init.cmo] or
- * [perl_init.cmx] which calls this for you.
- *)
+external current_interpreter : unit -> t
+ = "perl4caml_current_interpreter"
+(** The [Perl] module has a notion of the "current" interpreter. Throws
+ * [Not_found] if there is no current interpreter.
+ *
+ * When a program starts up, if it has been linked with [perl_init.cmo]
+ * (which is should be), an interpreter is created for you. Normally
+ * this should be all you need to know about interpreters, unless you
+ * want to be really good and call
+ * [Perl.destroy (Perl.current_interpreter ())] at the end of your
+ * program to do proper cleanup.
+ *
+ * You can also, under certain circumstances, create other interpreters,
+ * although this is experiemental and definitely not recommended.
+ *
+ * If Perl was compiled with [-Dusemultiplicity] then you can create
+ * mutliple interpreters at the same time and switch between them by
+ * calling {!Perl.set_context}.
+ *
+ * Otherwise you may destroy the current interpreter and create another
+ * one (provided that at no time you have two "live" interpreters),
+ * by calling {!Perl.destroy} followed by {!Perl.create}.
+*)
-external destroy : unit -> unit
+external destroy : t -> unit
= "perl4caml_destroy"
-(** Destroy the current Perl interpreter, performing any necessary cleanup.
- * You should call this at the end of your program, otherwise Perl won't
- * properly clean up.
+(** Destroy the Perl interpreter, performing any necessary cleanup.
+ *
+ * You should call [Perl.destroy (Perl.current_interpreter ())] at
+ * the end of your program, otherwise Perl won't properly clean up
+ * (running [END] blocks, destroying objects and the like).
*
* Note that a Perl interpreter is created for you by default when you
* use perl4caml.
+ *
+ * The current interpreter can be found by calling
+ * {!Perl.current_interpreter}.
*)
external create : ?args:string array -> unit -> t
/* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.5 2003-10-14 16:05:21 rich Exp $
+ * $Id: perl_c.c,v 1.6 2003-10-15 16:51:12 rich Exp $
*/
#include <stdio.h>
#define Val_av(av) (Val_voidptr ((av)))
#define Av_val(avv) (Voidptr_val (AV, (avv)))
-static void
-xs_init (pTHX)
+CAMLprim value
+perl4caml_init (value unit)
{
- char *file = __FILE__;
- EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
-
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+ CAMLparam1 (unit);
+ PERL_SYS_INIT3 (NULL, NULL, NULL);
+ return Val_unit;
}
CAMLprim value
-perl4caml_init (value unit)
+perl4caml_current_interpreter (value unit)
{
- static char *argv[] = { "", "-w", "-e", "0" };
- int argc = sizeof argv / sizeof argv[0];
-
- PERL_SYS_INIT3 (NULL, NULL, NULL);
+ CAMLparam1 (unit);
+ if (my_perl == 0) raise_not_found ();
+ return Val_perl (my_perl);
+}
- /* Create a default interpreter. */
- my_perl = perl_alloc ();
- perl_construct (my_perl);
- PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
- perl_parse (my_perl, xs_init, argc, argv, NULL);
- /*perl_run (my_perl);*/
+static void
+xs_init (pTHX)
+{
+ char *file = __FILE__;
+ EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
- return Val_unit;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
CAMLprim value
CAMLlocal1 (args);
int argc, i;
char **argv;
- static char *no_args[] = { "", "-e", "0" };
+ static char *no_args[] = { "", "-w", "-e", "0" };
/* Arguments given? */
if (optargs == Val_int (0)) /* "None" */
{
- argc = 3;
+ argc = 4;
argv = no_args;
}
else /* "Some args" where args is a string array. */
}
CAMLprim value
-perl4caml_destroy (value unit)
+perl4caml_destroy (value plv)
{
- CAMLparam1 (unit);
+ CAMLparam1 (plv);
+ PerlInterpreter *pl = Perl_val (plv);
- perl_destruct (my_perl);
- perl_free (my_perl);
+ perl_destruct (pl);
+ perl_free (pl);
- /* Force a segfault if someone tries to use a Perl function without
- * creating another interpreter first.
- */
- my_perl = 0;
+ /* Current interpreter? */
+ if (my_perl == pl) my_perl = 0;
CAMLreturn (Val_unit);
}
+++ /dev/null
-(* Every program must link with perl_init.cmo (or perl_init.cmx).
- * Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_init.ml,v 1.1 2003-10-12 17:33:14 rich Exp $
- *)
-
-Perl.init ()
(* Wrapper around Perl HTML::Element class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTML_Element.ml,v 1.2 2003-10-14 16:05:22 rich Exp $
+ * $Id: pl_HTML_Element.ml,v 1.3 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use HTML::Element"
+
type 'a content_t = Element of 'a | String of string
class html_element sv =
(* Wrapper around Perl HTML::Parser class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTML_Parser.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTML_Parser.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use HTML::Parser"
+
class html_parser sv =
object (self)
(* Wrapper around Perl HTML::TreeBuilder class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTML_TreeBuilder.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTML_TreeBuilder.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_HTML_Parser
open Pl_HTML_Element
+let _ = eval "use HTML::TreeBuilder"
+
class html_treebuilder sv =
object (self)
(* Wrapper around Perl HTTP::Message class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTTP_Message.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTTP_Message.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use HTTP::Message"
+
class http_message sv =
object (self)
(* Wrapper around Perl HTTP::Request class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTTP_Request.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTTP_Request.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_HTTP_Message
open Pl_URI
+let _ = eval "use HTTP::Request"
+
class http_request sv =
object (self)
(* Wrapper around Perl HTTP::Response class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_HTTP_Response.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_HTTP_Response.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_HTTP_Message
+let _ = eval "use HTTP::Response"
+
class http_response sv =
object (self)
(* Wrapper around Perl LWP::UserAgent class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_LWP_UserAgent.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_LWP_UserAgent.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_HTTP_Request
open Pl_HTTP_Response
+let _ = eval "use LWP::UserAgent"
+
class lwp_useragent sv =
object (self)
(* 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 $
+ * $Id: pl_Net_Google.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_Net_Google_Search
open Pl_Net_Google_Spelling
+let _ = eval "use Net::Google"
+
let may f = function None -> () | Some v -> f v
class net_google sv =
(* 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 $
+ * $Id: pl_Net_Google_Cache.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use Net::Google::Cache"
+
class net_google_cache sv =
object (self)
(* 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 $
+ * $Id: pl_Net_Google_Response.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use Net::Google::Response"
+
class net_google_response sv =
object (self)
(* 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 $
+ * $Id: pl_Net_Google_Search.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
open Pl_Net_Google_Response
+let _ = eval "use Net::Google::Search"
+
class net_google_search sv =
object (self)
(* 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 $
+ * $Id: pl_Net_Google_Spelling.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use Net::Google::Spelling"
+
class net_google_spelling sv =
object (self)
(* Wrapper around Perl URI class.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: pl_URI.ml,v 1.1 2003-10-12 17:33:15 rich Exp $
+ * $Id: pl_URI.ml,v 1.2 2003-10-15 16:51:12 rich Exp $
*)
open Perl
+let _ = eval "use URI"
+
class uri sv =
object (self)