wrappers/pl_HTML_Element.ml

   1 (** Wrapper around Perl [HTML::Element] class.
   2   *
   3   * Copyright (C) 2003 Merjis Ltd.
   4   *
   5   * $Id: pl_HTML_Element.ml,v 1.4 2003-10-16 13:41:07 rich Exp $
   6   *)
   7
   8 open Perl
   9
  10 let _ = eval "use HTML::Element"
  11
  12 type 'a content_t = Element of 'a | String of string
  13
  14 class html_element sv =
  15
  16   let rec assocs_of_svlist = function
  17       [] -> []
  18     | [x] -> failwith "HTML::Element all_attr returned odd-length list!"
  19     | svname :: svvalue :: xs ->
  20         (string_of_sv svname, string_of_sv svvalue) :: assocs_of_svlist xs
  21   in
  22
  23   let rec list_of_svlist = function
  24       [] -> []
  25     | sv :: xs ->
  26         string_of_sv sv :: list_of_svlist xs
  27   in
  28
  29 object (self)
  30
  31   method sv = sv
  32
  33   method attr name =
  34     string_of_sv (call_method sv "attr" [sv_of_string name])
  35   method set_attr name value =
  36     call_method_void sv "attr" [sv_of_string name; sv_of_string value]
  37   method tag =
  38     string_of_sv (call_method sv "tag" [])
  39   method set_tag tag =
  40     call_method_void sv "tag" [sv_of_string tag]
  41   method parent =
  42     let sv = call_method sv "parent" [] in
  43     new html_element sv
  44   method set_parent (parent : html_element) =
  45     call_method_void sv "parent" [parent#sv]
  46   method content_list =
  47     let svlist = call_method_array sv "content_list" [] in
  48     List.map
  49       (fun c ->
  50          (* Not very satisfactory, but sv_type fails to discern the type
  51           * for some reason. XXX
  52           *)
  53          let str = string_of_sv c in
  54          let marker = "HTML::Element=HASH(" in
  55          let marker_len = String.length marker in
  56          if String.length str > marker_len &&
  57            String.sub str 0 marker_len = marker then
  58              Element (new html_element c)
  59          else
  60            String (string_of_sv c)
  61       ) svlist
  62   method all_attr =
  63     let svlist = call_method_array sv "all_attr" [] in
  64     assocs_of_svlist svlist
  65   method all_attr_names =
  66     let svlist = call_method_array sv "all_attr_names" [] in
  67     list_of_svlist svlist
  68   method all_external_attr =
  69     let svlist = call_method_array sv "all_external_attr" [] in
  70     assocs_of_svlist svlist
  71   method all_external_attr_names =
  72     let svlist = call_method_array sv "all_external_attr_names" [] in
  73     list_of_svlist svlist
  74
  75 end
  76
  77 (* Note that "new" is a reserved word, so I've appended an _ character. *)
  78 let new_ tag attrs =
  79   let rec loop = function
  80       [] -> []
  81     | (name, value) :: xs -> sv_of_string name :: sv_of_string value :: loop xs
  82   in
  83   let sv = call_class_method "HTML::Element" "new"
  84              (sv_of_string tag :: loop attrs) in
  85   new html_element sv