Re: [Caml-list] perl4caml (Call Perl code and functions from Objective Caml)

[Richard Jones <rich@annexia.org>]

[-- Attachment #1: Type: text/plain, Size: 785 bytes --]

http://www.annexia.org/tmp/perl4caml-0.2.1.tar.gz

This version doesn't actually work (dies with some sort of
inexplicable Perl-ism), but demonstrates some points. Attached #1 is
some sample code which calls Perl classes. Attached #2 is the code you
need to write to wrap around a Perl class.

Wrapping the classes isn't as straightforward as I hoped, but it's
pretty simple and doesn't require too much thought. Considerably
easier (I hope) than rewriting CPAN anyway ...

Rich.

-- 
Richard Jones. http://www.annexia.org/ http://freshmeat.net/users/rwmj
Merjis Ltd. http://www.merjis.com/ - all your business data are belong to you.
PTHRLIB is a library for writing small, efficient and fast servers in C.
HTTP, CGI, DBI, lightweight threads: http://www.annexia.org/freeware/pthrlib/

[-- Attachment #2: loadpage.ml --]
[-- Type: text/plain, Size: 1662 bytes --]

(* 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 $
 *)

open Printf

open Pl_LWP_UserAgent
open Pl_HTTP_Request
open Pl_HTML_TreeBuilder
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";

  let site =
    if Array.length Sys.argv >= 2 then
      Sys.argv.(1)
    else
      "http://www.merjis.com/" in

  (* Create the UserAgent object. *)
  let ua = Pl_LWP_UserAgent.new_ ~env_proxy:true () in

  (* Fetch the page. *)
  let req = Pl_HTTP_Request.new_ "GET" ~uri:site () in
  let res = ua#request req in

  if not res#is_success then
    failwith ("Error while fetching " ^ site ^ ": " ^ res#status_line);

  (* Extract the content of the page. *)
  let content = res#content in

  (* Parse it using HTML::TreeBuilder. *)
  let tree = Pl_HTML_TreeBuilder.new_from_content content in

  (* Turn the tree into an HTML::Element. *)
  let tree = tree#elementify in

  (* Print out the resulting tree. *)
  let rec print root =
    let tag = root#tag in
    let attrs = root#all_external_attr in
    let subnodes = root#content_list in

    printf "Start tag: %s\n" tag;
    List.iter (fun (name, value) ->
		 printf "\tAttr: %s=\"%s\"\n" name value) attrs;

    List.iter (fun node ->
		 match node with
		     Element node -> print node
		   | String str ->
		       printf "String: %s\n" str) subnodes;
    printf "End tag: %s\n" tag
  in
  print tree;

  (* Destroy the Perl interpreter. *)
  Perl.destroy ()

[-- Attachment #3: pl_HTTP_Response.ml --]
[-- Type: text/plain, Size: 1118 bytes --]

(* 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 $
 *)

open Perl

open Pl_HTTP_Message

class http_response sv =

object (self)
  inherit http_message sv

  method code =
    string_of_sv (call_method sv "code" [])
  method set_code code =
    call_method_void sv "code" [sv_of_string code]
  method message =
    string_of_sv (call_method sv "message" [])
  method set_message message =
    call_method_void sv "message" [sv_of_string message]
  method status_line =
    string_of_sv (call_method sv "status_line" [])
  method base =
    string_of_sv (call_method sv "base" [])
  method as_string =
    string_of_sv (call_method sv "as_string" [])
  method is_info =
    bool_of_sv (call_method sv "is_info" [])
  method is_success =
    bool_of_sv (call_method sv "is_success" [])
  method is_redirect =
    bool_of_sv (call_method sv "is_redirect" [])
  method is_error =
    bool_of_sv (call_method sv "is_error" [])
  method error_as_HTML =
    string_of_sv (call_method sv "error_as_HTML" [])

end

(* let new_ ... *)