wrappers/pl_HTML_Element.ml

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